TSAYTIMER
Re: TSAYTIMER
Cesar Cortes Cruz
SysCtrl Software
Mexico
' Sin +- FWH es mejor "
SysCtrl Software
Mexico
' Sin +- FWH es mejor "
Re: TSAYTIMER
Aqui una modificación para implementar el transparente y sin el borde.
Así como el preprocesado.
Proprocesado (saytimer.ch)
Clase (saytimer.prg)
Archivo de prueba (test.prg)
Agradeciendo la modificación al maestro Daniel García
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
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
/**************************************************************************************/
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
William, Morales
Saludos
méxico.sureste
Saludos
méxico.sureste
Re: TSAYTIMER
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???
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...
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...
Re: TSAYTIMER
Esa opción esta en el tintero, ya fue sugerida y estoy trabajando en ello.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???
William, Morales
Saludos
méxico.sureste
Saludos
méxico.sureste
Re: TSAYTIMER
Aqui la modificación para que sea en AMPM y hora corta
Proprocesado (saytimer.ch)
Clase (saytimer.prg)
Archivo de prueba (test.prg)
A los amigos que han seguido este post, aqui la modificación.
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
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
/**************************************************************************************/
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
William, Morales
Saludos
méxico.sureste
Saludos
méxico.sureste
- cuatecatl82
- Posts: 614
- Joined: Wed Mar 14, 2007 6:49 pm
- Location: San Cristobal de las Casas, Chiapas México
- Contact:
Re: TSAYTIMER
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.
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.
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
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
Re: TSAYTIMER
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.
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
Saludos
méxico.sureste
Re: TSAYTIMER
Excelente trabajo wmormar.
Mis felicitaciones y agradecimiento !!!
Un abrazo. El Loco
Mis felicitaciones y agradecimiento !!!
Un abrazo. El Loco
Re: TSAYTIMER
Es un placer amigoEl Loco wrote:Excelente trabajo wmormar.
Mis felicitaciones y agradecimiento !!!
Un abrazo. El Loco
William, Morales
Saludos
méxico.sureste
Saludos
méxico.sureste
Re: TSAYTIMER
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
Saludos
méxico.sureste
Re: TSAYTIMER
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...
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...
Re: TSAYTIMER
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.
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 ]
LEANDRO ALFONSO
SISTEMAS LYMA - BASE
Bogotá (Colombia)
[ FWH 19.09 ] [ xHarbour 1.2.3 Intl. (SimpLex) (Build 20190613) ] [ Embarcadero C++ 7.30 for Win32 ]
Re: TSAYTIMER
leandro,
Efectivamente, pero no hay tiempo que no se cumpla, jjejjejje
revisando...
Efectivamente, pero no hay tiempo que no se cumpla, jjejjejje
revisando...
William, Morales
Saludos
méxico.sureste
Saludos
méxico.sureste
Re: TSAYTIMER
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.
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
Saludos
méxico.sureste
Re: TSAYTIMER
Amigazo perdón 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 ]
LEANDRO ALFONSO
SISTEMAS LYMA - BASE
Bogotá (Colombia)
[ FWH 19.09 ] [ xHarbour 1.2.3 Intl. (SimpLex) (Build 20190613) ] [ Embarcadero C++ 7.30 for Win32 ]