BINARY - Clock "for coder's only" ;-)

[MrSwiss]

Hi all,
just finished my latest project ... a BIN clock ...

It just happens to coincide with the currently ongoing community discussion on BOOLEAN Type in FB (by coderJeff).
Reference: http://www.freebasic.net/forum/viewtopi ... 6&start=15
Some Long's in the code are 'misused' as BOOLEANS, see comments in code ...

BTW: our Server: r2-dallas went down whilst I've been writing this post! (obviously it's back up again ...)
Thanks to the Support People at Site5 ...

BIN-Clock.bas:

Code: Select all

' =================================================================== '
' BINARY Clock (incl. Digital & Help) 'MrSwiss  made'™ Version is:
' newly coded, commented and tested: (details below)
' ------------------------------------------------------------------- '
' Copyright © 2015, MrSwiss
' ALL RIGHTS RESERVED! NO COMMERCIAL/EDUCATIONAL USE WHATSOEVER! THIS
' INCLUDES ANY FORM OF DISTRIBUTION IN ANY FORM AND BY ANY MEANS!
' NO WARRANTIES AT ALL ANYWHWERE IN THE WORLD! THE USER TAKES ANY AND
' ALL RISKS! THE AUTHOR DISCLAIMS ANY RESPONSIBILITY FOR ANY TYPE OF
' DAMAGE(S) CAUSED BY THIS CODE! IF IN DOUBT, DON'T USE IT AT ALL!
' FREE FOR PERSONAL, NONPROFIT USE ONLY. GOVERNMENTS: NOT PERMITTED!
' -------------------------------------------------------------------- '
' PLAIN TEXT: Don't LIKE it, don't USE it! It's as simple as that.
' =================================================================== '
' TESTED: with FreeBASIC Compiler Ver. 1.03.0, 32bit and 64bit (WIN)
' COMPILE WITH:  -s gui  (compiler switch), see manual for details
' COMPILER LANGUAGE: "fb" (only, no support for deprecated options!)
' ------------------------------------------------------------------- '
' CREDITS GO TO:	fxm (explanations of calling Bload etc.)
' FB-Forum Topic:	Programming/General/Freebasic 1.03 problems ...
' http://www.freebasic.net/forum/viewtopic.php?f=3&t=23728#p209888
' =================================================================== '

' define screen properties
ScreenRes 400, 200, 32					' screen setup (32 bit depth, single buffer)
' declarations used by local procedures
Dim As Long PX(5), PY(2), bi(5)			' C-style arrays: PX(0 To 5), PY(0 to 2), bi(0 To 5)
' bi() an array of 'Long' forced to behave as 'BOOLEAN', see ConvToBIN & PaintTime Sub's
Dim As Long hh, mm, ss, ret				' var's for time & returned (error) codes (ret should be BOOLEAN too)
Dim Shared As UByte r=0, g=0, b=0, a=255' default color (black), opaque (can be used everywhere)
Dim As String TStr						' time string
' declares ... general init stuff
Dim As Any Ptr dclock = ImageCreate(300, 50, , 32)	' create 'clock face' buffer
ret = Bload (ExePath & "\DigiIF.bmp", dclock)' fill the buffer with the .BMP Graphic (from file)
If ret Then								' file NOT found, inform user and quit ...
	' remember: background, at this point in time is still black ... default
	Draw String (20, 80), "'DigiIF.bmp' NOT found, aborting ...", rgb(255,127,0)	' orange
	Draw String (20,100), "Press any key to exit program!", rgb(255,127,0)			' orange
	ImageDestroy dclock					' destroy image buffer
	Sleep : End 1						' quit with errorcode 1 (for batch processing)
EndIf
Color rgba(r,g,b,a), rgba(255,255,255,a)' black on white BG
' initialize the arrays PX, PY (without typing too much), defines _
' the Paint 'Axis-Points' (x, y) used later by 'PaintTime' Sub
For i As Long = 0 To 5
	PX(i) = 105 + i*50					' the 105 is the x-starting point (80+25) _
Next									' + i*50 is the increment by 50
For i As Long = 0 To 2
	PY(i) = 50 + i*50					' the 50 is the y-starting point (25+25) _
Next									' + i*50 is the increment by 50

' ----- local procedures ----- '
Sub GetTime(ByRef hh As Long, ByRef mm As Long, ByRef ss As Long, ByRef TStr As String)
	TStr = Time							' get time as string "hh:mm:ss", system time
	hh = ValInt(Left(TStr, 2))			' ValInt returns a Long = Int<32>
	mm = ValInt(Mid(TStr, 4, 2))		' ATTN.: ValLng returns a LongInt = Int<64>
	ss = ValInt(Right(TStr, 2))
End Sub


Sub ConvToBIN(ByVal Num As Long, bi() As Long)
	' reset array to 0 (all positions) to have a defined start ...
	For i As Long = 0 To 5 : bi(i) = 0 : Next	' single line 'For ... Next' loop
	' we now only have to set the 'proper' bits (no error checks)
	If Num >= 32 Then					' max. is 59 Min/Sec (max. 6 bits)
		bi(0) = 1 : Num mod= 32			' set bi() and get/set the 'remainder'
	EndIf
	If Num >= 16 Then bi(1) = 1 : Num mod= 16 : EndIf	' single line version (of above)
	If Num >= 8	 Then bi(2) = 1 : Num mod= 8  : EndIf	' if we had BOOLEANS: bi(n) = TRUE
	If Num >= 4  Then bi(3) = 1 : Num mod= 4  : EndIf
	If Num >= 2  Then bi(4) = 1 : Num mod= 2  : EndIf
	If Num	= 1  Then bi(5) = 1
End Sub


Sub PaintTime(ByVal idx As Long, PX() As Long, PY() As Long, bi() As Long)
	For j As Long = 0 To 5				' we have to always paint 6 fields (hh, mm, ss)
		Select Case As Const idx		' hh: idx = 0, mm: idx = 1, ss: idx = 2 _
			Case 0						' there is, with every call, always only a 1/3 of the code run
				Select Case As Const j	' every bi() instance once (0 --> 5), MS-Bit first ...
					Case 0				' this one is special to hh only (5 bits do the trick), 23 = max.
						Paint (PX(j), PY(idx)), rgba(255,223,0,a), rgba(r,g,b,a)		' dark yellow
						Draw String (PX(j)-12, PY(idx)-8), "NOT", rgba(r,g,b,a)			' default (black)
						Draw String (PX(j)-16, PY(idx)+1), "used", rgba(r,g,b,a)
					Case 1
						If bi(j) Then
							Paint (PX(j), PY(idx)), rgba(255,0,0,a), rgba(r,g,b,a)		' red (active)
						Else
							Paint (PX(j), PY(idx)), rgba(63,63,63,127), rgba(r,g,b,a)	' dark grey (inactive)
						EndIf
					Case 2
						If bi(j) Then
							Paint (PX(j), PY(idx)), rgba(255,0,0,a), rgba(r,g,b,a)
						Else
							Paint (PX(j), PY(idx)), rgba(63,63,63,127), rgba(r,g,b,a)
						EndIf
					Case 3
						If bi(j) Then
							Paint (PX(j), PY(idx)), rgba(255,0,0,a), rgba(r,g,b,a)
						Else
							Paint (PX(j), PY(idx)), rgba(63,63,63,127), rgba(r,g,b,a)
						EndIf
					Case 4
						If bi(j) Then
							Paint (PX(j), PY(idx)), rgba(255,0,0,a), rgba(r,g,b,a)
						Else
							Paint (PX(j), PY(idx)), rgba(63,63,63,127), rgba(r,g,b,a)
						EndIf
					Case 5
						If bi(j) Then
							Paint (PX(j), PY(idx)), rgba(255,0,0,a), rgba(r,g,b,a)
						Else
							Paint (PX(j), PY(idx)), rgba(63,63,63,127), rgba(r,g,b,a)
						EndIf
				End Select
			Case 1
				Select Case As Const j
					Case 0
						If bi(j) Then
							Paint (PX(j), PY(idx)), rgba(255,0,0,a), rgba(r,g,b,a)
						Else
							Paint (PX(j), PY(idx)), rgba(63,63,63,127), rgba(r,g,b,a)
						EndIf
					Case 1
						If bi(j) Then
							Paint (PX(j), PY(idx)), rgba(255,0,0,a), rgba(r,g,b,a)
						Else
							Paint (PX(j), PY(idx)), rgba(63,63,63,127), rgba(r,g,b,a)
						EndIf
					Case 2
						If bi(j) Then
							Paint (PX(j), PY(idx)), rgba(255,0,0,a), rgba(r,g,b,a)
						Else
							Paint (PX(j), PY(idx)), rgba(63,63,63,127), rgba(r,g,b,a)
						EndIf
					Case 3
						If bi(j) Then
							Paint (PX(j), PY(idx)), rgba(255,0,0,a), rgba(r,g,b,a)
						Else
							Paint (PX(j), PY(idx)), rgba(63,63,63,127), rgba(r,g,b,a)
						EndIf
					Case 4
						If bi(j) Then
							Paint (PX(j), PY(idx)), rgba(255,0,0,a), rgba(r,g,b,a)
						Else
							Paint (PX(j), PY(idx)), rgba(63,63,63,127), rgba(r,g,b,a)
						EndIf
					Case 5
						If bi(j) Then
							Paint (PX(j), PY(idx)), rgba(255,0,0,a), rgba(r,g,b,a)
						Else
							Paint (PX(j), PY(idx)), rgba(63,63,63,127), rgba(r,g,b,a)
						EndIf
				End Select
			Case 2
				Select Case As Const j
					Case 0
						If bi(j) Then
							Paint (PX(j), PY(idx)), rgba(255,0,0,a), rgba(r,g,b,a)
						Else
							Paint (PX(j), PY(idx)), rgba(63,63,63,127), rgba(r,g,b,a)
						EndIf
					Case 1
						If bi(j) Then
							Paint (PX(j), PY(idx)), rgba(255,0,0,a), rgba(r,g,b,a)
						Else
							Paint (PX(j), PY(idx)), rgba(63,63,63,127), rgba(r,g,b,a)
						EndIf
					Case 2
						If bi(j) Then
							Paint (PX(j), PY(idx)), rgba(255,0,0,a), rgba(r,g,b,a)
						Else
							Paint (PX(j), PY(idx)), rgba(63,63,63,127), rgba(r,g,b,a)
						EndIf
					Case 3
						If bi(j) Then
							Paint (PX(j), PY(idx)), rgba(255,0,0,a), rgba(r,g,b,a)
						Else
							Paint (PX(j), PY(idx)), rgba(63,63,63,127), rgba(r,g,b,a)
						EndIf
					Case 4
						If bi(j) Then
							Paint (PX(j), PY(idx)), rgba(255,0,0,a), rgba(r,g,b,a)
						Else
							Paint (PX(j), PY(idx)), rgba(63,63,63,127), rgba(r,g,b,a)
						EndIf
					Case 5
						If bi(j) Then
							Paint (PX(j), PY(idx)), rgba(255,0,0,a), rgba(r,g,b,a)
						Else
							Paint (PX(j), PY(idx)), rgba(63,63,63,127), rgba(r,g,b,a)
						EndIf
				End Select
		End Select
	Next
End Sub
' ----- end local procedures ----- '

' ===== MAIN ===== '
Dim As String Title = "Binary - Clock, MrSwiss made(TM)"	' define 'local var's' to main
Dim As String Help  = "0/32  0/16   0/8   0/4    0/2   0/1"	' show binary 'weight' of digit
WindowTitle "BINARY - Clock"					' instead of "BIN-Clock", the .EXE name ...

Do
	If Time = TStr Then Goto wait4TimeChange	' sleep until second increments
	CLS											' clear screen buffer
	GetTime(hh, mm, ss, TStr)					' once a second: get new values 24h, aka 'system time'
	ScreenLock
	'Paint (0, 0), rgba(255,255,191,127)			' paint BG bright yellow, to 'see' the loaded graphics
	Put (80, 25), dclock, Pset					' graphic for the hour(s)
	Put (80, 75), dclock, Pset					' graphic for the minute(s)
	Put (80,125), dclock, Pset					' graphic for the second(s)
	For i As Long = 0 To 2						' the outlines/contours filling routine ...
		Select Case As Const i
			Case 0
				ConvToBIN(hh, bi())				' get BINARY for hours: hh (reset, then fill bi() array) 
				PaintTime(i, PX(), PY(), bi())	' 'Paint' the graphics accordingly (uses all three arrays)
			Case 1
				ConvToBIN(mm, bi())
				PaintTime(i, PX(), PY(), bi())
			Case 2
				ConvToBIN(ss, bi())
				PaintTime(i, PX(), PY(), bi())
		End Select
	Next
	' dynamically centered string on the .BMP (80+150 pixels = center of graphic [300 x 50 px])
	Draw String (230-((Len(Title)+1)\2)*8, 13), Title, rgba(0,63,191,a)	' blue color
	Draw String (10, 45), "Hour..: ", rgba(r,g,b,a)		' default color, absolute positioning
	Draw String (90, 72), Help, rgba(r,g,b,a)			' display calculation help (bit-weight)
	Draw String (10, 95), "Minute: ", rgba(r,g,b,a)
	Draw String (90, 122), Help, rgba(r,g,b,a)
	Draw String (10, 145), "Second: ", rgba(r,g,b,a)
	Draw String (230-((Len(TStr)+1)\2)*8, 180), TStr, rgba(0,63,191,a)	' blue: Time-String, dyn. centered
	ScreenUnLock
wait4TimeChange:
	Sleep 200, 1
Loop Until InKey = Chr(255)+"k"					' top/right X clicked ... quit prog.

ImageDestroy dclock								' free allocated ressources (image buffer)

End 0											' End closes prog. [errorcode=0], NO error

This code is a typical case of: re-usability = NONE
Focus on 'Job at hand' = YES, ABSOLUTELY (and only that, see above)

[Obsolete]I still don't know how to properly supply the needed *.bmp file, because my available Host is always asking for PWD?
Any suggestions on permissions etc.???[/Obsolete]

[Edit]try this LINK to my OneDrive shared stuff:
http://1drv.ms/1IqOzKA
hope it works ... you should be able to download right away[/Edit]

[D.J.Peters]

Code: Select all

function BinTime(t as string,n as integer) as string
  var b = bin((t[n]-48)*10+(t[n+1]-48),6)
  select case as const n
  case 0 : return " H: " & b
  case 3 : return " M: " & b
  case 6 : return " S: " & b
  end select
end function

sub UpdateTime(t as string)
  cls : ?
  ? BinTime(t,0) : ?
  ? BinTime(t,3) : ?
  ? BinTime(t,6) : ?
  ? "  " & t
end sub

screenres 11*8,9*8,,,8
dim as string * 8 oldTime
while inkey()=""
  dim as string * 8 nowTime = Time()
  if nowTime<>oldTime then 
    UpdateTime nowTime
    oldTime=nowTime
  end if
  sleep 250,1
wend

[MrSwiss]

Hi all,

the second version of the Digi-Clock:

• smaller DigiIFsq.bmp, 50 x 50px, used 17 times
  recoded procedures
  added error checking (file load)
  compiler decided Window Title (intrinsic defines used)

The link to the needed BMP: http://1drv.ms/1DloGKq

The code (DIGI-Clock.bas) below:

Code: Select all

' ================================================================== '
' BINARY Clock (incl. Digital & Help) 'MrSwiss  made'™ Version is:
' 2.0 = recoded, commented and tested: (details below)
' ------------------------------------------------------------------ '
' Copyright © 2015, MrSwiss
' ALL RIGHTS RESERVED! NO COMMERCIAL/EDUCATIONAL USE WHATSOEVER! THIS
' INCLUDES ANY FORM OF DISTRIBUTION IN ANY FORM AND BY ANY MEANS!
' NO WARRANTIES AT ALL ANYWHWERE IN THE WORLD! THE USER TAKES ANY AND
' ALL RISKS! THE AUTHOR DISCLAIMS ANY RESPONSIBILITY FOR ANY TYPE OF
' DAMAGE(S) CAUSED BY THIS CODE! IF IN DOUBT, DON'T USE IT AT ALL!
' FREE FOR PERSONAL, NONPROFIT USE ONLY. GOVERNMENTS: NOT PERMITTED!
' ------------------------------------------------------------------ '
' PLAIN TEXT: Don't LIKE it, don't USE it! It's as simple as that.
' ================================================================== '
' TESTED: with FreeBASIC Compiler Ver. 1.03.0, 32bit and 64bit (WIN)
' COMPILE WITH:  -s gui  (compiler switch), see manual for details
' COMPILER LANGUAGE: "fb" (only, no support for deprecated options!)
' ------------------------------------------------------------------ '
' CREDITS GO TO:	no contributors
' 					idea and coding & graphics by MrSwiss
' ================================================================== '

ScreenRes 400, 200, 32					' screen setup: width, height, bit depth

Dim Shared As Long PX(5), PY(2), bi(5)	' global access to arrays
Dim As Long		hh, mm, ss, res
Dim As UByte	r=0, g=0, b=0, a=255	' default color = black, opaque
Dim As String	TStr

Dim As Any Ptr dclock = ImageCreate(50, 50,, 32)' create 'clock face' buffer
res = Bload (ExePath & "\DigiIFsq.bmp", dclock)	' fill the buffer with the .BMP Graphic
If res Then								' if .bmp not found, inform user and quit
	Draw String (55, 88), "DigiIFsq.bmp not found, aborting ...", rgb(255,95,95)
	Draw String (55,102), "Location: the same as BIN-Clock.exe!", rgb(255,191,0) 
	Sleep : ImageDestroy dclock	: End 1	' free used ressources,return errorlevel=1
EndIf
Color rgba(r,g,b,a), rgba(255,255,255,a)' black on white BG

' initialize the arrays PX(), PY() (without typing too much), defines _
' the Paint 'Points (x, y)' used later by 'DoPaint' Sub
For i As Long = 0 To 5
	PX(i) = 105 + i*50					' the 105 is the starting point (80+25) _
Next									' + i*50 is the increment by 50
For i As Long = 0 To 2
	PY(i) = 50 + i*50
Next


' ----- local procedures ----- '
Sub GetTime(ByRef hh As Long, ByRef mm As Long, ByRef ss As Long, ByRef TStr As String)
	TStr = Time
	hh = Val(Left(TStr, 2))
	mm = Val(Mid(TStr, 4, 2))
	ss = Val(Right(TStr, 2))
End Sub


Sub ConvToBIN(ByVal Num As Long)
	' reset array to 0 (all positions) to have a defined start ...
	For i As Long = 0 To 5
		bi(i) = 0								' 0 = false, using Long's as Boolean's
	Next
	' we now only have to set the 'proper' bits: max. is 59 Min/Sec (max. 6 bits), _
	' set bi() and get/set the 'remainder' ... no Boolean's in Ver. 1.03.0 yet!
	If Num >= 32 Then bi(0) = 1 : Num mod= 32	' assign top down ...
	If Num >= 16 Then bi(1) = 1 : Num mod= 16	' 1 = true (C-style), in FB = -1
	If Num >= 8  Then bi(2) = 1 : Num mod= 8
	If Num >= 4  Then bi(3) = 1 : Num mod= 4
	If Num >= 2  Then bi(4) = 1 : Num mod= 2
	If Num  = 1  Then bi(5) = 1
End Sub


Sub DoPaint (ByVal y As Long, ByVal a As UByte)	' a = alpha channel (color)
	For i As Long = 0 To 5
		If i = 0 AndAlso y = 0 Then
			Draw String (PX(i)-12, PY(y)-10), "NOT", rgba(159,159,159,a)' bright grey
			Draw String (PX(i)-16, PY(y)), "used", rgba(159,159,159,a)
		Else
			If bi(i) = 1 Then 
				Paint (PX(i), PY(y)), rgba(255,0,0,a), rgba(0,0,0,a)	' red (active)
			Else
				Paint (PX(i), PY(y)), rgba(91,91,91,127), rgba(0,0,0,a)	' dark grey, semi trans.
			EndIf
		EndIf
	Next
End Sub
' ----- end local procedures ----- '

' ===== MAIN ===== '
Dim As String Title = "Binary - Clock, MrSwiss made(TM)"	' define 'local var's' to main
Dim As String Help  = "0/32  0/16   0/8   0/4    0/2   0/1"	' show binary 'weight' of digit
#IfDef __FB_WIN32__	' Compiler decision: Title used instead of "BIN-Clock", the .EXE name ...
WindowTitle "BINARY - ClockV2 - x32"
#EndIf	' __FB_WIN32__
#IfDef __FB_64BIT__
WindowTitle "BINARY - ClockV2 - x64"
#EndIf	' __FB_64BIT__
' NOTE: on other operating systems the relevant intrinsic defines needed (this is WIN only)

Do
	If Time <> TStr Then						' sleep until second increments
		CLS								' clear screen buffer
		GetTime(hh, mm, ss, TStr)				' once a second: get new values 24h, aka 'system time'
		ScreenLock
		'Paint (0, 0), rgba(255,255,191,127)		' paint BG bright yellow, to 'see' the loaded graphics
		For j As Long = 25 To 125 Step 50		' y-axis (3 times)
			For i As Long = 80 To 330 Step 50	' x-axis (6	times, except in first row(5), see below)
				If i = 80 AndAlso j = 25 Then	' if it is the left/top pos. (not needed), do nothing
				Else
					Put (i, j), dclock, Pset	' plaster the image (50x50px), 17 times to screen
				EndIf
			Next
		Next
		For i As Long = 0 To 2					' the outlines/contours filling routine ...
			Select Case As Const i
				Case 0
					ConvToBIN(hh)			' get BINARY for hours: hh (reset, then fill bi() array) 
					DoPaint(i, a)			' 'Paint' the graphics accordingly (uses all three arrays)
				Case 1
					ConvToBIN(mm)
					DoPaint(i, a)
				Case 2
					ConvToBIN(ss)
					DoPaint(i, a)
			End Select
		Next
		' dynamically centered string on the .BMP's (80+150 pixels = center of graphics [50 x 50px x 6])
		Draw String (230-((Len(Title)+1)\2)*8, 13), Title, rgba(0,63,127,a)	' dark blue
		Draw String (10, 45), "Hour..: ", rgba(r,g,b,a)	' default color
		Draw String (90, 72), Help, rgba(r,g,b,a)		' display calculation help (bit-weight)
		Draw String (10, 95), "Minute: ", rgba(r,g,b,a)
		Draw String (90, 122), Help, rgba(r,g,b,a)
		Draw String (10, 145), "Second: ", rgba(r,g,b,a)
		Draw String (230-((Len(TStr)+1)\2)*8, 180), TStr, rgba(0,63,127,a)	' d-blue: Time-String, dyn. centered
		ScreenUnLock
	EndIf
	Sleep 200, 1
Loop Until InKey() = chr(255)+"k"					' until the X is clicked (top/right of window)

ImageDestroy dclock								' free allocated ressources (image buffer)
End 0											' finished ... errorlevel=0, for batch use

[MrSwiss]

Hi all,

Binary Clock, revisited (aka: Version 3.0), New/Changed:

• No more external *.bmp File
• only a single Sub GetBinTime()
• NEW Method to set the Booleans
• uses a Type now to hold Boolean array's
• different Color for Hour/Min./Sec.
• etc. see source code/Comments ...

BinClock.bas:

Code: Select all

' BINARY Clock Version 3.0 - (c) MrSwiss - 2016-09-07/11
' -------------------------------------------------------------------
' Copyright (c) 2016-09-11, MrSwiss (ISO Date Format)
' File Name: BinClock.bas (tested: WIN32/64 | FBC 1.05.0)
' intended use: GUI only! compile using: -s gui
' -------------------------------------------------------------------
' LICENSE:    A donation to the FB-Community! Free for use 'as is'!
' EXCEPTION:  Any and all publishing rights remain exclusively mine!
' WARRANTY:   NONE AT ALL, USE AT YOUR OWN RISK! NO EXCEPTIONS!
' PROHIBITED: Removal of any or all of the above notice(s)!
' -------------------------------------------------------------------

Const As ULong black = &hFF000000, white = &hFFFFFFFF ' Color Const's
Const As ULong trns = &h00FF00FF, grey = &hFF8F8F8F, dgrey = &hFF3F3F3F
Const As ULong red = &hFFFF0000, green = &hFF00FF00, blue = &hFF004FFF

Const As UInteger scrw = 351, scrh = 201 ' Screen Const's

Type BTime ' our Data-Struct(ure)
	As UByte	Seconds ' keeps the last 'updated to' Second
	As Boolean	BTh(2 To 6) ' Booleans used as BIN-Array: hr.
	As Boolean	BTm(1 To 6) ' min.
	As Boolean	BTs(1 To 6) ' sec.
End Type
Dim As BTime BinT ' Size: 18 Bytes

Sub GetBinTime( ByRef B_T As BTime )
	Var ts = Time	' Time-String, current Time
	Static As UByte hh, mm, ss 

	' first: erase all set Booleans to FALSE (hour, min., sec.) in the Type
	For e As UInteger = 2 To 6 : B_T.BTh(e) = FALSE : Next
	For e As UInteger = 1 To 6 : B_T.BTm(e) = FALSE : B_T.BTs(e) = FALSE : Next

	hh = CUByte(Left(ts, 2))   ' Hour: from String
	mm = CUByte(Mid(ts, 4, 2)) ' Minute: dito
	ss = CUByte(Right(ts, 2)) : B_T.Seconds = ss ' store last update (Sec.)

	For p As UInteger = 1 To 3 ' setting the correct Booleans to TRUE
		With B_T               ' (saves a certain amount of typing)
		Select Case As Const p ' whole eval. is 'inlined' here (for speed!) _
			Case 1             ' instead of calling a external procedure
				Var bs = Bin(hh, 8)        ' binary string
				For b As UInteger = 2 To 6 ' hh range = 0 - 23
					.BTh(b) = bs[b+1] - 48 ' actually: bs[b+2-1], adj. index
				Next
			Case 2
				Var bs = Bin(mm, 8)
				For b As UInteger = 1 To 6 ' mm range = 0 - 59
					.BTm(b) = bs[b+1] - 48
				Next
			Case 3
				Var bs = Bin(ss, 8)
				For b As UInteger = 1 To 6 ' ss range = 0 - 59
					.BTs(b) = bs[b+1] - 48
				Next
		End Select
		End With
	Next
End Sub

ScreenRes(scrw, scrh, 32)
Color black, white : Cls

Dim As Any Ptr IMG = ImageCreate(scrw, scrh,,32)

For j As UInteger = 1 To 3
	Var y = j * 50
	For i As UInteger = 1 To 6
		Var x = i * 50
		Circle IMG, (x, y), 23, black,,,, F
		Circle IMG, (x, y), 17, trns,,,, F
	Next
Next
Circle IMG, (50, 50), 23, white,,,, F ' top/left - hour = never used!
Draw String IMG, ( 29, 10), "red=Hrs." + Space(4) + "green=Mins." + Space(4) + "blue=Secs.", black
Draw String IMG, ( 39, 41), "24h", dgrey : Draw String IMG, ( 31, 52), "Clock", dgrey
Draw String IMG, (113,183), "MrSwiss made(TM)", black

Do
	If BinT.Seconds <> CUByte(Right(Time, 2)) Then ' once a Second only
		GetBinTime(BinT)
		
		ScreenLock
		Cls : Put (0, 0), IMG, Trans
		
		For j As UInteger = 1 To 3
			Var y = j * 50
			For i As UInteger = 1 To 6
				Var x = i * 50
				If j = 1 AndAlso i = 1 Then
					' don't do anything!
				Else
					Select Case As Const j
						Case 1
							If BinT.BTh(i) Then Circle (x, y), 17, red,,,, F _
								Else Circle (x, y), 17, grey,,,, F
						Case 2
							If BinT.BTm(i) Then Circle (x, y), 17, green,,,, F _
								Else Circle (x, y), 17, grey,,,, F
						Case 3
							If BinT.BTs(i) Then Circle (x, y), 17, blue,,,, F _
								Else Circle (x, y), 17, grey,,,, F
					End Select
				EndIf
			Next
		Next
		ScreenUnLock
	EndIf

	Sleep 200, 1 ' precision <= 200mS
Loop Until Len(InKey())

ImageDestroy(IMG)

[jdmcbride]

These are so awesome. I'm a nerd and i'm grinning ear-to-ear!

[MrSwiss]

These are so awesome. I'm a nerd and i'm grinning ear-to-ear!

Glad you like them ...

A lil update to Version 3.0 --> 3.01:

• X click, now the only method to close (prevents unwanted close by "any key")
• compiled program now shows the used Type/Version of FBC in Title Bar.
• added a few more comments in source

See code or FBC Type&Version ...

BinClock.bas (Ver. 3.01):

Code: Select all

' BINARY Clock Version 3.01 - Copyright (c) MrSwiss - 2016-09-07/13
' ---------------------------------------------------------------------------
' Copyright (c) 2016-09-13, MrSwiss (ISO Date Format)
' File Name: BinClock.bas (tested: WIN32/64 | FBC 1.05.0 | FBC x64 1.06.0)
' intended use: GUI only! compile using: -s gui
' ---------------------------------------------------------------------------
' LICENSE:    A donation to the FB-Community! Free for use 'as is'!
' EXCEPTION:  Any and all publishing rights remain exclusively mine!
' WARRANTY:   NONE AT ALL, USE AT YOUR OWN RISK! NO EXCEPTIONS WHATSOEVER!
' PROHIBITED: Removal of any or all of the above notice(s) icnl. this one!
' ---------------------------------------------------------------------------

Const As ULong black = &hFF000000, white = &hFFFFFFFF ' Color Const's
Const As ULong trns = &h00FF00FF, grey = &hFF8F8F8F, dgrey = &hFF3F3F3F
Const As ULong red = &hFFFF0000, green = &hFF00FF00, blue = &hFF004FFF

Const As UInteger scrw = 351, scrh = 201 ' Screen Const's
Const As String   PROG = "BIN-Clock V3.01 " ' leave a 'spacer'
Const As String   FBTV = "x" + Str(SizeOf(Any Ptr) * 8) + _ ' x32/x64
                         " - FBC " + __FB_VERSION__ ' and Version

Type BTime ' our Data-Struct(ure)
	As UByte	Seconds ' keeps the last 'updated to' Second
	As Boolean	BTh(2 To 6) ' Booleans used as BIN-Array: hr.
	As Boolean	BTm(1 To 6) ' min.
	As Boolean	BTs(1 To 6) ' sec.
End Type
Dim As BTime BinT ' Size: 18 Bytes

Sub GetBinTime( ByRef B_T As BTime )
	Var ts = Time	' Time-String, current Time
	Static As UByte hh, mm, ss 

	' first: erase all set Booleans to FALSE (hour, min., sec.) in the Type
	For e As UInteger = 2 To 6 : B_T.BTh(e) = FALSE : Next
	For e As UInteger = 1 To 6 : B_T.BTm(e) = FALSE : B_T.BTs(e) = FALSE : Next

	hh = CUByte(Left(ts, 2))   ' Hour: from String
	mm = CUByte(Mid(ts, 4, 2)) ' Minute: dito
	ss = CUByte(Right(ts, 2)) : B_T.Seconds = ss ' store last update (Sec.)

	For p As UInteger = 1 To 3 ' setting the correct Booleans to TRUE
		With B_T               ' (saves a certain amount of typing)
		Select Case As Const p ' whole eval. is 'inlined' here (for speed!) _
			Case 1             ' instead of calling a external procedure
				Var bs = Bin(hh, 8)        ' binary string
				For b As UInteger = 2 To 6 ' hh range = 0 - 23
					.BTh(b) = bs[b+1] - 48 ' actually: bs[b+2-1], adj. index
				Next
			Case 2
				Var bs = Bin(mm, 8)
				For b As UInteger = 1 To 6 ' mm range = 0 - 59
					.BTm(b) = bs[b+1] - 48
				Next
			Case 3
				Var bs = Bin(ss, 8)
				For b As UInteger = 1 To 6 ' ss range = 0 - 59
					.BTs(b) = bs[b+1] - 48
				Next
		End Select
		End With
	Next
End Sub

' ===== MAIN =====
' set up screen
ScreenRes(scrw, scrh, 32)
WindowTitle PROG + FBTV ' program info + FBC Type(x32/x64) & Version info
Color black, white : Cls

' set up the Clock-Face (all that's static in IMG)
Dim As Any Ptr IMG = ImageCreate(scrw, scrh, trns, 32)

For j As UInteger = 1 To 3
	Var y = j * 50
	For i As UInteger = 1 To 6
		Var x = i * 50
		Circle IMG, (x, y), 23, black,,,, F
		Circle IMG, (x, y), 17, trns,,,, F
	Next
Next
Circle IMG, (50, 50), 23, trns,,,, F ' top/left - hour = never used! (overwrite: transparent Color)
Draw String IMG, ( 29, 10), "red=Hrs." + Space(4) + "green=Mins." + Space(4) + "blue=Secs.", black
Draw String IMG, ( 39, 41), "24h", dgrey : Draw String IMG, ( 31, 52), "Clock", dgrey
Draw String IMG, (113,183), "MrSwiss made(TM)", black
' end of init IMG

Do
	If BinT.Seconds <> CUByte(Right(Time, 2)) Then ' once a Second only
		GetBinTime(BinT)
		
		ScreenLock
		Cls : Put (0, 0), IMG, Trans
		
		For j As UInteger = 1 To 3
			Var y = j * 50
			For i As UInteger = 1 To 6
				Var x = i * 50
				If j = 1 AndAlso i = 1 Then
					' don't do anything!
				Else
					Select Case As Const j
						Case 1
							If BinT.BTh(i) Then Circle (x, y), 17, red,,,, F _
								Else Circle (x, y), 17, grey,,,, F
						Case 2
							If BinT.BTm(i) Then Circle (x, y), 17, green,,,, F _
								Else Circle (x, y), 17, grey,,,, F
						Case 3
							If BinT.BTs(i) Then Circle (x, y), 17, blue,,,, F _
								Else Circle (x, y), 17, grey,,,, F
					End Select
				EndIf
			Next
		Next
		ScreenUnLock
	EndIf

	Sleep 200, 1 ' precision <= 200mS
Loop Until InKey() = Chr(255, 107)	' X click to quit
' release allocated MEM, reset Pointer ...
ImageDestroy(IMG) : IMG = 0