Uploaded with ImageShack.us
saludos.
FiveTech Software tech support forums
www.FiveTechSoft.com
TSAYTIMER
40 posts • Page 2 of 3 • 1, 2, 3
Re: TSAYTIMER
by sysctrl2 » Wed Sep 28, 2011 7:36 pm
Cesar Cortes Cruz
SysCtrl Software
Mexico
' Sin +- FWH es mejor "
SysCtrl Software
Mexico
' Sin +- FWH es mejor "
-
sysctrl2 - Posts: 1020
- Joined: Mon Feb 05, 2007 7:15 pm
Re: TSAYTIMER
by wmormar » Fri Sep 30, 2011 3:26 am
Aqui una modificación para implementar el transparente y sin el borde.
Así como el preprocesado.
Proprocesado (saytimer.ch)
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 Expand view
- #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 Expand view
- /*
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 Expand view
- /*
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
Saludos
méxico.sureste
-
wmormar - Posts: 1074
- Joined: Fri Oct 07, 2005 10:41 pm
- Location: México
Re: TSAYTIMER
by Bayron » Fri Sep 30, 2011 3:43 am
William,
Que clase de Control.... Nice.... Y mil gracias por compartir... Y como siempre: Gracias a tí tambien Daniel, y a todo el Equipo de Fivetech....
EDITADO:
Podría aplicarsele el formato AM, PM???
Talvéz colocando una condicion en cTime???
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...
-
Bayron - Posts: 815
- Joined: Thu Dec 24, 2009 12:46 am
- Location: Philadelphia, PA
Re: TSAYTIMER
by wmormar » Fri Sep 30, 2011 4:17 am
Bayron wrote:William,
Que clase de Control.... Nice.... Y mil gracias por compartir... Y como siempre: Gracias a tí tambien Daniel, y a todo el Equipo de Fivetech....
EDITADO:
Podría aplicarsele el formato AM, PM???
Talvéz colocando una condicion en cTime???
Esa opción esta en el tintero, ya fue sugerida y estoy trabajando en ello.
William, Morales
Saludos
méxico.sureste
Saludos
méxico.sureste
-
wmormar - Posts: 1074
- Joined: Fri Oct 07, 2005 10:41 pm
- Location: México
Re: TSAYTIMER
by wmormar » Fri Sep 30, 2011 5:16 am
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 Expand view
- #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 Expand view
- /*
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 Expand view
- /*
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
Saludos
méxico.sureste
-
wmormar - Posts: 1074
- Joined: Fri Oct 07, 2005 10:41 pm
- Location: México
Re: TSAYTIMER
by cuatecatl82 » Sat Oct 01, 2011 3:39 am
Hi Compa William:
Excelente trabajo el que estas haciendo, te dejo algo de codigo, es el reloj de manceillas, hay cosillas que refinar como el repintado de las manecillas, pero funciona perfecto:
Aqui el link de descarga para que lo integres a tu clase y sea opcional el cual se deba mostrar...
http://www.megaupload.com/?d=BU6GHFR8
Saludos y ojala sirva.
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
-
cuatecatl82 - Posts: 625
- Joined: Wed Mar 14, 2007 6:49 pm
- Location: San Cristobal de las Casas, Chiapas México
Re: TSAYTIMER
by wmormar » Sat Oct 01, 2011 4:14 am
Amigos,
Revisando con el Amigo Daniel García se descubrió que el control cuando se usa en un MDI varia en la posición del transparente y se ve un efecto un poco raro, así que aquí la modificación.
Aquí la clase completa ya corregida.
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 Expand view
- /*
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
-
wmormar - Posts: 1074
- Joined: Fri Oct 07, 2005 10:41 pm
- Location: México
Re: TSAYTIMER
by El Loco » Sat Oct 01, 2011 6:21 am
Excelente trabajo wmormar.
Mis felicitaciones y agradecimiento !!!
Un abrazo. El Loco
Mis felicitaciones y agradecimiento !!!
Un abrazo. El Loco
FWH 32/64 14.04
Harbour 3.2.0 (r1306211258)
PellesC
Harbour 3.2.0 (r1306211258)
PellesC
- El Loco
- Posts: 328
- Joined: Fri May 19, 2006 4:08 pm
- Location: Buenos Aires - Argentina
Re: TSAYTIMER
by wmormar » Sat Oct 01, 2011 9:32 pm
El Loco wrote:Excelente trabajo wmormar.
Mis felicitaciones y agradecimiento !!!
Un abrazo. El Loco
Es un placer amigo
William, Morales
Saludos
méxico.sureste
Saludos
méxico.sureste
-
wmormar - Posts: 1074
- Joined: Fri Oct 07, 2005 10:41 pm
- Location: México
Re: TSAYTIMER
by wmormar » Wed Oct 05, 2011 2:51 am
Modificacion: Problema con la hora corta, reportado por AIDA
- Code: Select all Expand view
- /*
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
-
wmormar - Posts: 1074
- Joined: Fri Oct 07, 2005 10:41 pm
- Location: México
Re: TSAYTIMER
by Bayron » Wed Oct 05, 2011 4:31 am
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...
-
Bayron - Posts: 815
- Joined: Thu Dec 24, 2009 12:46 am
- Location: Philadelphia, PA
Re: TSAYTIMER
by leandro » Wed Oct 05, 2011 6:25 pm
Viejo Willi muchas felicitaciones ya lo hice andar....
Hay un "problema" para mi, Cuando son las las 12 pm, se ve de la siguiente manera:
00:14:56 PM
Creo que deberia ser:
12:14:45 PM
Muchas gracias por el aporte.
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 AREVALO
Bogotá (Colombia)
https://hymlyma.com
https://hymplus.com/
leandroalfonso111@gmail.com
leandroalfonso111@hotmail.com
[ Embarcadero C++ 7.60 for Win32 ] [ FiveWin 23.07 ] [ xHarbour 1.3.0 Intl. (SimpLex) (Build 20230914) ]
LEANDRO AREVALO
Bogotá (Colombia)
https://hymlyma.com
https://hymplus.com/
leandroalfonso111@gmail.com
leandroalfonso111@hotmail.com
[ Embarcadero C++ 7.60 for Win32 ] [ FiveWin 23.07 ] [ xHarbour 1.3.0 Intl. (SimpLex) (Build 20230914) ]
-
leandro - Posts: 1676
- Joined: Wed Oct 26, 2005 2:49 pm
- Location: Colombia
Re: TSAYTIMER
by wmormar » Wed Oct 05, 2011 7:36 pm
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
-
wmormar - Posts: 1074
- Joined: Fri Oct 07, 2005 10:41 pm
- Location: México
Re: TSAYTIMER
by wmormar » Thu Oct 06, 2011 4:19 am
Leandro,
Listo amigazo, corregida segun tus apreciaciones, gracias por testear
Y amigo, como decimos por aca, "viejo los cerros y reverdecen", jjejjejjejjejje
Aquí la clase modificada.
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 Expand view
- /*
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
-
wmormar - Posts: 1074
- Joined: Fri Oct 07, 2005 10:41 pm
- Location: México
Re: TSAYTIMER
by leandro » Thu Oct 06, 2011 10:05 pm
Amigazo perdón 
por lo de viejo jajajajajajaja, como siempre gracias, pero no quedo corregida. persiste el problema.
por lo de viejo jajajajajajaja, como siempre gracias, pero no quedo corregida. persiste el problema.Saludos
LEANDRO AREVALO
Bogotá (Colombia)
https://hymlyma.com
https://hymplus.com/
leandroalfonso111@gmail.com
leandroalfonso111@hotmail.com
[ Embarcadero C++ 7.60 for Win32 ] [ FiveWin 23.07 ] [ xHarbour 1.3.0 Intl. (SimpLex) (Build 20230914) ]
LEANDRO AREVALO
Bogotá (Colombia)
https://hymlyma.com
https://hymplus.com/
leandroalfonso111@gmail.com
leandroalfonso111@hotmail.com
[ Embarcadero C++ 7.60 for Win32 ] [ FiveWin 23.07 ] [ xHarbour 1.3.0 Intl. (SimpLex) (Build 20230914) ]
-
leandro - Posts: 1676
- Joined: Wed Oct 26, 2005 2:49 pm
- Location: Colombia
40 posts • Page 2 of 3 • 1, 2, 3
Return to FiveWin para Harbour/xHarbour
Who is online
Users browsing this forum: Google [Bot] and 34 guests