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.

//filename binclockunit1.pas
unit binclockUnit1;

interface
{$RESOURCE BINCLOCK2.RES}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,math,
  dsLeds, StdCtrls, ExtCtrls, Menus, ComCtrls,wininet,shellapi;
  const
  default_cheight=185;
  reg_color1='Color1';
  reg_color0='Color0';
  reg_timezone='Timezone';
  reg_timeformat='TimeFormat';
  reg_colorbg='BackgroundColor';
  reg_textcolor='TextColor';
  reg_segcolor='SegmentColor';
  reg_tzminute='TimeZoneMinute';
  reg_shape='Shape';
  SCREENSAVER_MODE=1;
  RESET_TIME_MODE=2;
  PREVIEW_MODE=4;
  ADJUSTING_TIME_MODE=8;
  SCREENSAVER_MODES=PREVIEW_MODE OR SCREENSAVER_MODE;
type
  TBinaryClock = class(TForm)
    Hour10: TdsLed;
    H10: TdsSevenSegmentDisplay;
    H1: TdsSevenSegmentDisplay;
    M10: TdsSevenSegmentDisplay;
    M1: TdsSevenSegmentDisplay;
    S10: TdsSevenSegmentDisplay;
    S1: TdsSevenSegmentDisplay;
    Hour20: TdsLed;
    Hour1: TdsLed;
    Hour2: TdsLed;
    Hour4: TdsLed;
    Hour8: TdsLed;
    Minute10: TdsLed;
    Minute20: TdsLed;
    Minute1: TdsLed;
    Minute2: TdsLed;
    Minute4: TdsLed;
    Minute8: TdsLed;
    Second10: TdsLed;
    Second20: TdsLed;
    Second1: TdsLed;
    Second2: TdsLed;
    Second4: TdsLed;
    Second8: TdsLed;
    Minute40: TdsLed;
    Second40: TdsLed;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    MainMenu1: TMainMenu;
    Options1: TMenuItem;
    Timezone1: TMenuItem;
    Local1: TMenuItem;
    UTC1: TMenuItem;
    TimeFormat1: TMenuItem;
    N12HourFormat1: TMenuItem;
    N24HourFormat1: TMenuItem;
    StatusBar1: TStatusBar;
    Colors1: TMenuItem;
    ColorDialog1: TColorDialog;
    BackgroundColor1: TMenuItem;
    TextColor1: TMenuItem;
    Binary1Color1: TMenuItem;
    Binary0Color1: TMenuItem;
    SegmentColor1: TMenuItem;

    Help1: TMenuItem;
    About1: TMenuItem;
    Visitmywebsite1: TMenuItem;
    ChangeTime1: TMenuItem;
    LEDShape1: TMenuItem;
    Circle1: TMenuItem;
    Rectangle1: TMenuItem;
    CustomTimezone1: TMenuItem;
    Button1: TButton;
    Button2: TButton;
    Label5: TLabel;    procedure FormCreate(Sender: TObject);
    procedure Local1Click(Sender: TObject);
    procedure N12HourFormat1Click(Sender: TObject);
    procedure BackgroundColor1Click(Sender: TObject);
    procedure Binary0Color1Click(Sender: TObject);
    procedure Binary1Color1Click(Sender: TObject);
    procedure TextColor1Click(Sender: TObject);
    procedure SegmentColor1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ChangeTime1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Visitmywebsite1Click(Sender: TObject);
    procedure Circle1Click(Sender: TObject);
    procedure CustomTimezone1Click(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TSystemTimeProc=procedure(var systime:systemtime);stdcall;
  procedure customtime(var systime:systemtime);stdcall;
procedure UnsetTimeProc(var systime:systemtime);stdcall;
function BinaryClockThread(reserved:pointer):dword;stdcall;
  const GetTime:array[-23..26]of TSystemTimeProc=(customtime,customtime,
  customtime,customtime,customtime,customtime,customtime,customtime,customtime,customtime,
  customtime,customtime,customtime,customtime,customtime,customtime,customtime,customtime,
  customtime,customtime,customtime,customtime,customtime,customtime,customtime,customtime,
  customtime,customtime,customtime,customtime,customtime,customtime,customtime,customtime,
  customtime,customtime,customtime,customtime,customtime,customtime,customtime,customtime,
  customtime,customtime,customtime,customtime,customtime,GetLocalTime,GetSystemTime,
  UnsetTimeProc);
  appname='delphijustin Binary Clock';
  UserAgent=appname+' v2.0';
var
  hInet: HINTERNET;
  BinaryClock: TBinaryClock;
  zoneIndex:longint=24;
  TimeFormat:dword=24;
  adjustTime:systemtime;
  modes:byte=0;
  hkapp:hkey;
  clockID:DWord=0;
implementation

uses BinClockUnit2;

{$R *.DFM}
procedure UnsetTimeProc(var systime:systemtime);stdcall;
var dummy1,dummy2,dummy3:word;
begin
copymemory(@systime,@adjusttime,sizeof(systime));
decodetime(now,dummy1,dummy2,systime.wsecond,dummy3);
end;
procedure customtime(var systime:systemtime);stdcall;
var utctime:systemtime;
tzMinute,rs:DWord;
begin
getsystemtime(utctime);tzminute:=0;rs:=4;regqueryvalueex(hkapp,reg_tzminute,nil,
nil,@tzminute,@rs);
if zoneindex<0then
datetimetosystemtime(systemtimetodatetime(utctime)-encodetime(abs(zoneindex),
tzminute,0,0),systime)else
datetimetosystemtime(systemtimetodatetime(utctime)+encodetime(zoneindex,tzminute,
0,0),systime);
end;

function StrToDateTimeDef(const S: string;def:TDatetime): TDateTime;
begin
result:=def;
try
result:=strtodatetime(s);
except end;
end;


    function DownloadDate(var errorCode:dword): tdatetime;
    var
      hFile: HINTERNET;
      datestr:array[0..length('mm/dd/yyyy hh:mm:ss')]of ansichar;
      bytesRead: DWORD;
      utc:systemtime;
      url:array[0..255]of char;
    begin
    errorcode:=maxdword;
    getsystemtime(utc);
      result := systemtimetodatetime(utc);
      hFile := InternetOpenURL(hInet,strfmt(url,
      'http://delphianserver.com/utccheck.php?dt=%g',[result]),nil,0,0,0);
      if Assigned(hFile) then
      begin
      zeromemory(@datestr,sizeof(datestr));
      if InternetReadFile(hFile,@datestr,high(datestr),bytesRead)then
      errorcode:=error_success else errorcode:=getlasterror;
        result := strtodatetimedef(datestr,result);
        InternetCloseHandle(hFile);
      end;
    end;

function checkDate(reserved:pointer):dword;stdcall;
var dd:tdatetime;
utc:systemtime;
err:dword;
begin
result:=0;
getsystemtime(utc);
dd:=downloaddate(err);
if abs(dd-systemtimetodatetime(utc))>encodetime(0,5,0,0)then modes:=
modes or reset_time_mode;
binaryclock.StatusBar1.Visible:=(modes and reset_time_mode>0)or(err>0);
binaryclock.StatusBar1.SimpleText:='The time is incorrect';
if(err>0)then binaryclock.StatusBar1.SimpleText:=syserrormessage(err);
end;

function BinaryClockThread(reserved:pointer):dword;stdcall;
var st:systemtime;
tid:dword;
t:tdatetime;
r:trect;
selbit:byte;
ca:tcloseaction;
screenbmp:tbitmap;
szTime,strTimeFormat:String;
label loop;
begin
{
This function is the thread that makes the clock tick!
}
result:=0;
hInet := InternetOpen(useragent,INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0);
createthread(nil,0,@checkdate,nil,0,tid);
getwindowrect(getdesktopwindow,r);
if modes and preview_mode>0then begin getclientrect(strtoint(paramstr(2)),r);
screensaver.Height:=r.Bottom;screensaver.Width:=r.Right;screensaver.Top:=0;
screensaver.Left:=0;setparent(screensaver.handle,strtoint(paramstr(2)));end;
r.Left:=0;r.Top:=0;
selbit:=0;
try
loop:
if(modes and preview_mode>0)then if not iswindow(strtoint(paramstr(2)))then
binaryclock.FormClose(nil,ca);
gettime[zoneindex](st);
t:=systemtimetodatetime(st);
if timeformat=12then strtimeformat:=' AMPM';
if timeformat=24then strtimeformat:='';
if modes and reset_time_mode=0then
sztime:=formatdatetime('hhnnss '+strtimeformat,t)else
sztime:=inttohex(trunc(power(2,selbit))*$111111,0);
inc(selbit);selbit:=selbit mod 4;
with binaryclock do begin
label5.visible:=(timeformat=12)and(modes and adjusting_time_mode>0);
label5.font.Color:=label1.Font.Color;
h10.value:=StrToInt(sztime[1]);
h1.value:=StrToInt(sztime[2]);
m10.value:=StrToInt(sztime[3]);
m1.value:=StrToInt(sztime[4]);
s10.value:=StrToInt(sztime[5]);
s1.value:=StrToInt(sztime[6]);
hour1.ledon:=(h1.value and 1>0);
hour2.ledon:=(h1.value and 2>0);
hour4.ledon:=(h1.value and 4>0);
hour8.ledon:=(h1.value and 8>0);
hour10.ledon:=(h10.value and 1>0);
hour20.ledon:=(h10.value and 2>0);
minute1.ledon:=(m1.value and 1>0);
minute2.ledon:=(m1.value and 2>0);
minute4.ledon:=(m1.value and 4>0);
minute8.ledon:=(m1.value and 8>0);
minute10.ledon:=(m10.value and 1>0);
minute20.ledon:=(m10.value and 2>0);
minute40.ledon:=(m10.value and 4>0);
second1.ledon:=(s1.value and 1>0);
second2.ledon:=(s1.value and 2>0);
second4.ledon:=(s1.value and 4>0);
second8.ledon:=(s1.value and 8>0);
second10.ledon:=(s10.value and 1>0);
second20.ledon:=(s10.value and 2>0);
second40.ledon:=(s10.value and 4>0);
if(modes and screensaver_mode>0)then begin
screenbmp:=GetFormImage;
screensaver.Canvas.StretchDraw(r,screenbmp);
 screenbmp.Free;end;
 sleep(1000);
goto loop;
end;
except binaryclock.FormClose(nil,ca); end;
end;
procedure TBinaryClock.Binary1Color1Click(Sender: TObject);
var dw:dword;
begin
dw:=hour1.oncolor;
colordialog1.Color:=dw;
if not colordialog1.Execute then exit;
dw:=colordialog1.Color;
hour1.oncolor:=dw;
hour2.oncolor:=dw;
hour4.oncolor:=dw;
hour8.oncolor:=dw;
hour10.oncolor:=dw;
hour20.oncolor:=dw;
minute1.oncolor:=dw;
minute2.oncolor:=dw;
minute4.oncolor:=dw;
minute8.oncolor:=dw;
minute10.oncolor:=dw;
minute20.oncolor:=dw;
minute40.oncolor:=dw;
second1.oncolor:=dw;
second2.oncolor:=dw;
second4.oncolor:=dw;
second8.oncolor:=dw;
second10.oncolor:=dw;
second20.oncolor:=dw;
second40.oncolor:=dw;
regsetvalueex(hkapp,reg_color1,0,reg_dword,@dw,4);

end;

procedure TBinaryClock.FormCreate(Sender: TObject);
var rs,dw:dword;
begin
clientheight:=default_cheight;
caption:=appname;application.Title:=appname;
if sender=self then
regcreatekeyex(hkey_current_user,'Software\Justin\BinClock2',0,nil,
reg_option_non_volatile,key_all_access,nil,hkapp,nil);
circle1.Tag:=ord(ltellipse);rectangle1.Tag:=ord(ltrectangle);
rs:=4;dw:=ord(hour1.shape);regqueryvalueex(hkapp,reg_shape,nil,nil,@dw,@rs);
with circle1 do checked:=(tag=dw);with rectangle1 do checked:=(tag=dw);
hour1.shape:=TdsLedShape(dw);
hour2.shape:=TdsLedShape(dw);
hour4.shape:=TdsLedShape(dw);
hour8.shape:=TdsLedShape(dw);
hour10.shape:=TdsLedShape(dw);
hour20.shape:=TdsLedShape(dw);
minute1.shape:=TdsLedShape(dw);
minute2.shape:=TdsLedShape(dw);
minute4.shape:=TdsLedShape(dw);
minute8.shape:=TdsLedShape(dw);
minute10.shape:=TdsLedShape(dw);
minute20.shape:=TdsLedShape(dw);
minute40.shape:=TdsLedShape(dw);
second1.shape:=TdsLedShape(dw);
second2.shape:=TdsLedShape(dw);
second4.shape:=TdsLedShape(dw);
second8.shape:=TdsLedShape(dw);
second10.shape:=TdsLedShape(dw);
second20.shape:=TdsLedShape(dw);
second40.shape:=TdsLedShape(dw);
rs:=4;regqueryvalueex(hkapp,reg_timezone,nil,nil,@zoneindex,@rs);
rs:=4;regqueryvalueex(hkapp,reg_timeformat,nil,nil,@timeformat,@rs);
local1.Checked:=(zoneindex=24);utc1.Checked:=(zoneindex=25);
customtimezone1.Checked:=(zoneindex<24);
n12hourformat1.Checked:=(timeformat=12);n24hourformat1.Checked:=(timeformat=24);
if comparetext('/t',paramstr(1))=0then modes:=reset_time_mode;
rs:=4;dw:=color;regqueryvalueex(hkapp,reg_colorbg,nil,nil,@dw,@rs);color:=dw;
rs:=4;dw:=clred;regqueryvalueex(hkapp,reg_color1,nil,nil,@dw,@rs);
hour1.oncolor:=dw;
hour2.oncolor:=dw;
hour4.oncolor:=dw;
hour8.oncolor:=dw;
hour10.oncolor:=dw;
hour20.oncolor:=dw;
minute1.oncolor:=dw;
minute2.oncolor:=dw;
minute4.oncolor:=dw;
minute8.oncolor:=dw;
minute10.oncolor:=dw;
minute20.oncolor:=dw;
minute40.oncolor:=dw;
second1.oncolor:=dw;
second2.oncolor:=dw;
second4.oncolor:=dw;
second8.oncolor:=dw;
second10.oncolor:=dw;
second20.oncolor:=dw;
second40.oncolor:=dw;
rs:=4;dw:=clsilver;regqueryvalueex(hkapp,reg_color0,nil,nil,@dw,@rs);
hour1.offcolor:=dw;
hour2.offcolor:=dw;
hour4.offcolor:=dw;
hour8.offcolor:=dw;
hour10.offcolor:=dw;
hour20.offcolor:=dw;
minute1.offcolor:=dw;
minute2.offcolor:=dw;
minute4.offcolor:=dw;
minute8.offcolor:=dw;
minute10.offcolor:=dw;
minute20.offcolor:=dw;
minute40.offcolor:=dw;
second1.offcolor:=dw;
second2.offcolor:=dw;
second4.offcolor:=dw;
second8.offcolor:=dw;
second10.offcolor:=dw;
second20.offcolor:=dw;
second40.offcolor:=dw;
rs:=4;dw:=clwhite;regqueryvalueex(hkapp,reg_textcolor,nil,nil,@dw,@rs);
label1.Font.Color:=dw;
label2.Font.Color:=dw;
label3.Font.Color:=dw;
label4.Font.Color:=dw;
rs:=4;dw:=clred;regqueryvalueex(hkapp,reg_segcolor,nil,nil,@dw,@rs);
h1.OnColor:=dw;
h10.OnColor:=dw;
m1.OnColor:=dw;
m10.OnColor:=dw;
s1.OnColor:=dw;
s10.OnColor:=dw;
end;

procedure TBinaryClock.Local1Click(Sender: TObject);
begin
zoneindex:=TMenuitem(sender).tag;
local1.Checked:=(zoneindex=24);
utc1.Checked:=(zoneindex=25);
customtimezone1.Checked:=false;
regsetvalueex(hkapp,reg_timezone,0,reg_dword,@zoneindex,4);
end;

procedure TBinaryClock.N12HourFormat1Click(Sender: TObject);
begin
timeformat:=tmenuitem(sender).tag;
n12hourformat1.Checked:=(timeformat=12);
n24hourformat1.Checked:=(timeformat=24);
regsetvalueex(hkapp,reg_timeformat,0,reg_dword,@timeformat,4);
end;

procedure TBinaryClock.BackgroundColor1Click(Sender: TObject);
var dw:dword;
begin
dw:=color;
colordialog1.Color:=dw;
if not colordialog1.Execute then exit;
dw:=colordialog1.Color;
color:=dw;
regsetvalueex(hkapp,reg_colorbg,0,reg_dword,@dw,4);
end;

procedure TBinaryClock.Binary0Color1Click(Sender: TObject);
var dw:dword;
begin
dw:=hour1.offcolor;
colordialog1.Color:=dw;
if not colordialog1.Execute then exit;
dw:=colordialog1.Color;
hour1.offcolor:=dw;
hour2.offcolor:=dw;
hour4.offcolor:=dw;
hour8.offcolor:=dw;
hour10.offcolor:=dw;
hour20.offcolor:=dw;
minute1.offcolor:=dw;
minute2.offcolor:=dw;
minute4.offcolor:=dw;
minute8.offcolor:=dw;
minute10.offcolor:=dw;
minute20.offcolor:=dw;
minute40.offcolor:=dw;
second1.offcolor:=dw;
second2.offcolor:=dw;
second4.offcolor:=dw;
second8.offcolor:=dw;
second10.offcolor:=dw;
second20.offcolor:=dw;
second40.offcolor:=dw;
regsetvalueex(hkapp,reg_color0,0,reg_dword,@dw,4);
end;

procedure TBinaryClock.TextColor1Click(Sender: TObject);
var dw:dword;
begin
dw:=label1.font.color;
colordialog1.Color:=dw;
if not colordialog1.Execute then exit;
dw:=colordialog1.Color;
label1.font.color:=dw;
label2.font.color:=dw;
label3.font.color:=dw;
label4.font.color:=dw;
regsetvalueex(hkapp,reg_textcolor,0,reg_dword,@dw,4);
end;

procedure TBinaryClock.SegmentColor1Click(Sender: TObject);
var dw:dword;
begin
dw:=h1.OnColor;
colordialog1.Color:=dw;
if not colordialog1.Execute then exit;
dw:=colordialog1.Color;
h1.OnColor:=dw;
h10.OnColor:=dw;
m1.OnColor:=dw;
m10.OnColor:=dw;
s1.OnColor:=dw;
s10.OnColor:=dw;
regsetvalueex(hkapp,reg_segcolor,0,reg_dword,@dw,4);
end;

procedure TBinaryClock.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
regclosekey(hkapp);
internetclosehandle(hinet);
exitprocess(0);
end;

procedure TBinaryClock.ChangeTime1Click(Sender: TObject);
begin
modes:=(modes and(not reset_time_mode))or adjusting_time_mode;
statusbar1.visible:=true;
statusbar1.simpletext:=
'Hour press H, Minute press M';
zoneindex:=26;
getlocaltime(adjusttime);adjusttime.wMinute:=0;adjusttime.wHour:=0;
button1.Visible:=true;button1.Enabled:=true;button2.Visible:=true;
button2.Enabled:=true;clientheight:=218;
end;

procedure TBinaryClock.About1Click(Sender: TObject);
var msgbox:msgboxparams;
begin
zeromemory(@msgbox,sizeof(msgbox));
msgbox.cbSize:=sizeof(msgbox);
if sender<>nil then
msgbox.hwndOwner:=handle;
msgbox.hInstance:=hinstance;
msgbox.lpszText:='delphijustin Binary Clock Screensaver v2.0'#13#10'By Justin Roeder'#13#10'LED Display and lights components by Grega Loboda';
msgbox.lpszCaption:='About';
msgbox.dwStyle:=mb_usericon;
msgbox.lpszIcon:=makeintresource(1);
messageboxindirect(msgbox);
end;

procedure TBinaryClock.Visitmywebsite1Click(Sender: TObject);
begin
shellexecute(handle,nil,'https://delphijustin.biz',nil,nil,sw_shownormal);

end;

procedure TBinaryClock.Circle1Click(Sender: TObject);
var dw:Dword;
begin
dw:=tmenuitem(sender).tag;
hour1.shape:=tdsledshape(dw);
hour2.shape:=tdsledshape(dw);
hour4.shape:=tdsledshape(dw);
hour8.shape:=tdsledshape(dw);
hour10.shape:=tdsledshape(dw);
hour20.shape:=tdsledshape(dw);
minute1.shape:=tdsledshape(dw);
minute2.shape:=tdsledshape(dw);
minute4.shape:=tdsledshape(dw);
minute8.shape:=tdsledshape(dw);
minute10.shape:=tdsledshape(dw);
minute20.shape:=tdsledshape(dw);
minute40.shape:=tdsledshape(dw);
second1.shape:=tdsledshape(dw);
second2.shape:=tdsledshape(dw);
second4.shape:=tdsledshape(dw);
second8.shape:=tdsledshape(dw);
second10.shape:=tdsledshape(dw);
second20.shape:=tdsledshape(dw);
second40.shape:=tdsledshape(dw);
with circle1 do checked:=(dw=tag);
with rectangle1 do checked:=(dw=tag);
regsetvalueex(hkapp,reg_shape,0,reg_dword,@dw,4);
end;

procedure TBinaryClock.CustomTimezone1Click(Sender: TObject);
var minute,rs:dword;
hour:longint;
tzStr,shour,sminute:string;
begin
minute:=0;rs:=4;regqueryvalueex(hkapp,reg_tzminute,nil,nil,@minute,@rs);
tzStr:=format('%.*d:%.*u',[2,zoneindex,2,minute]);
if not inputquery(customTimezone1.caption,'Enter UTC Bias offset Local = 24:00 UTC = 25:00',tzStr)then
exit;
tzstr:=stringreplace(tzstr,'+','',[]);
if length(tzstr)=0then raise exception.Create('Invalid Offset');
shour:=copy(tzstr,1,pos(':',tzstr)-1);
sminute:=copy(tzstr,1+pos(':',tzstr),maxint);
minute:=min(abs(strtointdef(sminute,0)),59);
if minute>59then raise exception.Createfmt('%d is an invalid minute',[minute]);
hour:=strtointdef(shour,zoneindex);
if abs(hour)>25then raise exception.CreateFMT('%d is an invalid hour',[hour]);
zoneindex:=hour;
regsetvalueex(hkapp,reg_timezone,0,reg_dword,@zoneindex,4);
regsetvalueex(hkapp,reg_tzminute,0,reg_dword,@minute,4);
customtimezone1.Checked:=(zoneindex<24);
local1.Checked:=(zoneindex=24);
utc1.Checked:=(zoneindex=25);
end;

procedure TBinaryClock.FormKeyPress(Sender: TObject; var Key: Char);
begin
if modes and adjusting_time_mode=0then exit;
case key of
'h','H':inc(adjusttime.wHour);
'm','M':inc(adjusttime.wminute);
end;
adjusttime.wHour:=adjusttime.wHour mod 24;
adjusttime.wMinute:=adjusttime.wMinute mod 60;
if(adjusttime.wHour<12)then label5.Caption:='AM'else label5.Caption:='PM';
end;

function DefSetTime(dsystime:Systemtime):boolean;
var comspec:array[0..max_path]of char;
ec:integer;
begin
ec:=0;
  getenvironmentvariable('ComSpec',comspec,max_path);
with dsystime do
  binclockunit2.ExecuteProcess(comspec,format(
  '/C time %.2u:%.2u:%.2u',[whour,wminute,wsecond]),getcurrentdir,true,false,
  false,ec);
  result:=(ec=0);
end;

function SetPCSystemTime(dSysTime:systemtime): Boolean;
const
  SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege';
var
  hToken: THandle;
  ReturnLength: DWORD;
  ec:integer;
  tkp, PrevTokenPriv: TTokenPrivileges;
  luid: TLargeInteger;
begin
  Result := False;
  if (Win32Platform = VER_PLATFORM_WIN32_NT) then
  begin
    if OpenProcessToken(GetCurrentProcess,
      TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
    begin
      try
        LookupPrivilegeValue(nil, SE_SYSTEMTIME_NAME, luid);
        tkp.PrivilegeCount := 1;
        tkp.Privileges[0].luid := luid;
        tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
        AdjustTokenPrivileges(hToken, False, tkp, SizeOf(TTOKENPRIVILEGES),
          PrevTokenPriv, ReturnLength);
        if (GetLastError <> ERROR_SUCCESS) then
        binaryclock.StatusBar1.SimpleText:=syserrormessage(getlasterror);
        finally
        CloseHandle(hToken);
      end;
    end;
  end;
  Result := Windows.SetLocalTime(dSysTime);
  if not result then result:=DefSetTime(dSysTime);
end;
procedure TBinaryClock.Button1Click(Sender: TObject);
begin
zoneindex:=24;
modes:= modes xor adjusting_time_mode;
button1.Visible:=false;button1.Enabled:=false;
button2.Visible:=false;button2.Enabled:=false;
statusbar1.Visible:=not setpcsystemtime(adjusttime);
end;

procedure TBinaryClock.Button2Click(Sender: TObject);
begin
zoneindex:=24;modes:=modes xor adjusting_time_mode;
clientheight:=default_cheight;
button1.Visible:=false;button1.Enabled:=false;
statusbar1.Visible:=false;
button2.Visible:=false;button2.Enabled:=false;
end;

end.
//filename binclockunit2.pas
unit binclockunit2;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Menus;

type
  TScreenSaver = class(TForm)
    Timer1: TTimer;
    PopupMenu1: TPopupMenu;
    FullScreen1: TMenuItem;
    About1: TMenuItem;
    SmallScreen1: TMenuItem;
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FullScreen1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure SmallScreen1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
function ExecuteProcess(const FileName, Params: string; Folder: string; WaitUntilTerminated, WaitUntilIdle, RunMinimized: boolean;
  var ErrorCode: integer): boolean;
var
  ScreenSaver: TScreenSaver;
  oldmouse,newmouse:tpoint;
implementation

uses binclockUnit1;

{$R *.DFM}

procedure TScreenSaver.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
//binaryclock.close;
end;

function ExcludeTrailingPathDelimiter(const S:String):string;
begin
result:=s;
if length(s)=0then exit;
if s[length(s)]='\' then delete(result,length(result),1);
end;

function ExecuteProcess(const FileName, Params: string; Folder: string; WaitUntilTerminated, WaitUntilIdle, RunMinimized: boolean;
  var ErrorCode: integer): boolean;
var
  CmdLine: string;
  WorkingDirP: PChar;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  Result := true;
  CmdLine := '"' + FileName + '" ' + Params;
  if Folder = '' then Folder := ExcludeTrailingPathDelimiter(ExtractFilePath(FileName));
  ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
  StartupInfo.cb := SizeOf(StartupInfo);
  if RunMinimized then
    begin
      StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
      StartupInfo.wShowWindow := SW_SHOWMINIMIZED;
    end;
  if Folder <> '' then WorkingDirP := PChar(Folder)
  else WorkingDirP := nil;
  if not CreateProcess(nil, PChar(CmdLine), nil, nil, false, 0, nil, WorkingDirP, StartupInfo, ProcessInfo) then
    begin
      Result := false;
      ErrorCode := GetLastError;
      exit;
    end;
  with ProcessInfo do
    begin
      CloseHandle(hThread);
      if WaitUntilIdle then WaitForInputIdle(hProcess, INFINITE);
      if WaitUntilTerminated then
        repeat
          Application.ProcessMessages;
        until MsgWaitForMultipleObjects(1, hProcess, false, INFINITE, QS_ALLINPUT) <> WAIT_OBJECT_0 + 1;
      CloseHandle(hProcess);
    end;
end;
procedure TScreenSaver.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var ca:TCloseaction;
mouse:tpoint;
begin
getcursorpos(mouse);
if modes and preview_mode>0then
popupmenu1.Popup(mouse.x,mouse.y)else binaryclock.formclose(nil,ca);
end;

procedure TScreenSaver.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var ca:tcloseaction;
begin
if modes and preview_mode>0then exit;
binaryclock.formclose(nil,ca);
end;

procedure TScreenSaver.FormCreate(Sender: TObject);
begin
timer1.enabled:=(comparetext('/s',paramstr(1))*comparetext('/p',paramstr(1))=0);
top:=0;left:=0;
getcursorpos(oldmouse);getcursorpos(newmouse);
if timer1.Enabled then begin
modes:=modes or screensaver_mode;
if comparetext('/p',paramstr(1))=0then modes:=modes or preview_mode;
end;
createthread(nil,0,@binaryclockthread,nil,0,clockid);
end;

procedure TScreenSaver.Timer1Timer(Sender: TObject);
var cA:tcloseaction;
begin
binaryclock.visible:=false;
showwindow(application.handle,sw_hide);
visible:=true;
if modes and screensaver_modes=screensaver_mode then begin
getcursorpos(newmouse);
if(newmouse.x<>oldmouse.x)or(newmouse.y<>oldmouse.y)then binaryclock.FormClose(
nil,ca);
end;
end;

procedure TScreenSaver.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
action:=cafree;
end;

procedure TScreenSaver.FullScreen1Click(Sender: TObject);
var ec:integer;
begin
if not executeprocess(paramstr(0),'/s',getcurrentdir,false,false,false,ec)then
messagebox(handle,'Full Screen failed',appname,mb_iconwarning);
end;

procedure TScreenSaver.About1Click(Sender: TObject);
begin
binaryclock.About1click(nil);
end;

procedure TScreenSaver.SmallScreen1Click(Sender: TObject);
var ec:integer;
begin
if not executeprocess(paramstr(0),'',getcurrentdir,true,false,false,ec)then
messagebox(handle,'Small Screen failed',appname,mb_iconwarning);
binaryclock.FormCreate(nil);
end;

end.

New improvement in 2.0 is the design, works with control panel preview monitor and many more!

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 *

16 − eight =


Auto close youtube

delphijustin Industries is an Autism Supported Business
Social Media Auto Publish Powered By : XYZScripts.com
Screen too small? Click Here!