I saw there is a oldest release on github and now there is the right release of Tled 1.00 run also on Harbour
CLASS TLed FROM TControl
CLASSDATA lRegistered AS LOGICAL
DATA lBorder AS LOGICAL INIT .T.
DATA nBorderLine AS NUMERIC INIT 3
DATA nColorBorder AS NUMERIC INIT nRGB( 3, 56, 147 )
DATA nColorBack AS NUMERIC INIT nRGB( 89, 135, 214 )
DATA nColorLedOFF AS NUMERIC INIT nRGB( 125, 165, 224 )
DATA nColorLedON AS NUMERIC INIT nRGB( 247, 192, 91 )
DATA nLedWidth AS NUMERIC INIT 3
DATA nLedHeight AS NUMERIC INIT 5
DATA nLedSpace AS NUMERIC INIT 1
DATA cTxtLin1 INIT "Linea 1"
DATA cTxtLin2 INIT "Linea 2"
DATA cMessage INIT ""
DATA aLinea1 AS ARRAY INIT {}
DATA aLinea2 AS ARRAY INIT {}
DATA lBlink AS LOGICAL INIT .F.
DATA lStatus AS LOGICAL INIT .F. //internal
DATA lTimeDate AS LOGICAL INIT .F.
DATA lStatusTime AS LOGICAL INIT .F. //internal
DATA lBeep AS LOGICAL INIT .F.
DATA oTimer READONLY //internal
DATA oOut READONLY //internal
DATA nInterval AS NUMERIC INIT 700
DATA nLedLines AS NUMERIC INIT 2
DATA nLedCharacters AS NUMERIC INIT 20
DATA lChronometer AS LOGICAL INIT .F.
DATA oTimerKrono READONLY
DATA n_secs //FOR CHRONPMETER
METHOD New( nTop, nLeft, oWnd, cMessage, nBorderLine, lPixel, lBorder , nColorBack ) CONSTRUCTOR
METHOD ReDefine( nId, oWnd ) CONSTRUCTOR
METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
METHOD Paint()
METHOD _FillRect( nTop, nLeft, nBottom, nRight, nColor )
METHOD Initiate( hDlg ) INLINE ::Super:Initiate( hDlg ), ::Default()
METHOD Default()
METHOD CheckLines()
METHOD GetCode( cChar )
METHOD Resize()
METHOD AdjustText()
METHOD TimeDate()
METHOD Blink()
METHOD StopTime()
METHOD StopBlink() INLINE ::oOut:deactivate()
METHOD Chronometer()
METHOD StopChrono() INLINE ::oTimerKrono:deactivate()
METHOD ResetChrono() INLINE ( ::StopChrono(), ::cTxtLin1:=space(3)+"00:00:00:000", ::refresh(.t.) )
METHOD PlayChrono() INLINE ( if(::lChronometer, ::StopChrono(),), ::cTxtLin1:=space(3)+"00:00:00:000", ::n_secs:=seconds(),::oTimerKrono:activate())
ENDCLASS
METHOD New( nTop, nLeft, oWnd, cMessage, nBorderLine, lPixel, lBorder , nColorBack) CLASS TLed
DEFAULT nTop := 0, nLeft := 0 ,;
oWnd := GetWndDefault() ,;
nBorderLine := 3 ,;
lPixel := .f. ,;
lBorder := .t. ,;
nColorBack := nRGB( 89, 135, 214 ) ,;
cMessage := "Fivewin TLed (*) For Harbour (*)"
::nStyle = nOR( WS_CHILD, WS_VISIBLE, WS_TABSTOP )
::nId = ::GetNewId()
::oWnd = oWnd
::nTop = If( lPixel, nTop, nTop * SAY_CHARPIX_H )
::nLeft = If( lPixel, nLeft, nLeft * SAY_CHARPIX_W )
::cMessage = cMessage
::nLedLines = 2
::AdjustText()
* ::Register()
::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )
::n_secs:=seconds()
if ! Empty( oWnd:hWnd )
::Create()
::Default()
oWnd:AddControl( Self )
else
oWnd:DefControl( Self )
endif
if ::lDrag
::CheckDots()
endif
return Self
//----------------------------------------------------------------------------------------//
METHOD ReDefine( nId, oWnd ) CLASS TLed
return Self
METHOD StopTime() CLASS TLed
IF ::oTimer != NIL
::oTimer:deactivate()
ELSE
::Default()
endif
return nil
//----------------------------------------------------------------------------------------//
/*
METHOD Paint() CLASS TLed
Local aRect := GetClientRect( ::hWnd )
Local nMidLine,hPen,hOldPen
Local k,w
Local nLinea,nCar,aChar,cFila
Local nLineax:= 0
Local nLineay:= 0
Local nColorPixel
Local hDC := ::hDC
Local aInfo := ::DispBegin()
//background
::_FillRect( aRect[1], aRect[2], aRect[3],aRect[4], ::nColorBack )
//control and create aLinea
::CheckLines()
For nHeight := 0 to ::nLedLines // 2 lines
aLinea := IIF( nHeight == 0, ::aLinea1, ::aLinea2 )
For nWidth := 0 to (::nLedCharacters-1) // 20 characters
aChar := aLinea[nWidth + 1]
For k := 0 to 7 // 8 pixel
nLineax := ( nHeight * ( ( ::nLedHeight * 9 ) + ( ::nLedSpace * 8 ) ) ) + ( k * ( ::nLedHeight + ::nLedSpace ) ) + ( ::nLedHeight + 3 )
cFila := aChar[k+1]
For w := 0 to 4
nLineay := ( nWidth * ( ( ::nLedWidth * 7 ) + ( ::nLedSpace * 4 ) ) ) + ( w * ( ::nLedWidth + ::nLedSpace ) ) + ( ::nLedHeight + 3 )
nColorPixel := IIF( cFila[w+1] == SYMBOL_LED, ::nColorLedON, ::nColorLedOFF)
FillSolidRect(::hDC, { nLineax, nLineay, nLineax + ::nLedWidth, nLineay + ::nLedHeight} , nColorPixel)
Next
Next
Next
Next
//Border
If ::lBorder
hPen := CreatePen( 0, ::nBorderLine, ::nColorBorder )
hOldPen := SelectObject( ::hDc, hPen )
nMidLine := ::nBorderLine / 2
MoveTo( ::hDC, nMidLine, nMidLine )
LineTo(::hDC, nMidLine, ::nHeight - nMidLine , hPen )
LineTo(::hDC, ::nWidth - nMidLine, ::nHeight - nMidLine , hPen )
LineTo(::hDC, ::nWidth - nMidLine , nMidLine, hPen )
LineTo(::hDC, nMidLine, nMidLine, 0, hPen )
ENDIF
::DispEnd( aInfo )
return 0
*/
METHOD Paint() CLASS TLed
Local aRect := GetClientRect( ::hWnd )
Local nMidLine,hPen,hOldPen
Local k,w
Local aChar,cFila
Local nLineax:= 0
Local nLineay:= 0
Local nColorPixel
Local hDC := ::hDC
Local nHeight,nWidth
Local aLinea
Local aInfo := ::DispBegin()
//background
::_FillRect( aRect[1], aRect[2], aRect[3],aRect[4], ::nColorBack )
/*
If ::lBorder
hPen := CreatePen( 0, ::nBorderLine, ::nColorBorder )
hOldPen := SelectObject( ::hDc, hPen )
nMidLine := ::nBorderLine / 2
MoveTo( ::hDC, nMidLine, nMidLine )
LineTo(::hDC, nMidLine, ::nHeight - nMidLine , hPen )
LineTo(::hDC, ::nWidth - nMidLine, ::nHeight - nMidLine , hPen )
LineTo(::hDC, ::nWidth - nMidLine , nMidLine, hPen )
LineTo(::hDC, nMidLine, nMidLine, 0, hPen )
ENDIF
*/
if ::lBorder
BoxEx( ::hDC, GetClientRect( ::hWnd ), ::nColorBorder )
endif
//control and create aLinea
::CheckLines()
For nHeight := 0 to (::nLedLines-1) // 2 lines
aLinea := IIF( nHeight == 0, ::aLinea1, ::aLinea2 )
For nWidth := 0 to (::nLedCharacters-1) // 20 characters
aChar := aLinea[nWidth + 1]
For k := 0 to 7 // 8 pixel
nLineax := ( nHeight * ( ( ::nLedHeight * 9 ) + ( ::nLedSpace * 8 ) ) ) + ( k * ( ::nLedHeight + ::nLedSpace ) ) + ( ::nLedHeight + 3 )
cFila := aChar[k+1]
For w := 0 to 4
nLineay := ( nWidth * ( ( ::nLedWidth * 7 ) + ( ::nLedSpace * 4 ) ) ) + ( w * ( ::nLedWidth + ::nLedSpace ) ) + ( ::nLedHeight + 3 )
//XHARBOUR
* nColorPixel := IIF( cFila[w+1] == SYMBOL_LED, ::nClrLedON, ::nClrLedOFF) //xharbour
//HARBOUR
nColorPixel := IIF( SubStr(cFila, w+1, 1) == SYMBOL_LED, ::nColorLedON, ::nColorLedOFF)
FillSolidRect(::hDC, { nLineax, nLineay, nLineax + ::nLedWidth, nLineay + ::nLedHeight} , nColorPixel)
Next
Next
Next
Next
::DispEnd( aInfo )
return 0
//----------------------------------------------------------------------------------------//
METHOD Default() CLASS TLed
::Resize()
IF ::lTimeDate
DEFINE TIMER ::oTimer INTERVAL 500 OF ::oWnd ACTION ::TimeDate()
ACTIVATE TIMER ::oTimer
ENDIF
IF ::lBlink
DEFINE TIMER ::oOut INTERVAL ::nInterval OF ::oWnd ACTION ::Blink ()
ACTIVATE TIMER ::oOut
ENDIF
IF ::lChronometer
DEFINE TIMER ::oTimerKrono INTERVAL 500 OF ::oWnd ACTION ::Chronometer()
ACTIVATE TIMER ::oTimerKrono
ENDIF
RETURN NIL
//----------------------------------------------------------------------------------------//
METHOD Blink() CLASS TLed
STATIC nSaveON, nSaveOFF
DEFAULT nSaveON := ::nColorLedON
DEFAULT nSaveOFF := ::nColorLedOFF
if ::lStatus
::nColorLedON := nSaveON
else
::nColorLedON := nSaveOFF
endif
IIF( ! Empty( ::hWnd ), ::Refresh(.f.), )
::lStatus := ! ::lStatus
return NIL
//----------------------------------------------------------------------------------------//
METHOD TimeDate(lBeep,nLang) CLASS TLed
Local cDate:= DtoS( Date() )
Local aItalian:= {"Gennaio", "Febbraio", "Marzo", "Aprile", "Maggio","Giugno", "Luglio", "Agosto", "Settembre", "Ottobre", "Novembre", "Dicembre"}
Local aSpanish := {"Enero", "Febrero", "Marzo", "Abril", "Mayo", "Abril","Junio", "Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre"}
Local aEnglish := {"January", "Febrary", "March", "April", "May", "June", "July", "August","September", "October", "November", "December" }
Local cMessage
default nlang := 1
DO CASE
CASE nLang = 1
aMesi := aItalian
CASE nLang = 2
aMesi := aEnglish
CASE nLang = 3
aMesi := aSpanish
ENDCASE
cMessage := Right( cDate, 2 ) + " | " +;
aMesi[ Val( SubStr( cDate, 5, 2 ) ) ] + " | " +;
Left(cDate, 4 )
if ::lStatusTime
::cTxtLin1 := Space(6) + Time()
::cTxtLin2 := Space( ( 20 - Len( cMessage) ) /2 ) + cMessage
IF ::lBeep
Msgbeep()
Endif
endif
* ::resize()
IIF( ! Empty( ::hWnd ), ::Refresh(.f.), )
::lStatusTime := ! ::lStatusTime
return NIL
//----------------------------------------------------------------------------------------//
METHOD Chronometer(cMessage) CLASS TLed
default cMessage := "Chronometer Led "
if ::lStatusTime
::cTxtLin1 := Space(3) + CalTime(::n_Secs)
::cTxtLin2 := Space( ( 20 - Len( cMessage) ) /2 ) + cMessage
endif
::nLedLines = 1
* ::resize()
IIF( ! Empty( ::hWnd ), ::Refresh(.f.), )
::lStatusTime := ! ::lStatusTime
return NIL
//----------------------------------------------------------------------------------------//
static Function CalTime(n_Secs)
Local _nTotSecs:=SECONDS()-n_Secs
Return Right(SecsToTime(_nTotSecs),16)
static function SecsToTime( nTimeInSecs )
local nHours := Int( nTimeInSecs / 3600 )
local nMins := Int( nTimeInSecs % 3600 / 60 )
local nSecs := Int( nTimeInSecs - ( nHours * 3600 ) - ( nMins * 60 ) )
local nMillisec := Int(GETTICKCOUNT())
return StrZero( nHours, 2 ) + ":" + StrZero( nMins, 2 ) + ":" + ;
StrZero( nSecs, 2 ) + ":" + Right(str(nMillisec),3)
//----------------------------------------------------------------------------------------//
METHOD _FillRect( nTop, nLeft, nBottom, nRight, nColor ) CLASS TLed
LOCAL oBrush, hBru, hOld, nMid
hBru := CreateSolidBrush( nColor )
hOld := SelectObject( ::hDC, hBru )
FillRect( ::hDC, { nTop, nLeft, nBottom, nRight }, hBru )
SelectObject( ::hDC, hOld )
DeleteObject( hBru )
RETURN (Nil)
//----------------------------------------------------------------------------------------//
/*
METHOD Resize() CLASS TLed
Local y, x
Local nLedValLines
Local nWidthChars:= (::nLedCharacters*6.87)+0.5 //138 // 20 cr
Local nHeightsymbol := 7
Local nLines:= 2
Local nSpaces:= (::nLedCharacters*2)*2
if ::nLedlines == 0
nLedValLines := 7
else
nLedValLines := 18 //19
endif
y := ( ::nLedHeight * nLedValLines) + ( ::nLedSpace * (nHeightsymbol*nLines) ) + 8
x := ( ::nLedWidth * nWidthChars ) + ( ::nLedHeight * 2 ) + ( ::nLedSpace * nSpaces ) + 8
::nWidth := x
::nHeight := y
IIF( ! Empty( ::hWnd ), ::Refresh(.f.), )
RETURN Nil
*/
METHOD Resize() CLASS TLed
Local y, x
Local nLedValLines
Local nWidthChars:= (::nLedCharacters*6.87)+0.5 //138 // 20 cr
Local nHeightsymbol := 7
Local nLines:= 2
Local nSpaces:= (::nLedCharacters*2)*2
if ::nLedlines == 1
nLedValLines := 7
else
nLedValLines := 18 //19
endif
y := ( ::nLedHeight * nLedValLines ) + ( ::nLedSpace * 14 ) + 8
x := ( ::nLedWidth * nWidthChars ) + ( ::nLedHeight * 2 ) + ( ::nLedSpace * 80 ) + 8
::nWidth := x
::nHeight := y
IIF( ! Empty( ::hWnd ), ::Refresh(.f.), )
RETURN Nil
//----------------------------------------------------------------------------------------//
METHOD AdjustText() CLASS TLed
Local cLin1, cLin2
Local cTmp := ::cMessage
IIF( Len( cTmp ) >= 41, cTmp := Left( cTmp, 40 ), )
IF Len( cTmp ) == 40
::cTxtLin1 := Left( cTmp, ::nLedCharacters )
::cTxtLin2 := Right( cTmp, ::nLedCharacters )
ELSE
::cTxtLin1 := Left( cTmp, ::nLedCharacters )
::cTxtLin1 := ::cTxtLin1 + Space( ::nLedCharacters - Len( ::cTxtLin1 ) )
::cTxtLin2 := Right( cTmp, Len( cTmp ) - ::nLedCharacters )
::cTxtLin2 := ::cTxtLin2 + Space( ::nLedCharacters - Len( ::cTxtLin2 ) )
END
IIF( ! Empty( ::hWnd ), ::Refresh(.f.), )
RETURN Nil
//----------------------------------------------------------------------------------------//
/*
METHOD CheckLines() CLASS TLed
Local nI
::aLinea1 := {}
::aLinea2 := {}
For nI := 1 to ::nLedCharacters
IF ni <= LEN( ::cTxtLin1 )
AAdd( ::aLinea1, ::GetCode( alltrim( ::cTxtLin1[nI] ) ) )
ELSE
AAdd( ::aLinea1, ::GetCode( " " ) )
END
IF ni <= LEN( ::cTxtLin2 )
AAdd( ::aLinea2, ::GetCode( alltrim( ::cTxtLin2[nI] ) ) )
ELSE
AAdd( ::aLinea2, ::GetCode( " " ) )
END
Next
RETURN Nil */
METHOD CheckLines() CLASS TLed
Local nI
::aLinea1 := {}
::aLinea2 := {}
For nI := 1 to ::nLedCharacters
IF ni <= LEN( ::cTxtLin1 )
AAdd( ::aLinea1, ::GetCode( SubStr(::cTxtLin1, ni, 1) ) )
ELSE
AAdd( ::aLinea1, ::GetCode( " " ) )
END
IF ni <= LEN( ::cTxtLin2 )
AAdd( ::aLinea2, ::GetCode( SubStr(::cTxtLin2, ni, 1) ) )
ELSE
AAdd( ::aLinea2, ::GetCode( " " ) )
END
Next
RETURN Nil
//----------------------------------------------------------------------------------------//
METHOD GetCode( cChar ) CLASS TLed
Local aChar, nChar
nChar := ASC( cChar )
DO CASE
CASE nChar=32 //space
aChar := CodeAScii32()
CASE nChar=33
aChar := CodeAScii33()
CASE nChar=34
aChar := CodeAScii34()
CASE nChar=35
aChar := CodeAScii35()
CASE nChar=36
aChar := CodeAScii36()
CASE nChar=37
aChar := CodeAScii37()
CASE nChar=38
aChar := CodeAScii38()
CASE nChar=39
aChar := CodeAScii39()
CASE nChar=40
aChar := CodeAScii40()
CASE nChar=41
aChar := CodeAScii41()
CASE nChar=42
aChar := CodeAScii42()
CASE nChar=43
aChar := CodeAScii43()
CASE nChar=44
aChar := CodeAScii44()
CASE nChar=45
aChar := CodeAScii45()
CASE nChar=46
aChar := CodeAScii46()
CASE nChar=47
aChar := CodeAScii47()
CASE nChar=48
aChar := CodeAScii48()
CASE nChar=49
aChar := CodeAScii49()
CASE nChar=50
aChar := CodeAScii50()
CASE nChar=51
aChar := CodeAScii51()
CASE nChar=52
aChar := CodeAScii52()
CASE nChar=53
aChar := CodeAScii53()
CASE nChar=54
aChar := CodeAScii54()
CASE nChar=55
aChar := CodeAScii55()
CASE nChar=56
aChar := CodeAScii56()
CASE nChar=57
aChar := CodeAScii57()
CASE nChar=58
aChar := CodeAScii58()
CASE nChar=51
aChar := CodeAScii51()
CASE nChar=53
aChar := CodeAScii53()
CASE nChar=54
aChar := CodeAScii54()
CASE nChar=55
aChar := CodeAScii55()
CASE nChar=56
aChar := CodeAScii56()
CASE nChar=57
aChar := CodeAScii57()
CASE nChar=58
aChar := CodeAScii58()
CASE nChar=59
aChar := CodeAScii59()
CASE nChar=60
aChar := CodeAScii60()
CASE nChar=61
aChar := CodeAScii61()
CASE nChar=62
aChar := CodeAScii62()
CASE nChar=63
aChar := CodeAScii63()
CASE nChar=64
aChar := CodeAScii64()
CASE nChar=65
aChar := CodeAScii65()
CASE nChar=66
aChar := CodeAScii66()
CASE nChar=67
aChar := CodeAScii67()
CASE nChar=68
aChar := CodeAScii68()
CASE nChar=69
aChar := CodeAScii69()
CASE nChar=70
aChar := CodeAScii70()
CASE nChar=71
aChar := CodeAScii71()
CASE nChar=72
aChar := CodeAScii72()
CASE nChar=73
aChar := CodeAScii73()
CASE nChar=74
aChar := CodeAScii74()
CASE nChar=75
aChar := CodeAScii75()
CASE nChar=76
aChar := CodeAScii76()
CASE nChar=77
aChar := CodeAScii77()
CASE nChar=78
aChar := CodeAScii78()
CASE nChar=79
aChar := CodeAScii79()
CASE nChar=80
aChar := CodeAScii80()
CASE nChar=81
aChar := CodeAScii81()
CASE nChar=82
aChar := CodeAScii82()
CASE nChar=83
aChar := CodeAScii83()
CASE nChar=84
aChar := CodeAScii84()
CASE nChar=85
aChar := CodeAScii85()
CASE nChar=86
aChar := CodeAScii86()
CASE nChar=87
aChar := CodeAScii87()
CASE nChar=88
aChar := CodeAScii88()
CASE nChar=89
aChar := CodeAScii89()
CASE nChar=90
aChar := CodeAScii90()
CASE nChar=91
aChar := CodeAScii91()
CASE nChar=92
aChar := CodeAScii92()
CASE nChar=93
aChar := CodeAScii93()
CASE nChar=94
aChar := CodeAScii94()
CASE nChar=95
aChar := CodeAScii95()
CASE nChar=96
aChar := CodeAScii96()
CASE nChar=97
aChar := CodeAScii97()
CASE nChar=98
aChar := CodeAScii98()
CASE nChar=99
aChar := CodeAScii99()
CASE nChar=100
aChar := CodeAScii100()
CASE nChar=101
aChar := CodeAScii101()
CASE nChar=102
aChar := CodeAScii102()
CASE nChar=103
aChar := CodeAScii103()
CASE nChar=104
aChar := CodeAScii104()
CASE nChar=105
aChar := CodeAScii105()
CASE nChar=106
aChar := CodeAScii106()
CASE nChar=106
aChar := CodeAScii106()
CASE nChar=107
aChar := CodeAScii107()
CASE nChar=108
aChar := CodeAScii108()
CASE nChar=109
aChar := CodeAScii109()
CASE nChar=110
aChar := CodeAScii110()
CASE nChar=111
aChar := CodeAScii111()
CASE nChar=112
aChar := CodeAScii112()
CASE nChar=113
aChar := CodeAScii113()
CASE nChar=114
aChar := CodeAScii114()
CASE nChar=115
aChar := CodeAScii115()
CASE nChar=116
aChar := CodeAScii116()
CASE nChar=117
aChar := CodeAScii117()
CASE nChar=118
aChar := CodeAScii118()
CASE nChar=119
aChar := CodeAScii119()
CASE nChar=120
aChar := CodeAScii120()
CASE nChar=121
aChar := CodeAScii121()
CASE nChar=122
aChar := CodeAScii122()
CASE nChar=123
aChar := CodeAScii123()
CASE nChar=124
aChar := CodeAScii124()
CASE nChar=125
aChar := CodeAScii125()
CASE nChar=126
aChar := CodeAScii126()
CASE nChar=128
aChar := CodeAScii128()
CASE nChar=161
aChar := CodeAScii161()
CASE nChar=170
aChar := CodeAScii170()
CASE nChar=186
aChar := CodeAScii186()
CASE nChar=224
aChar := CodeAScii224()
CASE nChar=225
aChar := CodeAScii225()
CASE nChar=232
aChar := CodeAScii232()
CASE nChar=233
aChar := CodeAScii233()
CASE nChar=236
aChar := CodeAScii236()
CASE nChar=237
aChar := CodeAScii237()
CASE nChar=242
aChar := CodeAScii242()
CASE nChar=243
aChar := CodeAScii243()
CASE nChar=247
aChar := CodeAScii247()
CASE nChar=249
aChar := CodeAScii249()
CASE nChar=250
aChar := CodeAScii250()
OTHERWISE
aChar := CodeAScii32()
ENDCASE
RETURN aChar