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!
Small Window Screenshot 
It now displays something in the preview monitor in Control Panel
