Binary Clock Screensaver

This screensaver shows the LED Binary Clock on the desktop. It can be used as a screensaver or as a regular app.
It has features such as:
* Can use UTC instead of local timezone
* Use a different TimeZone rather than what windows was setup for.
* Can display 12-hour format time(default) or 24-hour format.
* Can change the way things look in it, such as LED Colors,LED Styles, Background color and font.
Make sure you save the download and not run it.

ScreenShot

program binclock;
// filename: binclock.dpr
uses
  Forms,windows,sysutils,
  binclockUnit1 in 'binclockUnit1.pas' {BinClockWND},
  binclockUnit2 in 'binclockUnit2.pas' {BinClockSCR};

{$E scr}

{$R *.RES}

begin
if StrIComp('/p',PChar(paramstr(1)))=0then exitprocess(0);
  Application.Initialize;
  Application.CreateForm(TBinClockWND, BinClockWND);
  Application.CreateForm(TBinClockSCR, BinClockSCR);
  Application.Run;
end.
//filename binclockunit1.pas
unit binclockUnit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Menus;
CONST Current_Version='v1.0';
type
  TBinClockWND = class(TForm)
    Hour10: TShape;
    Hour20: TShape;
    Hour1: TShape;
    Hour2: TShape;
    Hour4: TShape;
    Hour8: TShape;
    Minute10: TShape;
    Minute20: TShape;
    Minute40: TShape;
    Minute1: TShape;
    Minute2: TShape;
    Minute4: TShape;
    Minute8: TShape;
    Seconds10: TShape;
    Seconds20: TShape;
    Seconds40: TShape;
    Seconds1: TShape;
    Seconds2: TShape;
    Seconds4: TShape;
    Seconds8: TShape;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    Settings1: TMenuItem;
    UTCTime1: TMenuItem;
    N24Hour1: TMenuItem;
    Graphics1: TMenuItem;
    ColorDialog1: TColorDialog;
    N0Color1: TMenuItem;
    N1Color1: TMenuItem;
    BackgroundColor1: TMenuItem;
    LEDShapes1: TMenuItem;
    Circle1: TMenuItem;
    Square1: TMenuItem;
    LEDStyes1: TMenuItem;
    Solid1: TMenuItem;
    Cross1: TMenuItem;
    DiagCross1: TMenuItem;
    Horizontial1: TMenuItem;
    Vertical1: TMenuItem;
    BDiagonal1: TMenuItem;
    FDiagonal1: TMenuItem;
    TimeZone1: TMenuItem;
    Help1: TMenuItem;
    AboutBinaryClock1: TMenuItem;
    Font1: TMenuItem;
    FontDialog1: TFontDialog;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure UTCTime1Click(Sender: TObject);
    procedure N24Hour1Click(Sender: TObject);
    procedure Circle1Click(Sender: TObject);
    procedure N0Color1Click(Sender: TObject);
    procedure N1Color1Click(Sender: TObject);
    procedure BackgroundColor1Click(Sender: TObject);
    procedure Solid1Click(Sender: TObject);
    procedure TimeZone1Click(Sender: TObject);
    procedure AboutBinaryClock1Click(Sender: TObject);
    procedure Font1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TGetTimeProc=procedure(var st:systemtime);stdcall;
  TBCFont=record
  Styles:tfontstyles;
  color:tcolor;
  name:shortstring;
  size:integer;
  end;
  TGraphicSettings=record
  color0,color1,background:tcolor;
  shape:tshapetype;
  Style:TBrushstyle;
  CustomColors:Array['A'..'P']of tcolor;
  Font:tbcfont;
  end;
var
  GetTimeID,timeformat:dword;
  clockout:tcanvas;
  mode:byte;
  timezone:shortint=24;
  GraphicSettings:TGraphicSettings;
  hkusr:hkey;
  GetTime:tgettimeproc;
  BinClockWND: TBinClockWND;
const btimefmt:array[boolean]of byte=(12,24);

implementation

uses binclockUnit2;

{$R *.DFM}

procedure UpdateLabels(const labels:array of tlabel);
var i:integer;
begin
{
Update the fonts on TLabel VCL Components.
}
if graphicsettings.Font.size=0then exit;
for i:=0to length(labels)-1do
begin
labels[i].font.Color:=graphicsettings.Font.color;
labels[i].font.Style:=graphicsettings.Font.styles;
labels[i].font.Name:=graphicsettings.Font.name;
labels[i].font.Size:=graphicsettings.Font.size;
end;
end;

function systime(var st:systemtime):tdatetime;
begin
result:=encodetime(st.whour,st.wminute,st.wsecond,0);
if timezone<>24then begin if timezone<0then result:=result-encodetime(abs(
timezone),0,0,0)else result:=result+encodetime(abs(timezone),0,0,0);end;
end;

function ClockThread(p:pointer):Dword;stdcall;
var digit1,digit10:byte;
st:systemtime;
t:tdatetime;
r:trect;
screenbmp:tbitmap;
strTimeFormat:String;
label loop;
begin
{
This function is the thread that makes the clock tick!
}
case mode of
1:getwindowrect(getdesktopwindow,r);
2:getwindowrect(strtoint(paramstr(2)),r);
end;
r.Left:=0;r.Top:=0;
loop:
if timeformat=12then strtimeformat:=' AMPM';
if timeformat=24then strtimeformat:='';
gettime(st); t:=systime(st);
 digit10:=strtoint(formatdatetime('hh'+strtimeformat,t)[1]);
digit1:=strtoint(formatdatetime('hh'+strtimeformat,t)[2]);
BinCLockWND.Label5.Caption:=Inttostr(digit10);
binclockwnd.Label6.Caption:=inttostr(digit1);
if digit1 and 1>0then binclockwnd.Hour1.Brush.Color:=graphicsettings.color1 else
binclockwnd.hour1.Brush.Color:=graphicsettings.color0;
if digit1 and 2>0then binclockwnd.Hour2.Brush.Color:=graphicsettings.color1 else
binclockwnd.hour2.Brush.Color:=graphicsettings.color0;
if digit1 and 4>0then binclockwnd.Hour4.Brush.Color:=graphicsettings.color1 else
binclockwnd.hour4.Brush.Color:=graphicsettings.color0;
if digit1 and 8>0then binclockwnd.Hour8.Brush.Color:=graphicsettings.color1 else
binclockwnd.hour8.Brush.Color:=graphicsettings.color0;
if digit10 and 1>0then binclockwnd.Hour10.Brush.Color:=graphicsettings.color1 else
binclockwnd.hour10.Brush.Color:=graphicsettings.color0;
if digit10 and 2>0then binclockwnd.Hour20.Brush.Color:=graphicsettings.color1 else
binclockwnd.hour20.Brush.Color:=graphicsettings.color0;
digit10:=strtoint(formatdatetime('nn',t)[1]);
digit1:=strtoint(formatdatetime('nn',t)[2]);
BinCLockWND.Label7.Caption:=Inttostr(digit10);
binclockwnd.Label8.Caption:=inttostr(digit1);
if digit1 and 1>0then binclockwnd.MInute1.Brush.Color:=graphicsettings.color1 else
binclockwnd.Minute1.Brush.Color:=graphicsettings.color0;
if digit1 and 2>0then binclockwnd.Minute2.Brush.Color:=graphicsettings.color1 else
binclockwnd.Minute2.Brush.Color:=graphicsettings.color0;
if digit1 and 4>0then binclockwnd.Minute4.Brush.Color:=graphicsettings.color1 else
binclockwnd.Minute4.Brush.Color:=graphicsettings.color0;
if digit1 and 8>0then binclockwnd.Minute8.Brush.Color:=graphicsettings.color1 else
binclockwnd.Minute8.Brush.Color:=graphicsettings.color0;
if digit10 and 1>0then binclockwnd.Minute10.Brush.Color:=graphicsettings.color1 else
binclockwnd.Minute10.Brush.Color:=graphicsettings.color0;
if digit10 and 2>0then binclockwnd.Minute20.Brush.Color:=graphicsettings.color1 else
binclockwnd.Minute20.Brush.Color:=graphicsettings.color0;
if digit10 and 4>0then binclockwnd.Minute40.Brush.Color:=graphicsettings.color1 else
binclockwnd.Minute40.Brush.Color:=graphicsettings.color0;
digit10:=strtoint(formatdatetime('ss',t)[1]);
digit1:=strtoint(formatdatetime('ss',t)[2]);
BinCLockWND.Label9.Caption:=Inttostr(digit10);
binclockwnd.Label10.Caption:=inttostr(digit1);
if digit1 and 1>0then binclockwnd.Seconds1.Brush.Color:=graphicsettings.color1 else
binclockwnd.Seconds1.Brush.Color:=graphicsettings.color0;
if digit1 and 2>0then binclockwnd.Seconds2.Brush.Color:=graphicsettings.color1 else
binclockwnd.Seconds2.Brush.Color:=graphicsettings.color0;
if digit1 and 4>0then binclockwnd.Seconds4.Brush.Color:=graphicsettings.color1 else
binclockwnd.Seconds4.Brush.Color:=graphicsettings.color0;
if digit1 and 8>0then binclockwnd.Seconds8.Brush.Color:=graphicsettings.color1 else
binclockwnd.Seconds8.Brush.Color:=graphicsettings.color0;
if digit10 and 1>0then binclockwnd.Seconds10.Brush.Color:=graphicsettings.color1 else
binclockwnd.Seconds10.Brush.Color:=graphicsettings.color0;
if digit10 and 2>0then binclockwnd.Seconds20.Brush.Color:=graphicsettings.color1 else
binclockwnd.Seconds20.Brush.Color:=graphicsettings.color0;
if digit10 and 4>0then binclockwnd.Seconds40.Brush.Color:=graphicsettings.color1 else
binclockwnd.Seconds40.Brush.Color:=graphicsettings.color0;
if(mode>0)then begin screenbmp:=binclockwnd.GetFormImage;
 binclockscr.Canvas.StretchDraw(r,screenbmp);
 screenbmp.Free;end;
 sleep(1000);
goto loop;
end;

procedure UpdateShapes;
begin
{
Update TShape components colors and styles
}
with binclockwnd do begin
hour1.Shape:=graphicsettings.shape;
hour2.Shape:=graphicsettings.shape;
hour4.Shape:=graphicsettings.shape;
hour8.Shape:=graphicsettings.shape;

hour10.Shape:=graphicsettings.shape;
hour20.Shape:=graphicsettings.shape;
minute40.Shape:=graphicsettings.shape;
minute1.Shape:=graphicsettings.shape;
minute2.Shape:=graphicsettings.shape;
minute4.Shape:=graphicsettings.shape;
minute8.Shape:=graphicsettings.shape;
minute10.Shape:=graphicsettings.shape;
minute20.Shape:=graphicsettings.shape;
seconds40.Shape:=graphicsettings.shape;
seconds1.Shape:=graphicsettings.shape;
seconds2.Shape:=graphicsettings.shape;
seconds4.Shape:=graphicsettings.shape;
seconds8.Shape:=graphicsettings.shape;
seconds10.Shape:=graphicsettings.shape;
seconds20.Shape:=graphicsettings.shape;
hour1.brush.style:=graphicsettings.style    ;
hour2.brush.style:=graphicsettings.style    ;
hour4.brush.style:=graphicsettings.style    ;
hour8.brush.style:=graphicsettings.style    ;
hour10.brush.style:=graphicsettings.style   ;
hour20.brush.style:=graphicsettings.style   ;
minute40.brush.style:=graphicsettings.style ;
minute1.brush.style:=graphicsettings.style  ;
minute2.brush.style:=graphicsettings.style  ;
minute4.brush.style:=graphicsettings.style  ;
minute8.brush.style:=graphicsettings.style  ;
minute10.brush.style:=graphicsettings.style ;
minute20.brush.style:=graphicsettings.style ;
seconds40.brush.style:=graphicsettings.style;
seconds1.brush.style:=graphicsettings.style ;
seconds2.brush.style:=graphicsettings.style ;
seconds4.brush.style:=graphicsettings.style ;
seconds8.brush.style:=graphicsettings.style ;
seconds10.brush.style:=graphicsettings.style;
seconds20.brush.style:=graphicsettings.style;
end;
end;

procedure TBinClockWND.FormCreate(Sender: TObject);
var rs,tid:dword;
byt:byte;
begin
mode:=0;
zeromemory(@graphicsettings,sizeof(graphicsettings));
graphicsettings.color0:=clWhite;
graphicsettings.color1:=clred;
graphicsettings.background:=clblack;
graphicsettings.shape:=stcircle;
graphicsettings.Style:=bssolid;
if stricomp('/p',pchar(paramstr(1)))=0 then mode:=2;//mode 2 is reserved for newer versions
if stricomp('/s',pchar(Paramstr(1)))=0then mode:=1;
rs:=4;
gettimeid:=0;
timeformat:=12;
regcreatekey(hkey_current_user,'Software\Justin\BinClock',hkusr);
regqueryvalueex(hkusr,'GetTimeProc',nil,nil,@gettimeid,@rs);
rs:=4;
regqueryvalueex(hkusr,'TimeFormat',nil,nil,@timeformat,@rs);
rs:=sizeof(graphicsettings);
n24hour1.Checked:=(timeformat=24);
utctime1.Checked:=(gettimeid=1);
regqueryvalueex(hkusr,'Graphics',nil,nil,@graphicsettings,@rs);
updateshapes;
for byt:=byte('A')to Byte('P')do colordialog1.CustomColors.Values[format('Color%s',
[chr(byt)])]:=inttohex(graphicsettings.customcolors[chr(byt)],6);
circle1.Checked:=(hour1.Shape=stcircle);
square1.Checked:=(hour1.Shape=stsquare);
case gettimeid of
1:@gettime:=@getsystemtime;
0:@gettime:=@GetLocalTime;
end;
updatelabels([label1,label2,label3,label4,label5,label6,label7,label8,label9,
label10]);
rs:=sizeof(timezone);
regqueryvalueex(hkusr,'TimeZone',nil,nil,@timezone,@rs);
if timezone<>24then @gettime:=@getsystemtime;
createthread(nil,0,@clockthread,nil,0,tid);
circle1.Tag:=Integer(stCircle);
square1.Tag:=integer(stsquare);
cross1.Tag:=integer(bscross);{some of the menu items tag are typecasted to a integer}
solid1.Tag:=integer(bssolid);
diagcross1.Tag:=Integer(bsDiagCross);
horizontial1.Tag:=Integer(bsHorizontal);
vertical1.Tag:=integer(bsvertical);
bdiagonal1.Tag:=integer(bsbdiagonal);
fdiagonal1.Tag:=integer(bsfdiagonal);
cross1.Checked:=(hour1.Brush.Style=bscross);
solid1.checked:=(hour1.Brush.Style= bssolid);
diagcross1.checked:=(hour1.Brush.Style= bsDiagCross);
horizontial1.checked:=(hour1.brush.style=bsHorizontal);
vertical1.checked:=(hour1.brush.style=bsvertical);
bdiagonal1.checked:=(hour1.Brush.style=bsbdiagonal);
fdiagonal1.checked:=(hour1.brush.style=bsfdiagonal);

end;

procedure TBinClockWND.Timer1Timer(Sender: TObject);
begin
if(mode=1)then begin showwindow(handle,sw_hide);
showwindow(application.handle,sw_hide);
timer1.Enabled:=false;
end;
timer1.Enabled:=false;
end;

procedure TBinClockWND.FormClose(Sender: TObject;
  var Action: TCloseAction);
var byt:byte;
begin
//this closes registry keys and saves settings on closing
for byt:=byte('A')to byte('P')do
graphicsettings.CustomColors[chr(byt)]:=strtointdef( '$'+
colordialog1.CustomColors.Values[format('Color%s',[chr(byt)])],0);
regsetvalueex(hkusr,'Graphics',0,reg_binary,@graphicsettings,sizeof(graphicsettings));
regsetvalueex(hkusr,'TimeFormat',0,reg_dword,@timeformat,4);
regsetvalueex(hkusr,'GetTimeProc',0,reg_dword,@gettimeid,4);
regsetvalueex(hkusr,'TimeZone',0,reg_binary,@timezone,sizeof(timezone));
regclosekey(hkusr);
end;

procedure TBinClockWND.UTCTime1Click(Sender: TObject);
begin
utctime1.Checked:=not utctime1.Checked;
gettimeid:=Byte(utctime1.checked);
if utctime1.Checked then @gettime:=@getsystemtime else
@gettime:=@getlocaltime;
end;

procedure TBinClockWND.N24Hour1Click(Sender: TObject);
begin
n24hour1.Checked:=not n24hour1.Checked;
timeformat:=btimefmt[n24hour1.checked];
end;

procedure TBinClockWND.Circle1Click(Sender: TObject);
begin
circle1.Checked:=false;
square1.Checked:=false;
tmenuitem(sender).checked:=true;
graphicsettings.shape:=tshapetype(tmenuitem(sender).tag);
updateshapes;
end;

procedure TBinClockWND.N0Color1Click(Sender: TObject);
begin
colordialog1.Color:=graphicsettings.color0;
if not colordialog1.Execute then exit;
graphicsettings.color0:=colordialog1.Color;
end;

procedure TBinClockWND.N1Color1Click(Sender: TObject);
begin
colordialog1.Color:=graphicsettings.color1;
if not colordialog1.Execute then exit;
graphicsettings.color1:=colordialog1.Color;
end;

procedure TBinClockWND.BackgroundColor1Click(Sender: TObject);
begin
colordialog1.Color:=graphicsettings.background;
if not colordialog1.Execute then exit;
graphicsettings.background:=colordialog1.Color;
color:=colordialog1.Color;
end;

procedure TBinClockWND.Solid1Click(Sender: TObject);
begin
cross1.Checked:=false;
solid1.checked:=false;
diagcross1.checked:=false;
horizontial1.checked:=false;
vertical1.checked:=false;
bdiagonal1.checked:=false;
fdiagonal1.checked:=false;
tmenuitem(sender).checked:=true;
graphicsettings.Style:=tbrushstyle(tmenuitem(sender).tag);
updateshapes;
end;

procedure TBinClockWND.TimeZone1Click(Sender: TObject);
var hours:string;
begin
if not inputquery('Enter Hour Offset','Offset from UTC,24=disabled',hours)then
exit;
timezone:=strtointdef(hours,24);
end;

procedure GetBuildInfo(var V1, V2, V3, V4: word);
var
  VerInfoSize, VerValueSize, Dummy: DWORD;
  VerInfo: Pointer;
  VerValue: PVSFixedFileInfo;
begin
  VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy);
  if VerInfoSize > 0 then
  begin
      GetMem(VerInfo, VerInfoSize);
      try
        if GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo) then
        begin
          VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
          with VerValue^ do
          begin
            V1 := dwFileVersionMS shr 16;
            V2 := dwFileVersionMS and $FFFF;
            V3 := dwFileVersionLS shr 16;
            V4 := dwFileVersionLS and $FFFF;
          end;
        end;
      finally
        FreeMem(VerInfo, VerInfoSize);
      end;
  end;
end;

{$RESOURCE binclock32.res}
procedure TBinClockWND.AboutBinaryClock1Click(Sender: TObject);
var txt:array[0..2048]of char;
v1,v2,v3,v4:word;
begin
getbuildinfo(v1,v2,v3,v4);
messagebox(handle,strfmt(txt,
'delphijustin Binary Clock Screensaver v%u.%u.%u.%u'#13#10'By Justin Roeder'#13#10'https://delphijustin.biz',
[v1,v2,v3,v4]),'About Binary Clock',0);
end;

procedure TBinClockWND.Font1Click(Sender: TObject);
begin
fontdialog1.font:=label1.Font;
if not fontdialog1.Execute then exit;
graphicsettings.Font.Styles:=fontdialog1.Font.Style;
graphicsettings.Font.color:=fontdialog1.Font.Color;
graphicsettings.Font.name:=fontdialog1.Font.Name;
graphicsettings.Font.size:=fontdialog1.Font.Size;
updatelabels([label1,label2,label3,label4,label5,label6,label7,label8,label9,
label10]);

end;

end.
//filename binclockunit2.pas
unit binclockUnit2;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;
//this unit is the screensavers main window
type
  TBinClockSCR = class(TForm)
    Timer1: TTimer;
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  BinClockSCR: TBinClockSCR;
  firstmousemove:boolean=true;
implementation
uses binclockunit1;
{$R *.DFM}

procedure TBinClockSCR.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
binclockwnd.close;
end;

procedure TBinClockSCR.FormClick(Sender: TObject);
begin
binclockwnd.close;
end;

procedure TBinClockSCR.FormCreate(Sender: TObject);
var desktoprect:trect;
begin
getwindowrect(getdesktopwindow,desktoprect);
if paramstr(1)='/S'then
begin
clientheight:=desktoprect.Bottom;
clientwidth:=desktoprect.Right;
top:=0;
left:=0;
end;
end;

procedure TBinClockSCR.Timer1Timer(Sender: TObject);
var previewrect:TRect;
begin
if(mode=0)then begin
timer1.Enabled:=false;
exit;
end;
if mode=2then begin
getwindowrect(strtoint(paramstr(2)),PreviewRect);
clientheight:=previewrect.Bottom;
clientwidth:=previewrect.Right;
top:=0;
left:=0;
windows.SetParent(handle,strtoint(paramstr(2)));
showwindow(handle,sw_show);
showwindow(application.handle,sw_hide);
showwindow(binclockwnd.handle,sw_hide);
end else if mode=1then showwindow(handle,SW_MAXIMIZE);
 timer1.Enabled:=false;
end;

end.

Published by Justin Roeder

I am an electronics engineer and computer programmer that has autism. I learned by myself

Leave a comment

Your email address will not be published. Required fields are marked *