Page 3 of 3

Re: TSAYTIMER

PostPosted: Thu Oct 06, 2011 11:29 pm
by wmormar
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

/**************************************************************************************/

Re: TSAYTIMER

PostPosted: Fri Oct 07, 2011 1:44 am
by Bayron
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"

Re: TSAYTIMER

PostPosted: Fri Oct 07, 2011 4:51 am
by wmormar
Bayron,

Es un gusto amigo.

Y la frase es muy buena. jjejjejjejje

Re: TSAYTIMER

PostPosted: Fri Oct 07, 2011 1:08 pm
by leandro
"Viejo" Willi Excelente ahora si esta perfecto muchas gracias por el aporte.

Re: TSAYTIMER

PostPosted: Fri Oct 07, 2011 3:03 pm
by wmormar
leandro,

Es un gusto.

Re: TSAYTIMER

PostPosted: Fri Oct 07, 2011 3:53 pm
by devtuxtla
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

Re: TSAYTIMER

PostPosted: Fri Oct 07, 2011 8:47 pm
by wmormar
devtuxtla,

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

gracias

Re: TSAYTIMER

PostPosted: Sat Feb 10, 2018 11:55 pm
by nanoespinoza
Estimados

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

Saludos

Fernando Espinoza A.

Re: TSAYTIMER

PostPosted: Mon Feb 12, 2018 12:45 am
by wmormar
Amigos, veremos a modificarla...

Saludos

Re: TSAYTIMER

PostPosted: Mon Feb 12, 2018 1:27 am
by Busmatic_wpb
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.