unit UMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Menus;
type
TForm1 =
class(TForm)
Timer1: TTimer;
PopupMenu1: TPopupMenu;
Beenden1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Beenden1Click(Sender: TObject);
private
{ Private-Deklarationen }
dt: TSystemTime;
WinRGN: HRGN;
procedure CreateRegions;
procedure DrawBinTime;
public
{ Public-Deklarationen }
procedure CreateParams(
var Params: TCreateParams);
override;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const
Radius = 5;
XYStep = (Radius * 2) + 2;
Digits = 6;
SetToDesktop = TRUE;
procedure TForm1.CreateParams(
var Params: TCreateParams);
begin
inherited;
if SetToDesktop
then
begin
Params.Style := WS_POPUP;
Params.ExStyle := WS_EX_NOACTIVATE;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
BorderStyle := bsNone;
ShowHint := TRUE;
Width := Digits * XYStep;
Height := 3 * XYStep;
Top := 10;
Left := Screen.Width - Width - 10;
WinRGN := CreateRectRGN(0, 0, 0, 0);
CreateRegions;
GetSystemTime(dt);
SetWindowRgn(
Handle, WinRGN, TRUE);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
//
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
DeleteObject(WinRGN);
Action := caFree;
end;
procedure TForm1.CreateRegions;
var
i, n, x , y: Integer;
RGN : HRGN;
begin
y := Radius;
for n := 1
to 3
do
begin
x := clientwidth - Radius;
for i := Digits
downto 1
do
begin
RGN := CreateEllipticRgn(x - Radius,
y - Radius,
x + Radius + 1,
y + Radius + 1);
CombineRgn(WinRgn, RGN, WinRgn, RGN_OR);
DeleteObject(RGN);
dec(x, XYStep);
end;
inc(y, XYStep);
end;
end;
function IntToBin(Int, Digits: Integer):
String;
var
i : Integer;
begin
Result := '
';
for i := Digits - 1
downto 0
do
Result := Result + IntToStr((Int
shr i)
and 1);
end;
procedure TForm1.DrawBinTime;
var
i, n, x , y: Integer;
s:
string;
begin
y := Radius;
for n := 1
to 3
do
begin
case n
of
1: s := IntToBin(dt.wHour, Digits);
2: s := IntToBin(dt.wMinute, Digits);
3: s := IntToBin(dt.wSecond, Digits);
end;
x := clientwidth - Radius;
for i := length(s)
downto 1
do
begin
if s[i] <> '
0'
then
begin
Canvas.Pen.Color :=
RGB(128, 0, 0);
Canvas.Brush.Color :=
RGB(255, 0, 0);
end else
begin
Canvas.Brush.Color :=
RGB(64, 0, 0);
Canvas.Pen.Color :=
RGB(32, 0, 0);
end;
Canvas.Ellipse(x - Radius, y - Radius, x + Radius, y + Radius);
dec(x, XYStep);
end;
inc(y, XYStep);
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
// inlinefunction
function ItS(V: integer):
String;
begin str(V:2, Result);
end;
//
begin
GetLocalTime(dt);
Hint := ItS(dt.wHour) + '
:' + ItS(dt.wMinute) + '
:' + ItS(dt.wSecond);
DrawBinTime;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
DrawBinTime;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
if SetToDesktop
then
begin
ShowWindow(Application.Handle, SW_Hide);
SetWindowLong(
Handle, GWL_EXSTYLE, GetWindowLong(
Handle, GWL_EXSTYLE)
or WS_EX_TOOLWINDOW
and not WS_EX_APPWINDOW);
Windows.SetParent(
Handle, GetDesktopWindow);
SetWindowPos(
Handle, HWND_BOTTOM, 0, 0, 0, 0,
SWP_NOACTIVATE
or SWP_NOMOVE
or SWP_NOSIZE);
end else
SetWindowPos(
Handle, HWND_TOPMOST, 0, 0, 0, 0,
SWP_NOACTIVATE
or SWP_NOMOVE
or SWP_NOSIZE);
end;
procedure TForm1.Beenden1Click(Sender: TObject);
begin
Close;
end;
end.