Cesar Cortes Cruz
SysCtrl Software
Mexico
' Sin +- FWH es mejor "
SysCtrl Software
Mexico
' Sin +- FWH es mejor "
Así como el preprocesado.
Proprocesado (saytimer.ch)
#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.> )
#endifClase (saytimer.prg)
/*
Autor : William Morales
País : México
Correo : <!-- e --><a href="mailto:wmormar@hotmail.com">wmormar@hotmail.com</a><!-- e -->
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)
/*
Autor : William Morales
País : México
Correo : <!-- e --><a href="mailto:wmormar@hotmail.com">wmormar@hotmail.com</a><!-- e -->
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 NILAgradeciendo la modificación al maestro Daniel García
por lo de viejo jajajajajajaja, como siempre gracias, pero no quedo corregida. persiste el problema.