TSAYTIMER

Re: TSAYTIMER

Postby wmormar » Thu Oct 06, 2011 11:29 pm

leando,


Amigo, mucha razon tienes, solo estaba checado con hora corta, aqui la modificacion

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 nNew == 0
            nNew := 12
         ENDIF
         IF ::lShortTime
            cTime := PadL( nNew, 2, "0" ) + SubStr( cTime, 3, 3 ) + " PM"
         ELSE
            cTime := PadL( nNew, 2, "0" ) + SubStr( cTime, 3 ) + " PM"
         ENDIF
      ELSE
         IF nHora == 0
            nHora := 12
         ENDIF
         IF ::lShortTime
            cTime := PadL( nHora, 2, "0" ) + SubStr( cTime, 3, 3 ) + " AM"
         ELSE
            cTime := PadL( nHora, 2, "0" ) + SubStr( cTime, 3 ) + " AM"
         ENDIF
      ENDIF
   ENDIF

   RETURN cTime

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

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

Re: TSAYTIMER

Postby Bayron » Fri Oct 07, 2011 1:44 am

Gracias nuevamente William por compartir...

Y amigo, como decimos por aca, "viejo los cerros y reverdecen", jjejjejjejjejje


Por aquí se dice: "Viejos los Cerros, pero todavía hechan uno que otro PALITO a la orilla del camino"
=====>

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

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

FiveWin, One line of code and it's done...
User avatar
Bayron
 
Posts: 815
Joined: Thu Dec 24, 2009 12:46 am
Location: Philadelphia, PA

Re: TSAYTIMER

Postby wmormar » Fri Oct 07, 2011 4:51 am

Bayron,

Es un gusto amigo.

Y la frase es muy buena. jjejjejjejje
William, Morales
Saludos

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

Re: TSAYTIMER

Postby leandro » Fri Oct 07, 2011 1:08 pm

"Viejo" Willi Excelente ahora si esta perfecto 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) ]
User avatar
leandro
 
Posts: 1480
Joined: Wed Oct 26, 2005 2:49 pm
Location: Colombia

Re: TSAYTIMER

Postby wmormar » Fri Oct 07, 2011 3:03 pm

leandro,

Es un gusto.
William, Morales
Saludos

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

Re: TSAYTIMER

Postby devtuxtla » Fri Oct 07, 2011 3:53 pm

Hola William.

Muy buen aporte.

No soy muy bueno modificando clases, asi que te dejo una idea, si consideras que vale la pena adicionarla, pues ...

Seria excelente que a la clase se le adicionaran dos parametros mas, el primero que fuese la cantidad de segundos en los cuales se ajecutaria una accion, y que esta accion fuese el segundo parametro.

Asi tendriamos una clase que mostrara en que tiempo se efectuaria una accion y que este tiempo este visible al usuario.

Te suena conocida la frase "SE AUNTODESTRUIRA EN 5 SEGUNDOS" ?

Saludos
Visite Chiapas, el paraiso de México.
devtuxtla
 
Posts: 392
Joined: Tue Jul 29, 2008 1:55 pm

Re: TSAYTIMER

Postby wmormar » Fri Oct 07, 2011 8:47 pm

devtuxtla,

Está en el tintero lo que comentas, en cuanto tenga algo lo publico como siempre.

gracias
William, Morales
Saludos

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

Re: TSAYTIMER

Postby nanoespinoza » Sat Feb 10, 2018 11:55 pm

Estimados

Alguien pudo realizar lo que se solicitó devtuxtla en este hilo.

Saludos

Fernando Espinoza A.
nanoespinoza
 
Posts: 135
Joined: Thu Mar 16, 2017 4:08 pm
Location: Ecuador

Re: TSAYTIMER

Postby wmormar » Mon Feb 12, 2018 12:45 am

Amigos, veremos a modificarla...

Saludos
William, Morales
Saludos

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

Re: TSAYTIMER

Postby Busmatic_wpb » Mon Feb 12, 2018 1:27 am

Exelente Mr. Williams
Gracias por compartirla hace algun tiempo compartio conmigo y muchas otras cosas que mi estimado amigo me enzeño. Gracias William que nunca tuve tiempo de agradecerte la ayuda y paciencia asi como todos aquellos ha nos ha ayudado incodicionalmente.

http://www.busmaticcr.com/taklilla2017.png

Vean la clase de Reloj.
Asi como muchos otros han aporto a ser parte del exito de muchos en ese Sitio.
Ocar Chacon Orozco.
Regards.
S.I.T.U.
Sistemas Inteligentes de transporte urbano
http://www.situcr.com
oscarchacon@Situcr.com
Desarrollos BA4/B4j androide
User avatar
Busmatic_wpb
 
Posts: 162
Joined: Wed Feb 22, 2017 2:19 am

Previous

Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: Google [Bot] and 8 guests