Amigo, mucha razon tienes, solo estaba checado con hora corta, aqui la modificacion
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 nNew == 0
nNew := 12
ENDIF
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 nHora == 0
nHora := 12
ENDIF
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
/**************************************************************************************/
