TSAYTIMER

User avatar
wmormar
Posts: 1050
Joined: Fri Oct 07, 2005 10:41 pm
Location: México
Contact:

Re: TSAYTIMER

Post by wmormar »

leando,


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

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 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
Bayron
Posts: 815
Joined: Thu Dec 24, 2009 12:46 am
Location: Philadelphia, PA

Re: TSAYTIMER

Post 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"
=====>

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
wmormar
Posts: 1050
Joined: Fri Oct 07, 2005 10:41 pm
Location: México
Contact:

Re: TSAYTIMER

Post by wmormar »

Bayron,

Es un gusto amigo.

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

méxico.sureste
User avatar
leandro
Posts: 958
Joined: Wed Oct 26, 2005 2:49 pm
Location: Colombia
Contact:

Re: TSAYTIMER

Post by leandro »

"Viejo" Willi Excelente ahora si esta perfecto 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 ]
User avatar
wmormar
Posts: 1050
Joined: Fri Oct 07, 2005 10:41 pm
Location: México
Contact:

Re: TSAYTIMER

Post by wmormar »

leandro,

Es un gusto.
William, Morales
Saludos

méxico.sureste
devtuxtla
Posts: 392
Joined: Tue Jul 29, 2008 1:55 pm

Re: TSAYTIMER

Post 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
Visite Chiapas, el paraiso de México.
User avatar
wmormar
Posts: 1050
Joined: Fri Oct 07, 2005 10:41 pm
Location: México
Contact:

Re: TSAYTIMER

Post by wmormar »

devtuxtla,

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

gracias
William, Morales
Saludos

méxico.sureste
nanoespinoza
Posts: 105
Joined: Thu Mar 16, 2017 4:08 pm
Location: Ecuador

Re: TSAYTIMER

Post by nanoespinoza »

Estimados

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

Saludos

Fernando Espinoza A.
User avatar
wmormar
Posts: 1050
Joined: Fri Oct 07, 2005 10:41 pm
Location: México
Contact:

Re: TSAYTIMER

Post by wmormar »

Amigos, veremos a modificarla...

Saludos
William, Morales
Saludos

méxico.sureste
User avatar
Busmatic_wpb
Posts: 162
Joined: Wed Feb 22, 2017 2:19 am

Re: TSAYTIMER

Post 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.
Regards.
S.I.T.U.
Sistemas Inteligentes de transporte urbano
http://www.situcr.com
_@Situcr.com
Desarrollos BA4/B4j androide
Post Reply