TSAYTIMER

sysctrl2 · Post by **sysctrl2** » Wed Sep 28, 2011 7:36 pm

otro ejemplo de TwSayTimer en Touch.

Uploaded with ImageShack.us

saludos.

wmormar · Post by **wmormar** » Fri Sep 30, 2011 3:26 am

Aqui una modificación para implementar el transparente y sin el borde.

Así como el preprocesado.

Proprocesado (saytimer.ch)

Code: Select all

#ifndef _SAYTIMER_CH
#define _SAYTIMER_CH

/*----------------------------------------------------------------------------*/

#xcommand REDEFINE SAYTIMER                        ;
             [<oSayTimer>]                         ;
             [ <dlg: OF,WINDOW,DIALOG > <oWnd> ]   ;
             [ FONT <oFont> ]                      ;
             [ INTERVAL <nInterval> ]              ;
             [ <color: COLOR,COLORS > <nClrText> [,<nClrShadow> [,<nClrBack> [,<nClrPen> ] ] ] ] ;
             [ <lTransparent: TRANSPARENT> ]       ;
             [ <lNoBorder: NOBORDER> ]             ;
      => ;
          [ <oSayTimer> := ] TWSayTimer():Redefine( ;
             <oWnd>, <oFont>, <nInterval>, <nClrText>, ;
             <nClrShadow>, <nClrBack>, <nClrPen>, <.lTransparent.>, <.lNoBorder.> )

#xcommand @ <nRow>, <nCol> SAYTIMER                ;
             [ <oSayTimer> ]                       ;
             [ <dlg: OF,WINDOW,DIALOG > <oWnd> ]   ;
             [ FONT <oFont> ]                      ;
             [ INTERVAL <nInterval> ]              ;
             [ <color: COLOR,COLORS > <nClrText> [,<nClrShadow> [,<nClrBack> [,<nClrPen> ] ] ] ] ;
             [ <lPixel: PIXEL, PIXELS > ]          ;
             [ <lTransparent: TRANSPARENT> ]       ;
             [ <lNoBorder: NOBORDER> ]             ;
      => ;
          [ <oSayTimer> := ] TWSayTimer():New( <nRow>, <nCol>, ;
             <oWnd>, <oFont>, <nInterval>, <nClrText>, ;
             <nClrShadow>, <nClrBack>, <nClrPen>, <.lPixel.>, <.lTransparent.>, <.lNoBorder.> )
#endif

Clase (saytimer.prg)

Code: Select all

/*
   Autor  : William Morales
   País   : México
   Correo : wmormar@hotmail.com
   Fecha  : 25/09/2011 06:29 a.m.
*/
#include "fivewin.ch"
#include "constant.ch"

#define COLOR_BTNFACE            15
#define WS_EX_TRANSPARENT      0x20
#define GWL_EXSTYLE             -20

CLASS TWSayTimer FROM TControl
   CLASSDATA lRegistered AS LOGICAL
   DATA lFont            AS LOGICAL   INIT .f.
   DATA lPixel           AS LOGICAL   INIT .f.
   DATA lTransparent     AS LOGICAL   INIT .f.
   DATA lNoBorder        AS LOGICAL   INIT .f.

   DATA oTmr             AS OBJECT    INIT NIL

   DATA nClrPen          AS NUMERIC   INIT CLR_HBLUE
   DATA nClrShadow       AS NUMERIC   INIT CLR_GRAY
   DATA nInterval        AS NUMERIC   INIT 1

   DATA cHour            AS CHARACTER INIT "0"
   DATA cMin             AS CHARACTER INIT "0"
   DATA cSecs            AS CHARACTER INIT "0"

   METHOD new( nTop, nLeft, oWnd, oFont, nInterval, clrText, clrShadow, ;
               clrBack, clrPen, lPixel, lTransparent ) CONSTRUCTOR
   METHOD Redefine( nId, oWnd, oFont, nInterval, clrText, clrShadow, ;
                    clrBack, clrPen, lTransparent ) CONSTRUCTOR
   METHOD paint()
   METHOD Display()         INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
   METHOD settimer()
   METHOD updatecoord()
   METHOD activate()        INLINE ::oTmr:activate()
   METHOD pause()           INLINE ::oTmr:deactivate()
   METHOD END()
   METHOD Initiate( hDlg )
   METHOD EraseBkGnd( hDC ) INLINE 1

ENDCLASS

/**************************************************************************************/
METHOD new( nTop, nLeft, oWnd, oFont, nInterval, clrText, clrShadow, ;
            clrBack, clrPen, lPixel, lTransparent, lNoBorder ) CLASS TWSayTimer
   DEFAULT oWnd         := GetWndDefault()
   DEFAULT nTop         := ::nTop
   DEFAULT nLeft        := ::nLeft
   DEFAULT nInterval    := ::nInterval
   DEFAULT clrPen       := GetSysColor( COLOR_BTNFACE )
   DEFAULT clrText      := oWnd:nClrText
   DEFAULT clrBack      := GetSysColor( COLOR_BTNFACE )
   DEFAULT lPixel       := .f.
   DEFAULT lTransparent := ::lTransparent
   DEFAULT ClrShadow    := CLR_GRAY
   DEFAULT lNoBorder    := .F.
   

   IF ValType(oFont) == "U"
      DEFINE FONT ::oFont NAME "Tahoma" SIZE 18, 18 BOLD
      ::lFont := .t.
   ELSE
      ::oFont := oFont
   ENDIF

   ::lTransparent := lTransparent
   ::oWnd         := oWnd
   ::nTop         := nTop * IF( !lPixel, BTN_CHARPIX_H, 1 )
   ::nLeft        := nLeft * IF( !lPixel, BTN_CHARPIX_W, 1 )
   ::updatecoord()
   ::nStyle       := nOR( WS_CHILD, WS_VISIBLE, WS_CLIPCHILDREN )
   ::nId          := ::GetNewId()
   ::nInterval    := nInterval * 1000
   ::nClrPen      := clrPen
   ::nClrShadow   := clrShadow
   ::nClrText     := clrText
   ::nClrPane     := clrBack
   ::lDrag        := .f.
   ::lNoBorder    := lNoBorder
    
   ::setBrush( ::oWnd:oBrush ) 
   
   ::Register()

   IF !Empty( ::oWnd:hWnd )
      ::Create()
      ::oWnd:AddControl( Self )
   ELSE
      ::oWnd:DefControl( Self )
   ENDIF

   ::settimer()

   RETURN Self

/**************************************************************************************/
METHOD Redefine( nId, oWnd, oFont, nInterval, clrText, clrShadow, ;
                 clrBack, clrPen, lTransparent ) CLASS TWSayTimer
   DEFAULT oWnd         := GetWndDefault()
   DEFAULT nInterval    := ::nInterval
   DEFAULT clrPen       := ::nClrPen
   DEFAULT clrText      := oWnd:nClrText
   DEFAULT clrBack      := GetSysColor( COLOR_BTNFACE )
   DEFAULT lTransparent := ::lTransparent

   IF ValType(oFont) == "U"
      DEFINE FONT ::oFont NAME "Tahoma" SIZE 18, 18 BOLD
      ::lFont := .t.
   ELSE
      ::oFont := oFont
   ENDIF

   ::nId        := nId
   ::oWnd       := oWnd
   ::nInterval  := nInterval * 1000
   ::nClrPen    := clrPen
   ::nClrShadow := clrShadow
   ::nClrText   := clrText
   ::nClrPane   := clrBack
   ::lDrag      := .f.

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

   oWnd:DefControl( Self )

   RETURN Self

/**************************************************************************************/
METHOD paint() CLASS TWSayTimer
   LOCAL hPen       := 0
   LOCAL hBrush     := 0
   LOCAL nBkOld     := 0
   LOCAL hFontOld   := 0
   LOCAL cTime      := Time()
   LOCAL aInfo      := ::DispBegin()
   LOCAL hOldBrush  := 0
   LOCAL aRect      := GetClientRect( ::hWnd )
   LOCAL aRect1     := GetClientRect( ::hWnd )
   LOCAL aRect2     := GetClientRect( ::hWnd )

   hPen      := CreatePen( 1, 3, ::nClrPen )
   nBkOld    := SetBkMode( ::hDC, 1 )
   hFontOld  := SelectObject( ::hDC, ::oFont:hFont )
   IF ::lTransparent
      hBrush    := ::oBrush:hBrush
   ELSE
      hBrush    := CreateSolidBrush( ::nClrPane )
   ENDIF

   IF ::lNoBorder
      SetBrushOrgEx( ::hDC, -(::nLeft+1), -(::nTop+1) )
      FillRect( ::hDC, aRect, hBrush )
   ELSE
      hOldBrush := SelectObject( ::hDC, hBrush )
      SetBrushOrgEx( ::hDC, -::nLeft, -::nTop )
      Rectangle( ::hDC, 0, 0, ::nHeight, ::nWidth, hPen )
      SelectObject( ::hDC, hOldBrush )
   ENDIF
   SetBrushOrgEx( ::hDC, 0, 0 )

   IF ValType(::nClrShadow) # "U"
      SetTextColor( ::hDC, ::nClrShadow )
      aRect1[1] := aRect1[1] + 2
      aRect1[2] := aRect1[2] + 2
      DrawText( ::hDC, cTime, aRect1 )
   ENDIF

   SetTextColor( ::hDC, ::nClrText )
   aRect2[1] := aRect2[1] + 3
   aRect2[2] := aRect2[2] + 3
   DrawText( ::hDC, cTime, aRect2 )

   if ! ::lTransparent
      DeleteObject( hBrush )
   endif
   DeleteObject( hPen )
   SelectObject( ::hDC, hFontOld )
   SetBkMode( ::hDC, nBkOld )

   ::DispEnd( aInfo )

   RETURN NIL

/**************************************************************************************/
METHOD settimer() CLASS TWSayTimer
   DEFINE TIMER ::oTmr INTERVAL ::nInterval ;
          ACTION If( IsWindowVisible( ::hWnd ), ::refresh(), ) OF Self
   ACTIVATE TIMER ::oTmr

   RETURN NIL

/**************************************************************************************/
METHOD updatecoord() CLASS TWSayTimer
   LOCAL hFontOld  := 0
   LOCAL cTime     := Time()

   hFontOld  := SelectObject( ::GETDC, ::oFont:hFont )
   ::nBottom := ::nTop + GetTextHeight( ::oFont:hFont, ::hDC ) + 6
   ::nRight  := ::nLeft + GetTextWidth( ::hDC, cTime, ::oFont:hFont ) + 6

   SelectObject( ::hDC, hFontOld )
   ::ReleaseDC()

   RETURN NIL

/**************************************************************************************/
METHOD END() CLASS TWSayTimer
   ::oTmr:END()

   IF ::lFont
      ::oFont:END()
   ENDIF

   RETURN NIL

/**************************************************************************************/
METHOD Initiate( hDlg ) CLASS TWSayTimer

   Super:Initiate( hDlg )
   IF !IsAppThemed()
      IF ::lTransparent
         IF !Empty( ::oWnd:oBrush:hBitmap ) .AND. !Empty( ::oBrush )
            ::SetBrush( ::oWnd:oBrush )
         ENDIF
      ENDIF
   ENDIF

   :: settimer()

   RETURN  nil

/**************************************************************************************/

Archivo de prueba (test.prg)

Code: Select all

/*
   Autor  : William Morales
   País   : México
   Correo : wmormar@hotmail.com
   Fecha  : 25/09/2011 06:29 a.m.
*/
#include "fivewin.ch"
#include "constant.ch"
#include "saytimer.ch"
 

FUNCTION main()
  LOCAL oFont := NIL
  LOCAL oWnd := NIL
  local o 
  local oBrush
   
  DEFINE BRUSH oBrush FILE "c:\fivewin\svn\repo\bitmaps\backgrnd\boards.bmp"
   
  DEFINE FONT oFont NAME "Times New Roman" BOLD SIZE 36, 36

  DEFINE WINDOW oWnd TITLE "TSAYTIMER..." BRUSH oBrush
  
  @ 10, oWnd:nWidth() - 60 SAYTIMER O OF oWnd FONT oFont PIXELS TRANSPARENT NOBORDER//;
//                                                    COLOR CLR_WHITE, CLR_HGREEN, CLR_BLUE, CLR_RED

 // oWnd:oTop = o
  ACTIVATE WINDOW oWnd MAXIMIZED

  RETURN NIL

Agradeciendo la modificación al maestro Daniel García

Bayron · Post by **Bayron** » Fri Sep 30, 2011 3:43 am

William,

Que clase de Control.... Nice.... Y mil gracias por compartir... Y como siempre: Gracias a tí tambien Daniel, y a todo el Equipo de Fivetech....

EDITADO:

Podría aplicarsele el formato AM, PM???

Talvéz colocando una condicion en cTime???

wmormar · Post by **wmormar** » Fri Sep 30, 2011 4:17 am

Bayron wrote:William,

Que clase de Control.... Nice.... Y mil gracias por compartir... Y como siempre: Gracias a tí tambien Daniel, y a todo el Equipo de Fivetech....

EDITADO:

Podría aplicarsele el formato AM, PM???

Talvéz colocando una condicion en cTime???

Esa opción esta en el tintero, ya fue sugerida y estoy trabajando en ello.

wmormar · Post by **wmormar** » Fri Sep 30, 2011 5:16 am

Aqui la modificación para que sea en AMPM y hora corta

Proprocesado (saytimer.ch)

Code: Select all

#ifndef _SAYTIMER_CH
#define _SAYTIMER_CH

/*----------------------------------------------------------------------------*/

#xcommand REDEFINE SAYTIMER                        ;
             [<oSayTimer>]                         ;
             [ <dlg: OF,WINDOW,DIALOG > <oWnd> ]   ;
             [ FONT <oFont> ]                      ;
             [ INTERVAL <nInterval> ]              ;
             [ <color: COLOR,COLORS > <nClrText> [,<nClrShadow> [,<nClrBack> [,<nClrPen> ] ] ] ] ;
             [ <lTransparent: TRANSPARENT> ]       ;
             [ <lAmPm: AMPM> ]                     ;
             [ <lShort: SHORT> ]                   ;
      => ;
          [ <oSayTimer> := ] TWSayTimer():Redefine( ;
             <oWnd>, <oFont>, <nInterval>, <nClrText>, ;
             <nClrShadow>, <nClrBack>, <nClrPen>, <.lTransparent.>, ;
             <.lAmPm.>, <.lShort.> )

#xcommand @ <nRow>, <nCol> SAYTIMER                ;
             [ <oSayTimer> ]                       ;
             [ <dlg: OF,WINDOW,DIALOG > <oWnd> ]   ;
             [ FONT <oFont> ]                      ;
             [ INTERVAL <nInterval> ]              ;
             [ <color: COLOR,COLORS > <nClrText> [,<nClrShadow> [,<nClrBack> [,<nClrPen> ] ] ] ] ;
             [ <lPixel: PIXEL, PIXELS > ]          ;
             [ <lTransparent: TRANSPARENT> ]       ;
             [ <lNoBorder: NOBORDER> ]             ;
             [ <lAmPm: AMPM> ]                     ;
             [ <lShort: SHORT> ]                   ;
      => ;
          [ <oSayTimer> := ] TWSayTimer():New( <nRow>, <nCol>, ;
             <oWnd>, <oFont>, <nInterval>, <nClrText>, ;
             <nClrShadow>, <nClrBack>, <nClrPen>, <.lPixel.>, ;
             <.lTransparent.>, <.lNoBorder.>, <.lAmPm.>, <.lShort.> )
#endif

Clase (saytimer.prg)

Code: Select all

/*
   Autor  : William Morales
   País   : México
   Correo : wmormar@hotmail.com
   Fecha  : 25/09/2011 06:29 a.m.
*/

#include "fivewin.ch"
#include "constant.ch"

#define COLOR_BTNFACE            15
#define WS_EX_TRANSPARENT      0x20
#define GWL_EXSTYLE             -20

CLASS TWSayTimer FROM TControl
   CLASSDATA lRegistered AS LOGICAL
   DATA lFont            AS LOGICAL   INIT .f.
   DATA lPixel           AS LOGICAL   INIT .f.
   DATA lTransparent     AS LOGICAL   INIT .f.
   DATA lNoBorder        AS LOGICAL   INIT .f.
   DATA lAmPm            AS LOGICAL   INIT .f.
   DATA lShortTime       AS LOGICAL   INIT .f.

   DATA oTmr             AS OBJECT    INIT NIL

   DATA nClrPen          AS NUMERIC   INIT CLR_HBLUE
   DATA nClrShadow       AS NUMERIC   INIT CLR_GRAY
   DATA nInterval        AS NUMERIC   INIT 1

   METHOD new( nTop, nLeft, oWnd, oFont, nInterval, clrText, clrShadow, ;
               clrBack, clrPen, lPixel, lTransparent, lAmPm, lShortTime ) CONSTRUCTOR
   METHOD Redefine( nId, oWnd, oFont, nInterval, clrText, clrShadow, ;
                    clrBack, clrPen, lTransparent, lAmPm, lShortTime ) CONSTRUCTOR
   METHOD paint()
   METHOD Display()         INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
   METHOD settimer()
   METHOD updatecoord()
   METHOD activate()        INLINE ::oTmr:activate()
   METHOD pause()           INLINE ::oTmr:deactivate()
   METHOD END()
   METHOD Initiate( hDlg )
   METHOD EraseBkGnd( hDC ) INLINE 1
   METHOD convertime()

ENDCLASS

/**************************************************************************************/
METHOD new( nTop, nLeft, oWnd, oFont, nInterval, clrText, clrShadow, ;
            clrBack, clrPen, lPixel, lTransparent, lNoBorder, lAmPm, ;
            lShortTime ) CLASS TWSayTimer
   DEFAULT oWnd         := GetWndDefault()
   DEFAULT nTop         := ::nTop
   DEFAULT nLeft        := ::nLeft
   DEFAULT nInterval    := ::nInterval
   DEFAULT clrPen       := GetSysColor( COLOR_BTNFACE )
   DEFAULT clrText      := oWnd:nClrText
   DEFAULT clrBack      := GetSysColor( COLOR_BTNFACE )
   DEFAULT lPixel       := .f.
   DEFAULT lTransparent := ::lTransparent
   DEFAULT ClrShadow    := CLR_GRAY
   DEFAULT lNoBorder    := .F.
   DEFAULT lAmPm        := .F.

   IF ValType(oFont) == "U"
      DEFINE FONT ::oFont NAME "Tahoma" SIZE 18, 18 BOLD
      ::lFont := .t.
   ELSE
      ::oFont := oFont
   ENDIF

   ::lShortTime   := lShortTime
   ::lAmPm        := lAmPm
   ::lTransparent := lTransparent
   ::oWnd         := oWnd
   ::nTop         := nTop * IF( !lPixel, BTN_CHARPIX_H, 1 )
   ::nLeft        := nLeft * IF( !lPixel, BTN_CHARPIX_W, 1 )
   ::updatecoord()
   ::nStyle       := nOR( WS_CHILD, WS_VISIBLE, WS_CLIPCHILDREN )
   ::nId          := ::GetNewId()
   ::nInterval    := nInterval * 1000
   ::nClrPen      := clrPen
   ::nClrShadow   := clrShadow
   ::nClrText     := clrText
   ::nClrPane     := clrBack
   ::lDrag        := .f.
   ::lNoBorder    := lNoBorder

   ::setBrush( ::oWnd:oBrush )
   ::Register()

   IF !Empty( ::oWnd:hWnd )
      ::Create()
      ::oWnd:AddControl( Self )
   ELSE
      ::oWnd:DefControl( Self )
   ENDIF

   ::settimer()

   RETURN Self

/**************************************************************************************/
METHOD Redefine( nId, oWnd, oFont, nInterval, clrText, clrShadow, ;
                 clrBack, clrPen, lTransparent, lAmPm, ;
                 lShortTime ) CLASS TWSayTimer
   DEFAULT oWnd         := GetWndDefault()
   DEFAULT nInterval    := ::nInterval
   DEFAULT clrPen       := ::nClrPen
   DEFAULT clrText      := oWnd:nClrText
   DEFAULT clrBack      := GetSysColor( COLOR_BTNFACE )
   DEFAULT lTransparent := ::lTransparent
   DEFAULT lAmPm        := .F.

   IF ValType(oFont) == "U"
      DEFINE FONT ::oFont NAME "Tahoma" SIZE 18, 18 BOLD
      ::lFont := .t.
   ELSE
      ::oFont := oFont
   ENDIF

   ::lShortTime := lShortTime
   ::lAmPm      := lAmPm
   ::nId        := nId
   ::oWnd       := oWnd
   ::nInterval  := nInterval * 1000
   ::nClrPen    := clrPen
   ::nClrShadow := clrShadow
   ::nClrText   := clrText
   ::nClrPane   := clrBack
   ::lDrag      := .f.

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

   oWnd:DefControl( Self )

   RETURN Self

/**************************************************************************************/
METHOD paint() CLASS TWSayTimer
   LOCAL hPen       := 0
   LOCAL hBrush     := 0
   LOCAL nBkOld     := 0
   LOCAL hFontOld   := 0
   LOCAL cTime      := ::convertime(Time())
   LOCAL aInfo      := ::DispBegin()
   LOCAL hOldBrush  := 0
   LOCAL aRect      := GetClientRect( ::hWnd )
   LOCAL aRect1     := GetClientRect( ::hWnd )
   LOCAL aRect2     := GetClientRect( ::hWnd )

   hPen      := CreatePen( 1, 3, ::nClrPen )
   nBkOld    := SetBkMode( ::hDC, 1 )
   hFontOld  := SelectObject( ::hDC, ::oFont:hFont )
   IF ::lTransparent
      hBrush    := ::oBrush:hBrush
   ELSE
      hBrush    := CreateSolidBrush( ::nClrPane )
   ENDIF

   IF ::lNoBorder
      SetBrushOrgEx( ::hDC, -(::nLeft+1), -(::nTop+1) )
      FillRect( ::hDC, aRect, hBrush )
   ELSE
      hOldBrush := SelectObject( ::hDC, hBrush )
      SetBrushOrgEx( ::hDC, -::nLeft, -::nTop )
      Rectangle( ::hDC, 0, 0, ::nHeight, ::nWidth, hPen )
      SelectObject( ::hDC, hOldBrush )
   ENDIF
   SetBrushOrgEx( ::hDC, 0, 0 )

   IF ValType(::nClrShadow) # "U"
      SetTextColor( ::hDC, ::nClrShadow )
      aRect1[1] := aRect1[1] + 2
      aRect1[2] := aRect1[2] + 2
      DrawText( ::hDC, cTime, aRect1 )
   ENDIF

   SetTextColor( ::hDC, ::nClrText )
   aRect2[1] := aRect2[1] + 3
   aRect2[2] := aRect2[2] + 3
   DrawText( ::hDC, cTime, aRect2 )

   if ! ::lTransparent
      DeleteObject( hBrush )
   endif
   DeleteObject( hPen )
   SelectObject( ::hDC, hFontOld )
   SetBkMode( ::hDC, nBkOld )

   ::DispEnd( aInfo )

   RETURN NIL

/**************************************************************************************/
METHOD settimer() CLASS TWSayTimer
   DEFINE TIMER ::oTmr INTERVAL ::nInterval ;
          ACTION If( IsWindowVisible( ::hWnd ), ::refresh(), ) OF Self
   ACTIVATE TIMER ::oTmr

   RETURN NIL

/**************************************************************************************/
METHOD updatecoord() CLASS TWSayTimer
   LOCAL hFontOld  := 0
   LOCAL cTime     := ::convertime(Time())

   hFontOld  := SelectObject( ::GETDC, ::oFont:hFont )
   ::nBottom := ::nTop + GetTextHeight( ::oFont:hFont, ::hDC ) + 6
   ::nRight  := ::nLeft + GetTextWidth( ::hDC, cTime, ::oFont:hFont ) + 6

   SelectObject( ::hDC, hFontOld )
   ::ReleaseDC()

   RETURN NIL

/**************************************************************************************/
METHOD END() CLASS TWSayTimer
   ::oTmr:END()

   IF ::lFont
      ::oFont:END()
   ENDIF

   RETURN NIL

/**************************************************************************************/
METHOD Initiate( hDlg ) CLASS TWSayTimer

   Super:Initiate( hDlg )
   IF !IsAppThemed()
      IF ::lTransparent
         IF !Empty( ::oWnd:oBrush:hBitmap ) .AND. !Empty( ::oBrush )
            ::SetBrush( ::oWnd:oBrush )
         ENDIF
      ENDIF
   ENDIF

   :: settimer()

   RETURN NIL

/**************************************************************************************/
METHOD convertime(cTime) CLASS TWSayTimer
   LOCAL nHora := Val(SubStr( cTime, 1, 2 ))
   LOCAL nNew  := 0

   IF ::lAmPm
      IF nHora >= 12
         nNew  := AScan( { 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23 }, nHora )
         IF ::lShortTime
            cTime := PadL( nNew, 2, "0" ) + SubStr( cTime, 3, 3 ) + " PM"
         ELSE
            cTime := PadL( nNew, 2, "0" ) + SubStr( cTime, 3 ) + " PM"
         ENDIF
      ELSE
         IF ::lShortTime
            cTime := PadL( nHora, 2, "0" ) + SubStr( cTime, 3, 3 ) + " AM"
         ELSE
            cTime := PadL( nHora, 2, "0" ) + SubStr( cTime, 3 ) + " AM"
         ENDIF
      ENDIF
   ENDIF

   RETURN cTime

/**************************************************************************************/

Archivo de prueba (test.prg)

Code: Select all

/*
   Autor  : William Morales
   País   : México
   Correo : wmormar@hotmail.com
   Fecha  : 25/09/2011 06:29 a.m.
*/
#include "fivewin.ch"
#include "constant.ch"
#include "saytimer.ch"
 

FUNCTION main()
  LOCAL oFont := NIL
  LOCAL oWnd := NIL
  local o 
  local oBrush
   
  DEFINE BRUSH oBrush FILE "c:\fivewin\svn\repo\bitmaps\backgrnd\boards.bmp"
   
  DEFINE FONT oFont NAME "Times New Roman" BOLD SIZE 36, 36

  DEFINE WINDOW oWnd TITLE "TSAYTIMER..." BRUSH oBrush
  
  @ 10, oWnd:nWidth() - 60 SAYTIMER O OF oWnd FONT oFont PIXELS TRANSPARENT NOBORDER
// AMPM ;
// SHORT ;
// COLOR CLR_WHITE, CLR_HGREEN, CLR_BLUE, CLR_RED

  ACTIVATE WINDOW oWnd MAXIMIZED

  RETURN NIL

A los amigos que han seguido este post, aqui la modificación.

cuatecatl82 · Post by **cuatecatl82** » Sat Oct 01, 2011 3:39 am

Hi Compa William:

Excelente trabajo el que estas haciendo, te dejo algo de codigo, es el reloj de manceillas, hay cosillas que refinar como el repintado de las manecillas, pero funciona perfecto:

Aqui el link de descarga para que lo integres a tu clase y sea opcional el cual se deba mostrar...
http://www.megaupload.com/?d=BU6GHFR8

Saludos y ojala sirva.

wmormar · Post by **wmormar** » Sat Oct 01, 2011 4:14 am

Amigos,

Revisando con el Amigo Daniel García se descubrió que el control cuando se usa en un MDI varia en la posición del transparente y se ve un efecto un poco raro, así que aquí la modificación.

Aquí la clase completa ya corregida.

Code: Select all

/*
   Autor  : William Morales
   País   : México
   Correo : wmormar@hotmail.com
   Fecha  : 25/09/2011 06:29 a.m.
*/

#include "fivewin.ch"
#include "constant.ch"

#define COLOR_BTNFACE            15
#define WS_EX_TRANSPARENT      0x20
#define GWL_EXSTYLE             -20

CLASS TWSayTimer FROM TControl
   CLASSDATA lRegistered AS LOGICAL
   DATA lFont            AS LOGICAL   INIT .f.
   DATA lPixel           AS LOGICAL   INIT .f.
   DATA lTransparent     AS LOGICAL   INIT .f.
   DATA lNoBorder        AS LOGICAL   INIT .f.
   DATA lAmPm            AS LOGICAL   INIT .f.
   DATA lShortTime       AS LOGICAL   INIT .f.

   DATA oTmr             AS OBJECT    INIT NIL

   DATA nClrPen          AS NUMERIC   INIT CLR_HBLUE
   DATA nClrShadow       AS NUMERIC   INIT CLR_GRAY
   DATA nInterval        AS NUMERIC   INIT 1

   METHOD new( nTop, nLeft, oWnd, oFont, nInterval, clrText, clrShadow, ;
               clrBack, clrPen, lPixel, lTransparent, lAmPm, lShortTime ) CONSTRUCTOR
   METHOD Redefine( nId, oWnd, oFont, nInterval, clrText, clrShadow, ;
                    clrBack, clrPen, lTransparent, lAmPm, lShortTime ) CONSTRUCTOR
   METHOD paint()
   METHOD Display()         INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
   METHOD settimer()
   METHOD updatecoord()
   METHOD activate()        INLINE ::oTmr:activate()
   METHOD pause()           INLINE ::oTmr:deactivate()
   METHOD END()
   METHOD Initiate( hDlg )
   METHOD EraseBkGnd( hDC ) INLINE 1
   METHOD convertime()

ENDCLASS

/**************************************************************************************/
METHOD new( nTop, nLeft, oWnd, oFont, nInterval, clrText, clrShadow, ;
            clrBack, clrPen, lPixel, lTransparent, lNoBorder, lAmPm, ;
            lShortTime ) CLASS TWSayTimer
   DEFAULT oWnd         := GetWndDefault()
   DEFAULT nTop         := ::nTop
   DEFAULT nLeft        := ::nLeft
   DEFAULT nInterval    := ::nInterval
   DEFAULT clrPen       := GetSysColor( COLOR_BTNFACE )
   DEFAULT clrText      := oWnd:nClrText
   DEFAULT clrBack      := GetSysColor( COLOR_BTNFACE )
   DEFAULT lPixel       := .f.
   DEFAULT lTransparent := ::lTransparent
   DEFAULT ClrShadow    := CLR_GRAY
   DEFAULT lNoBorder    := .F.
   DEFAULT lAmPm        := .F.

   IF ValType(oFont) == "U"
      DEFINE FONT ::oFont NAME "Tahoma" SIZE 18, 18 BOLD
      ::lFont := .t.
   ELSE
      ::oFont := oFont
   ENDIF

   ::lShortTime   := lShortTime
   ::lAmPm        := lAmPm
   ::lTransparent := lTransparent
   ::oWnd         := oWnd
   ::nTop         := nTop * IF( !lPixel, BTN_CHARPIX_H, 1 )
   ::nLeft        := nLeft * IF( !lPixel, BTN_CHARPIX_W, 1 )
   ::updatecoord()
   ::nStyle       := nOR( WS_CHILD, WS_VISIBLE, WS_CLIPCHILDREN )
   ::nId          := ::GetNewId()
   ::nInterval    := nInterval * 1000
   ::nClrPen      := clrPen
   ::nClrShadow   := clrShadow
   ::nClrText     := clrText
   ::nClrPane     := clrBack
   ::lDrag        := .f.
   ::lNoBorder    := lNoBorder

   ::setBrush( ::oWnd:oBrush )
   ::Register()

   IF !Empty( ::oWnd:hWnd )
      ::Create()
      ::oWnd:AddControl( Self )
   ELSE
      ::oWnd:DefControl( Self )
   ENDIF

   ::settimer()

   RETURN Self

/**************************************************************************************/
METHOD Redefine( nId, oWnd, oFont, nInterval, clrText, clrShadow, ;
                 clrBack, clrPen, lTransparent, lAmPm, ;
                 lShortTime ) CLASS TWSayTimer
   DEFAULT oWnd         := GetWndDefault()
   DEFAULT nInterval    := ::nInterval
   DEFAULT clrPen       := ::nClrPen
   DEFAULT clrText      := oWnd:nClrText
   DEFAULT clrBack      := GetSysColor( COLOR_BTNFACE )
   DEFAULT lTransparent := ::lTransparent
   DEFAULT lAmPm        := .F.

   IF ValType(oFont) == "U"
      DEFINE FONT ::oFont NAME "Tahoma" SIZE 18, 18 BOLD
      ::lFont := .t.
   ELSE
      ::oFont := oFont
   ENDIF

   ::lShortTime := lShortTime
   ::lAmPm      := lAmPm
   ::nId        := nId
   ::oWnd       := oWnd
   ::nInterval  := nInterval * 1000
   ::nClrPen    := clrPen
   ::nClrShadow := clrShadow
   ::nClrText   := clrText
   ::nClrPane   := clrBack
   ::lDrag      := .f.

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

   oWnd:DefControl( Self )

   RETURN Self

/**************************************************************************************/
METHOD paint() CLASS TWSayTimer
   LOCAL hPen       := 0
   LOCAL hBrush     := 0
   LOCAL nBkOld     := 0
   LOCAL hFontOld   := 0
   LOCAL cTime      := ::convertime(Time())
   LOCAL aInfo      := ::DispBegin()
   LOCAL hOldBrush  := 0
   LOCAL aRect      := GetClientRect( ::hWnd )
   LOCAL aRect1     := GetClientRect( ::hWnd )
   LOCAL aRect2     := GetClientRect( ::hWnd )

   hPen      := CreatePen( 1, 3, ::nClrPen )
   nBkOld    := SetBkMode( ::hDC, 1 )
   hFontOld  := SelectObject( ::hDC, ::oFont:hFont )
   IF ::lTransparent
      hBrush    := ::oBrush:hBrush
   ELSE
      hBrush    := CreateSolidBrush( ::nClrPane )
   ENDIF

   IF ::lNoBorder
      IF ::oWnd:ClassName() == "TMDIFRAME"
         SetBrushOrgEx( ::hDC, -(::nLeft+1), -(::nTop+1) )
      ELSE
         SetBrushOrgEx( ::hDC, -::nLeft, -::nTop )
      ENDIF
      FillRect( ::hDC, aRect, hBrush )
   ELSE
      hOldBrush := SelectObject( ::hDC, hBrush )
      SetBrushOrgEx( ::hDC, -::nLeft, -::nTop )
      Rectangle( ::hDC, 0, 0, ::nHeight, ::nWidth, hPen )
      SelectObject( ::hDC, hOldBrush )
   ENDIF
   SetBrushOrgEx( ::hDC, 0, 0 )

   IF ValType(::nClrShadow) # "U"
      SetTextColor( ::hDC, ::nClrShadow )
      aRect1[1] := aRect1[1] + 2
      aRect1[2] := aRect1[2] + 2
      DrawText( ::hDC, cTime, aRect1 )
   ENDIF

   SetTextColor( ::hDC, ::nClrText )
   aRect2[1] := aRect2[1] + 3
   aRect2[2] := aRect2[2] + 3
   DrawText( ::hDC, cTime, aRect2 )

   if ! ::lTransparent
      DeleteObject( hBrush )
   endif
   DeleteObject( hPen )
   SelectObject( ::hDC, hFontOld )
   SetBkMode( ::hDC, nBkOld )

   ::DispEnd( aInfo )

   RETURN NIL

/**************************************************************************************/
METHOD settimer() CLASS TWSayTimer
   DEFINE TIMER ::oTmr INTERVAL ::nInterval ;
          ACTION If( IsWindowVisible( ::hWnd ), ::refresh(), ) OF Self
   ACTIVATE TIMER ::oTmr

   RETURN NIL

/**************************************************************************************/
METHOD updatecoord() CLASS TWSayTimer
   LOCAL hFontOld  := 0
   LOCAL cTime     := ::convertime(Time())

   hFontOld  := SelectObject( ::GETDC, ::oFont:hFont )
   ::nBottom := ::nTop + GetTextHeight( ::oFont:hFont, ::hDC ) + 6
   ::nRight  := ::nLeft + GetTextWidth( ::hDC, cTime, ::oFont:hFont ) + 6

   SelectObject( ::hDC, hFontOld )
   ::ReleaseDC()

   RETURN NIL

/**************************************************************************************/
METHOD END() CLASS TWSayTimer
   ::oTmr:END()

   IF ::lFont
      ::oFont:END()
   ENDIF

   RETURN NIL

/**************************************************************************************/
METHOD Initiate( hDlg ) CLASS TWSayTimer

   Super:Initiate( hDlg )
   IF !IsAppThemed()
      IF ::lTransparent
         IF !Empty( ::oWnd:oBrush:hBitmap ) .AND. !Empty( ::oBrush )
            ::SetBrush( ::oWnd:oBrush )
         ENDIF
      ENDIF
   ENDIF

   :: settimer()

   RETURN NIL

/**************************************************************************************/
METHOD convertime(cTime) CLASS TWSayTimer
   LOCAL nHora := Val(SubStr( cTime, 1, 2 ))
   LOCAL nNew  := 0

   IF ::lAmPm
      IF nHora >= 12
         nNew  := AScan( { 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23 }, nHora )
         IF ::lShortTime
            cTime := PadL( nNew, 2, "0" ) + SubStr( cTime, 3, 3 ) + " PM"
         ELSE
            cTime := PadL( nNew, 2, "0" ) + SubStr( cTime, 3 ) + " PM"
         ENDIF
      ELSE
         IF ::lShortTime
            cTime := PadL( nHora, 2, "0" ) + SubStr( cTime, 3, 3 ) + " AM"
         ELSE
            cTime := PadL( nHora, 2, "0" ) + SubStr( cTime, 3 ) + " AM"
         ENDIF
      ENDIF
   ENDIF

   RETURN cTime

/**************************************************************************************/

El Loco · Post by **El Loco** » Sat Oct 01, 2011 6:21 am

Excelente trabajo wmormar.
Mis felicitaciones y agradecimiento !!!
Un abrazo. El Loco

wmormar · Post by **wmormar** » Sat Oct 01, 2011 9:32 pm

El Loco wrote:Excelente trabajo wmormar.
Mis felicitaciones y agradecimiento !!!
Un abrazo. El Loco

Es un placer amigo

wmormar · Post by **wmormar** » Wed Oct 05, 2011 2:51 am

Modificacion: Problema con la hora corta, reportado por AIDA

Code: Select all

/*
   Autor  : William Morales
   País   : México
   Correo : wmormar@hotmail.com
   Fecha  : 25/09/2011 06:29 a.m.
*/

#include "fivewin.ch"
#include "constant.ch"

#define COLOR_BTNFACE            15
#define WS_EX_TRANSPARENT      0x20
#define GWL_EXSTYLE             -20

CLASS TWSayTimer FROM TControl
   CLASSDATA lRegistered AS LOGICAL
   DATA lFont            AS LOGICAL   INIT .f.
   DATA lPixel           AS LOGICAL   INIT .f.
   DATA lTransparent     AS LOGICAL   INIT .f.
   DATA lNoBorder        AS LOGICAL   INIT .f.
   DATA lAmPm            AS LOGICAL   INIT .f.
   DATA lShortTime       AS LOGICAL   INIT .f.

   DATA oTmr             AS OBJECT    INIT NIL

   DATA nClrPen          AS NUMERIC   INIT CLR_HBLUE
   DATA nClrShadow       AS NUMERIC   INIT CLR_GRAY
   DATA nInterval        AS NUMERIC   INIT 1

   METHOD new( nTop, nLeft, oWnd, oFont, nInterval, clrText, clrShadow, ;
               clrBack, clrPen, lPixel, lTransparent, lAmPm, lShortTime ) CONSTRUCTOR
   METHOD Redefine( nId, oWnd, oFont, nInterval, clrText, clrShadow, ;
                    clrBack, clrPen, lTransparent, lAmPm, lShortTime ) CONSTRUCTOR
   METHOD paint()
   METHOD Display()         INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
   METHOD settimer()
   METHOD updatecoord()
   METHOD activate()        INLINE ::oTmr:activate()
   METHOD pause()           INLINE ::oTmr:deactivate()
   METHOD END()
   METHOD Initiate( hDlg )
   METHOD EraseBkGnd( hDC ) INLINE 1
   METHOD convertime()

ENDCLASS

/**************************************************************************************/
METHOD new( nTop, nLeft, oWnd, oFont, nInterval, clrText, clrShadow, ;
            clrBack, clrPen, lPixel, lTransparent, lNoBorder, lAmPm, ;
            lShortTime ) CLASS TWSayTimer
   DEFAULT oWnd         := GetWndDefault()
   DEFAULT nTop         := ::nTop
   DEFAULT nLeft        := ::nLeft
   DEFAULT nInterval    := ::nInterval
   DEFAULT clrPen       := GetSysColor( COLOR_BTNFACE )
   DEFAULT clrText      := oWnd:nClrText
   DEFAULT clrBack      := GetSysColor( COLOR_BTNFACE )
   DEFAULT lPixel       := .f.
   DEFAULT lTransparent := ::lTransparent
   DEFAULT ClrShadow    := CLR_GRAY
   DEFAULT lNoBorder    := .F.
   DEFAULT lAmPm        := .F.

   IF ValType(oFont) == "U"
      DEFINE FONT ::oFont NAME "Tahoma" SIZE 18, 18 BOLD
      ::lFont := .t.
   ELSE
      ::oFont := oFont
   ENDIF

   ::lShortTime   := lShortTime
   ::lAmPm        := lAmPm
   ::lTransparent := lTransparent
   ::oWnd         := oWnd
   ::nTop         := nTop * IF( !lPixel, BTN_CHARPIX_H, 1 )
   ::nLeft        := nLeft * IF( !lPixel, BTN_CHARPIX_W, 1 )
   ::updatecoord()
   ::nStyle       := nOR( WS_CHILD, WS_VISIBLE, WS_CLIPCHILDREN )
   ::nId          := ::GetNewId()
   ::nInterval    := nInterval * 1000
   ::nClrPen      := clrPen
   ::nClrShadow   := clrShadow
   ::nClrText     := clrText
   ::nClrPane     := clrBack
   ::lDrag        := .f.
   ::lNoBorder    := lNoBorder

   ::setBrush( ::oWnd:oBrush )
   ::Register()

   IF !Empty( ::oWnd:hWnd )
      ::Create()
      ::oWnd:AddControl( Self )
   ELSE
      ::oWnd:DefControl( Self )
   ENDIF

   ::settimer()

   RETURN Self

/**************************************************************************************/
METHOD Redefine( nId, oWnd, oFont, nInterval, clrText, clrShadow, ;
                 clrBack, clrPen, lTransparent, lAmPm, ;
                 lShortTime ) CLASS TWSayTimer
   DEFAULT oWnd         := GetWndDefault()
   DEFAULT nInterval    := ::nInterval
   DEFAULT clrPen       := ::nClrPen
   DEFAULT clrText      := oWnd:nClrText
   DEFAULT clrBack      := GetSysColor( COLOR_BTNFACE )
   DEFAULT lTransparent := ::lTransparent
   DEFAULT lAmPm        := .F.

   IF ValType(oFont) == "U"
      DEFINE FONT ::oFont NAME "Tahoma" SIZE 18, 18 BOLD
      ::lFont := .t.
   ELSE
      ::oFont := oFont
   ENDIF

   ::lShortTime := lShortTime
   ::lAmPm      := lAmPm
   ::nId        := nId
   ::oWnd       := oWnd
   ::nInterval  := nInterval * 1000
   ::nClrPen    := clrPen
   ::nClrShadow := clrShadow
   ::nClrText   := clrText
   ::nClrPane   := clrBack
   ::lDrag      := .f.

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

   oWnd:DefControl( Self )

   RETURN Self

/**************************************************************************************/
METHOD paint() CLASS TWSayTimer
   LOCAL hPen       := 0
   LOCAL hBrush     := 0
   LOCAL nBkOld     := 0
   LOCAL hFontOld   := 0
   LOCAL cTime      := ::convertime(Time())
   LOCAL aInfo      := ::DispBegin()
   LOCAL hOldBrush  := 0
   LOCAL aRect      := GetClientRect( ::hWnd )
   LOCAL aRect1     := GetClientRect( ::hWnd )
   LOCAL aRect2     := GetClientRect( ::hWnd )

   hPen      := CreatePen( 1, 3, ::nClrPen )
   nBkOld    := SetBkMode( ::hDC, 1 )
   hFontOld  := SelectObject( ::hDC, ::oFont:hFont )
   IF ::lTransparent
      hBrush    := ::oBrush:hBrush
   ELSE
      hBrush    := CreateSolidBrush( ::nClrPane )
   ENDIF

   IF ::lNoBorder
      IF ::oWnd:ClassName() == "TMDIFRAME"
         SetBrushOrgEx( ::hDC, -(::nLeft+1), -(::nTop+1) )
      ELSE
         SetBrushOrgEx( ::hDC, -::nLeft, -::nTop )
      ENDIF
      FillRect( ::hDC, aRect, hBrush )
   ELSE
      hOldBrush := SelectObject( ::hDC, hBrush )
      SetBrushOrgEx( ::hDC, -::nLeft, -::nTop )
      Rectangle( ::hDC, 0, 0, ::nHeight, ::nWidth, hPen )
      SelectObject( ::hDC, hOldBrush )
   ENDIF
   SetBrushOrgEx( ::hDC, 0, 0 )

   IF ValType(::nClrShadow) # "U"
      SetTextColor( ::hDC, ::nClrShadow )
      aRect1[1] := aRect1[1] + 2
      aRect1[2] := aRect1[2] + 2
      DrawText( ::hDC, cTime, aRect1 )
   ENDIF

   SetTextColor( ::hDC, ::nClrText )
   aRect2[1] := aRect2[1] + 3
   aRect2[2] := aRect2[2] + 3
   DrawText( ::hDC, cTime, aRect2 )

   if ! ::lTransparent
      DeleteObject( hBrush )
   endif
   DeleteObject( hPen )
   SelectObject( ::hDC, hFontOld )
   SetBkMode( ::hDC, nBkOld )

   ::DispEnd( aInfo )

   RETURN NIL

/**************************************************************************************/
METHOD settimer() CLASS TWSayTimer
   DEFINE TIMER ::oTmr INTERVAL ::nInterval ;
          ACTION If( IsWindowVisible( ::hWnd ), ::refresh(), ) OF Self
   ACTIVATE TIMER ::oTmr

   RETURN NIL

/**************************************************************************************/
METHOD updatecoord() CLASS TWSayTimer
   LOCAL hFontOld  := 0
   LOCAL cTime     := ::convertime(Time())

   hFontOld  := SelectObject( ::GETDC, ::oFont:hFont )
   ::nBottom := ::nTop + GetTextHeight( ::oFont:hFont, ::hDC ) + 6
   ::nRight  := ::nLeft + GetTextWidth( ::hDC, cTime, ::oFont:hFont ) + 6

   SelectObject( ::hDC, hFontOld )
   ::ReleaseDC()

   RETURN NIL

/**************************************************************************************/
METHOD END() CLASS TWSayTimer
   ::oTmr:END()

   IF ::lFont
      ::oFont:END()
   ENDIF

   RETURN NIL

/**************************************************************************************/
METHOD Initiate( hDlg ) CLASS TWSayTimer

   Super:Initiate( hDlg )
   IF !IsAppThemed()
      IF ::lTransparent
         IF !Empty( ::oWnd:oBrush:hBitmap ) .AND. !Empty( ::oBrush )
            ::SetBrush( ::oWnd:oBrush )
         ENDIF
      ENDIF
   ENDIF

   :: settimer()

   RETURN NIL

/**************************************************************************************/
METHOD convertime(cTime) CLASS TWSayTimer
   LOCAL nHora := Val(SubStr( cTime, 1, 2 ))
   LOCAL nNew  := 0

   IF ::lAmPm
      IF nHora >= 12
         nNew  := AScan( { 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23 }, nHora ) - 1
         IF ::lShortTime
            cTime := PadL( nNew, 2, "0" ) + SubStr( cTime, 3, 3 ) + " PM"
         ELSE
            cTime := PadL( nNew, 2, "0" ) + SubStr( cTime, 3 ) + " PM"
         ENDIF
      ELSE
         IF ::lShortTime
            cTime := PadL( nHora, 2, "0" ) + SubStr( cTime, 3, 3 ) + " AM"
         ELSE
            cTime := PadL( nHora, 2, "0" ) + SubStr( cTime, 3 ) + " AM"
         ENDIF
      ENDIF
   ENDIF

   RETURN cTime

/**************************************************************************************/

Bayron · Post by **Bayron** » Wed Oct 05, 2011 4:31 am

William, gracias por el gran aporte... muy bueno...

leandro · Post by **leandro** » Wed Oct 05, 2011 6:25 pm

Viejo Willi muchas felicitaciones ya lo hice andar....

Hay un "problema" para mi, Cuando son las las 12 pm, se ve de la siguiente manera:

00:14:56 PM

Creo que deberia ser:

12:14:45 PM

Muchas gracias por el aporte.

wmormar · Post by **wmormar** » Wed Oct 05, 2011 7:36 pm

leandro,

Efectivamente, pero no hay tiempo que no se cumpla, jjejjejje

revisando...

wmormar · Post by **wmormar** » Thu Oct 06, 2011 4:19 am

Leandro,

Listo amigazo, corregida segun tus apreciaciones, gracias por testear

Y amigo, como decimos por aca, "viejo los cerros y reverdecen", jjejjejjejjejje

Aquí la clase modificada.

Code: Select all

/*
   Autor  : William Morales
   País   : México
   Correo : wmormar@hotmail.com
   Fecha  : 25/09/2011 06:29 a.m.
*/

#include "fivewin.ch"
#include "constant.ch"

#define COLOR_BTNFACE            15
#define WS_EX_TRANSPARENT      0x20
#define GWL_EXSTYLE             -20

CLASS TWSayTimer FROM TControl
   CLASSDATA lRegistered AS LOGICAL
   DATA lFont            AS LOGICAL   INIT .f.
   DATA lPixel           AS LOGICAL   INIT .f.
   DATA lTransparent     AS LOGICAL   INIT .f.
   DATA lNoBorder        AS LOGICAL   INIT .f.
   DATA lAmPm            AS LOGICAL   INIT .f.
   DATA lShortTime       AS LOGICAL   INIT .f.

   DATA oTmr             AS OBJECT    INIT NIL

   DATA nClrPen          AS NUMERIC   INIT CLR_HBLUE
   DATA nClrShadow       AS NUMERIC   INIT CLR_GRAY
   DATA nInterval        AS NUMERIC   INIT 1

   METHOD new( nTop, nLeft, oWnd, oFont, nInterval, clrText, clrShadow, ;
               clrBack, clrPen, lPixel, lTransparent, lAmPm, lShortTime ) CONSTRUCTOR
   METHOD Redefine( nId, oWnd, oFont, nInterval, clrText, clrShadow, ;
                    clrBack, clrPen, lTransparent, lAmPm, lShortTime ) CONSTRUCTOR
   METHOD paint()
   METHOD Display()         INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
   METHOD settimer()
   METHOD updatecoord()
   METHOD activate()        INLINE ::oTmr:activate()
   METHOD pause()           INLINE ::oTmr:deactivate()
   METHOD END()
   METHOD Initiate( hDlg )
   METHOD EraseBkGnd( hDC ) INLINE 1
   METHOD convertime()

ENDCLASS

/**************************************************************************************/
METHOD new( nTop, nLeft, oWnd, oFont, nInterval, clrText, clrShadow, ;
            clrBack, clrPen, lPixel, lTransparent, lNoBorder, lAmPm, ;
            lShortTime ) CLASS TWSayTimer
   DEFAULT oWnd         := GetWndDefault()
   DEFAULT nTop         := ::nTop
   DEFAULT nLeft        := ::nLeft
   DEFAULT nInterval    := ::nInterval
   DEFAULT clrPen       := GetSysColor( COLOR_BTNFACE )
   DEFAULT clrText      := oWnd:nClrText
   DEFAULT clrBack      := GetSysColor( COLOR_BTNFACE )
   DEFAULT lPixel       := .f.
   DEFAULT lTransparent := ::lTransparent
   DEFAULT ClrShadow    := CLR_GRAY
   DEFAULT lNoBorder    := .F.
   DEFAULT lAmPm        := .F.

   IF ValType(oFont) == "U"
      DEFINE FONT ::oFont NAME "Tahoma" SIZE 18, 18 BOLD
      ::lFont := .t.
   ELSE
      ::oFont := oFont
   ENDIF

   ::lShortTime   := lShortTime
   ::lAmPm        := lAmPm
   ::lTransparent := lTransparent
   ::oWnd         := oWnd
   ::nTop         := nTop * IF( !lPixel, BTN_CHARPIX_H, 1 )
   ::nLeft        := nLeft * IF( !lPixel, BTN_CHARPIX_W, 1 )
   ::updatecoord()
   ::nStyle       := nOR( WS_CHILD, WS_VISIBLE, WS_CLIPCHILDREN )
   ::nId          := ::GetNewId()
   ::nInterval    := nInterval * 1000
   ::nClrPen      := clrPen
   ::nClrShadow   := clrShadow
   ::nClrText     := clrText
   ::nClrPane     := clrBack
   ::lDrag        := .f.
   ::lNoBorder    := lNoBorder

   ::setBrush( ::oWnd:oBrush )
   ::Register()

   IF !Empty( ::oWnd:hWnd )
      ::Create()
      ::oWnd:AddControl( Self )
   ELSE
      ::oWnd:DefControl( Self )
   ENDIF

   ::settimer()

   RETURN Self

/**************************************************************************************/
METHOD Redefine( nId, oWnd, oFont, nInterval, clrText, clrShadow, ;
                 clrBack, clrPen, lTransparent, lAmPm, ;
                 lShortTime ) CLASS TWSayTimer
   DEFAULT oWnd         := GetWndDefault()
   DEFAULT nInterval    := ::nInterval
   DEFAULT clrPen       := ::nClrPen
   DEFAULT clrText      := oWnd:nClrText
   DEFAULT clrBack      := GetSysColor( COLOR_BTNFACE )
   DEFAULT lTransparent := ::lTransparent
   DEFAULT lAmPm        := .F.

   IF ValType(oFont) == "U"
      DEFINE FONT ::oFont NAME "Tahoma" SIZE 18, 18 BOLD
      ::lFont := .t.
   ELSE
      ::oFont := oFont
   ENDIF

   ::lShortTime := lShortTime
   ::lAmPm      := lAmPm
   ::nId        := nId
   ::oWnd       := oWnd
   ::nInterval  := nInterval * 1000
   ::nClrPen    := clrPen
   ::nClrShadow := clrShadow
   ::nClrText   := clrText
   ::nClrPane   := clrBack
   ::lDrag      := .f.

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

   oWnd:DefControl( Self )

   RETURN Self

/**************************************************************************************/
METHOD paint() CLASS TWSayTimer
   LOCAL hPen       := 0
   LOCAL hBrush     := 0
   LOCAL nBkOld     := 0
   LOCAL hFontOld   := 0
   LOCAL cTime      := ::convertime(Time())
   LOCAL aInfo      := ::DispBegin()
   LOCAL hOldBrush  := 0
   LOCAL aRect      := GetClientRect( ::hWnd )
   LOCAL aRect1     := GetClientRect( ::hWnd )
   LOCAL aRect2     := GetClientRect( ::hWnd )

   hPen      := CreatePen( 1, 3, ::nClrPen )
   nBkOld    := SetBkMode( ::hDC, 1 )
   hFontOld  := SelectObject( ::hDC, ::oFont:hFont )
   IF ::lTransparent
      hBrush    := ::oBrush:hBrush
   ELSE
      hBrush    := CreateSolidBrush( ::nClrPane )
   ENDIF

   IF ::lNoBorder
      IF ::oWnd:ClassName() == "TMDIFRAME"
         SetBrushOrgEx( ::hDC, -(::nLeft+1), -(::nTop+1) )
      ELSE
         SetBrushOrgEx( ::hDC, -::nLeft, -::nTop )
      ENDIF
      FillRect( ::hDC, aRect, hBrush )
   ELSE
      hOldBrush := SelectObject( ::hDC, hBrush )
      SetBrushOrgEx( ::hDC, -::nLeft, -::nTop )
      Rectangle( ::hDC, 0, 0, ::nHeight, ::nWidth, hPen )
      SelectObject( ::hDC, hOldBrush )
   ENDIF
   SetBrushOrgEx( ::hDC, 0, 0 )

   IF ValType(::nClrShadow) # "U"
      SetTextColor( ::hDC, ::nClrShadow )
      aRect1[1] := aRect1[1] + 2
      aRect1[2] := aRect1[2] + 2
      DrawText( ::hDC, cTime, aRect1 )
   ENDIF

   SetTextColor( ::hDC, ::nClrText )
   aRect2[1] := aRect2[1] + 3
   aRect2[2] := aRect2[2] + 3
   DrawText( ::hDC, cTime, aRect2 )

   if ! ::lTransparent
      DeleteObject( hBrush )
   endif
   DeleteObject( hPen )
   SelectObject( ::hDC, hFontOld )
   SetBkMode( ::hDC, nBkOld )

   ::DispEnd( aInfo )

   RETURN NIL

/**************************************************************************************/
METHOD settimer() CLASS TWSayTimer
   DEFINE TIMER ::oTmr INTERVAL ::nInterval ;
          ACTION If( IsWindowVisible( ::hWnd ), ::refresh(), ) OF Self
   ACTIVATE TIMER ::oTmr

   RETURN NIL

/**************************************************************************************/
METHOD updatecoord() CLASS TWSayTimer
   LOCAL hFontOld  := 0
   LOCAL cTime     := ::convertime(Time())

   hFontOld  := SelectObject( ::GETDC, ::oFont:hFont )
   ::nBottom := ::nTop + GetTextHeight( ::oFont:hFont, ::hDC ) + 6
   ::nRight  := ::nLeft + GetTextWidth( ::hDC, cTime, ::oFont:hFont ) + 6

   SelectObject( ::hDC, hFontOld )
   ::ReleaseDC()

   RETURN NIL

/**************************************************************************************/
METHOD END() CLASS TWSayTimer
   ::oTmr:END()

   IF ::lFont
      ::oFont:END()
   ENDIF

   RETURN NIL

/**************************************************************************************/
METHOD Initiate( hDlg ) CLASS TWSayTimer

   Super:Initiate( hDlg )
   IF !IsAppThemed()
      IF ::lTransparent
         IF !Empty( ::oWnd:oBrush:hBitmap ) .AND. !Empty( ::oBrush )
            ::SetBrush( ::oWnd:oBrush )
         ENDIF
      ENDIF
   ENDIF

   :: settimer()

   RETURN NIL

/**************************************************************************************/
METHOD convertime(cTime) CLASS TWSayTimer
   LOCAL nHora := Val(SubStr( cTime, 1, 2 ))
   LOCAL nNew  := 0

   IF ::lAmPm
      IF nHora >= 12
         nNew  := AScan( { 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23 }, nHora )
         IF ::lShortTime
            IF nNew == 0
               nNew := 12
            ENDIF
            cTime := PadL( nNew, 2, "0" ) + SubStr( cTime, 3, 3 ) + " PM"
         ELSE
            cTime := PadL( nNew, 2, "0" ) + SubStr( cTime, 3 ) + " PM"
         ENDIF
      ELSE
         IF ::lShortTime
            IF nHora == 0
               nHora := 12
            ENDIF
            cTime := PadL( nHora, 2, "0" ) + SubStr( cTime, 3, 3 ) + " AM"
         ELSE
            cTime := PadL( nHora, 2, "0" ) + SubStr( cTime, 3 ) + " AM"
         ENDIF
      ENDIF
   ENDIF

   RETURN cTime

/**************************************************************************************/

leandro · Post by **leandro** » Thu Oct 06, 2011 10:05 pm

Amigazo perdón

por lo de viejo jajajajajajaja, como siempre gracias, pero no quedo corregida. persiste el problema.

FiveTech Software tech support forums

TSAYTIMER

Re: TSAYTIMER

Re: TSAYTIMER

Re: TSAYTIMER

Re: TSAYTIMER

Re: TSAYTIMER

Re: TSAYTIMER

Re: TSAYTIMER

Re: TSAYTIMER

Re: TSAYTIMER

Re: TSAYTIMER

Re: TSAYTIMER

Re: TSAYTIMER

Re: TSAYTIMER

Re: TSAYTIMER

Re: TSAYTIMER