TSAYTIMER

User avatar
sysctrl2
Posts: 833
Joined: Mon Feb 05, 2007 7:15 pm
Contact:

Re: TSAYTIMER

Post by sysctrl2 »

otro ejemplo de TwSayTimer en Touch.

Image

Uploaded with ImageShack.us

saludos.
Cesar Cortes Cruz
SysCtrl Software
Mexico

' Sin +- FWH es mejor "
User avatar
wmormar
Posts: 1050
Joined: Fri Oct 07, 2005 10:41 pm
Location: México
Contact:

Re: TSAYTIMER

Post by wmormar »

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
William, Morales
Saludos

méxico.sureste
User avatar
Bayron
Posts: 815
Joined: Thu Dec 24, 2009 12:46 am
Location: Philadelphia, PA

Re: TSAYTIMER

Post by Bayron »

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???
=====>

Bayron Landaverry
(215)2226600 Philadelphia,PA, USA
+(502)46727275 Guatemala
MayaBuilders@gMail.com

FWH12.04||Harbour 3.2.0 (18754)||BCC6.5||UEstudio 10.10||
Windows 7 Ultimate

FiveWin, One line of code and it's done...
User avatar
wmormar
Posts: 1050
Joined: Fri Oct 07, 2005 10:41 pm
Location: México
Contact:

Re: TSAYTIMER

Post by wmormar »

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.
William, Morales
Saludos

méxico.sureste
User avatar
wmormar
Posts: 1050
Joined: Fri Oct 07, 2005 10:41 pm
Location: México
Contact:

Re: TSAYTIMER

Post by wmormar »

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.
William, Morales
Saludos

méxico.sureste
User avatar
cuatecatl82
Posts: 614
Joined: Wed Mar 14, 2007 6:49 pm
Location: San Cristobal de las Casas, Chiapas México
Contact:

Re: TSAYTIMER

Post by cuatecatl82 »

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:

Image

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.
Last edited by cuatecatl82 on Thu Oct 06, 2011 5:38 am, edited 1 time in total.
Soluciones y Diseño de Software
Damos Soluciones...

I.S.C. Victor Daniel Cuatecatl Leon
Director y Diseñador de Proyectos

http://www.soldisoft.unlugar.com
http://www.sisa.unlugar.com
danyleon82@hotmail.com
www.facebook.com/victordaniel.cuatecatlleon
User avatar
wmormar
Posts: 1050
Joined: Fri Oct 07, 2005 10:41 pm
Location: México
Contact:

Re: TSAYTIMER

Post by wmormar »

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

/**************************************************************************************/
William, Morales
Saludos

méxico.sureste
El Loco
Posts: 220
Joined: Fri May 19, 2006 4:08 pm

Re: TSAYTIMER

Post by El Loco »

Excelente trabajo wmormar.
Mis felicitaciones y agradecimiento !!!
Un abrazo. El Loco
User avatar
wmormar
Posts: 1050
Joined: Fri Oct 07, 2005 10:41 pm
Location: México
Contact:

Re: TSAYTIMER

Post by wmormar »

El Loco wrote:Excelente trabajo wmormar.
Mis felicitaciones y agradecimiento !!!
Un abrazo. El Loco
Es un placer amigo
William, Morales
Saludos

méxico.sureste
User avatar
wmormar
Posts: 1050
Joined: Fri Oct 07, 2005 10:41 pm
Location: México
Contact:

Re: TSAYTIMER

Post by wmormar »

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

/**************************************************************************************/
William, Morales
Saludos

méxico.sureste
User avatar
Bayron
Posts: 815
Joined: Thu Dec 24, 2009 12:46 am
Location: Philadelphia, PA

Re: TSAYTIMER

Post by Bayron »

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

Bayron Landaverry
(215)2226600 Philadelphia,PA, USA
+(502)46727275 Guatemala
MayaBuilders@gMail.com

FWH12.04||Harbour 3.2.0 (18754)||BCC6.5||UEstudio 10.10||
Windows 7 Ultimate

FiveWin, One line of code and it's done...
User avatar
leandro
Posts: 958
Joined: Wed Oct 26, 2005 2:49 pm
Location: Colombia
Contact:

Re: TSAYTIMER

Post by leandro »

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.
Saludos
LEANDRO ALFONSO
SISTEMAS LYMA - BASE
Bogotá (Colombia)
[ FWH 19.09 ] [ xHarbour 1.2.3 Intl. (SimpLex) (Build 20190613) ] [ Embarcadero C++ 7.30 for Win32 ]
User avatar
wmormar
Posts: 1050
Joined: Fri Oct 07, 2005 10:41 pm
Location: México
Contact:

Re: TSAYTIMER

Post by wmormar »

leandro,

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

revisando...
William, Morales
Saludos

méxico.sureste
User avatar
wmormar
Posts: 1050
Joined: Fri Oct 07, 2005 10:41 pm
Location: México
Contact:

Re: TSAYTIMER

Post by wmormar »

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

/**************************************************************************************/
William, Morales
Saludos

méxico.sureste
User avatar
leandro
Posts: 958
Joined: Wed Oct 26, 2005 2:49 pm
Location: Colombia
Contact:

Re: TSAYTIMER

Post by leandro »

Amigazo perdón :D por lo de viejo jajajajajajaja, como siempre gracias, pero no quedo corregida. persiste el problema.
Saludos
LEANDRO ALFONSO
SISTEMAS LYMA - BASE
Bogotá (Colombia)
[ FWH 19.09 ] [ xHarbour 1.2.3 Intl. (SimpLex) (Build 20190613) ] [ Embarcadero C++ 7.30 for Win32 ]
Post Reply