// Das Prinzip ist
das gleiche wie bei
eine Analoguhr programmieren,
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
StdCtrls, ExtCtrls;
type
TClock = class(TForm)
Image1: TImage;
Timer1: TTimer;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormShow(Sender: TObject);
private
{ Private-Deklarationen }
public
procedure antialias(b: TBitmap);
function x(w, d, b: double): integer;
function y(w, d, h: double): integer;
procedure zeiger(c: TCanvas; farbe: TColor; wert, diff: double;
dicke: integer);
procedure readposi;
procedure writeposi;
end;
var
Clock: TClock;
implementation
{$R *.DFM}
{$R AUhr.RES}
uses Registry;
const
SZeiger = $2020FF;
MZeiger = $444444;
HZeiger = $505050;
SDicke = 1;
MDicke = 3;
HDicke = 4;
var
Secm: double = 61;
absts, abstm, absth: double;
mass, mitte: integer;
bm, hig: TBitmap;
Reg: TRegistry;
procedure TClock.antialias(b: TBitmap);
var
w, x, y, z, k, m: integer;
p0, p1, p2: PBytearray;
begin
for y := 1 to b.height - 2 do begin
p0 := b.ScanLine[y - 1];
p1 := b.scanline[y];
p2 := b.ScanLine[y + 1];
for x := 1 to b.width - 2 do begin
z := x * 3;
k := (x - 1) * 3;
m := (x + 1) * 3;
for w := 0 to 2 do begin
p1[z + w] := trunc((
p0[z + w] + p0[k + w] + p0[m + w] +
p2[z + w] + p2[k + w] + p2[m + w] +
p1[k + w] + p1[m + w] + p1[z + w] * 6) / 14);
end;
end;
end;
end;
procedure TClock.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if button = mbleft then begin
releaseCapture;
perform(WM_SysCommand, $F012, 0);
end;
end;
procedure TClock.FormCreate(Sender: TObject);
var
r: HRgn;
begin
Timer1.interval := 500;
borderstyle := bsNone;
FormStyle := fsStayOnTop;
doublebuffered := true;
Image1.left := 0;
Image1.top := 0;
Image1.autosize := true;
Image1.picture.bitmap.handle := LoadBitmap(HInstance, 'uhr');
clientwidth := Image1.Width;
clientheight := Image1.height;
r := CreateEllipticRgn(-1, -1, width + 1, height + 1);
setwindowRgn(handle, r, true);
left := screen.width - width - 10;
top := 10;
readposi;
mass := round(width * 0.8);
mitte := width div 2;
absts := (mass * 2) / 31;
abstm := (mass * 2) / 24;
absth := (mass * 2) / 11;
bm := TBitmap.Create;
bm.pixelformat := pf24bit;
bm.width := image1.width;
bm.height := image1.height;
bm.transparent := true;
hig := TBitmap.create;
hig.assign(Image1.picture.bitmap);
end;
function TClock.x(w, d, b: double): integer;
begin
b := b / 2 - d;
result := trunc(cos((pi / 30) * w - pi / 2) * b + mitte);
end;
function TClock.y(w, d, h: double): integer;
begin
h := h / 2 - d;
result := trunc(sin((pi / 30) * w - pi / 2) * h + mitte + 0.5);
end;
procedure TClock.zeiger(c: TCanvas; farbe: TColor; wert, diff: double;
dicke: integer);
begin
c.pen.color := farbe;
c.pen.width := dicke;
c.moveto(mitte, mitte);
c.lineto(x(wert, diff, mass), y(wert, diff, mass));
end;
procedure TClock.Timer1Timer(Sender: TObject);
var
Hour, Min, Sec, MSec: Word;
hlp: double;
procedure stundenhin;
begin
hlp := hour + (min / 12 + sec / 720);
zeiger(bm.canvas, HZeiger, hlp, absth, HDicke);
end;
procedure minutenhin;
begin
hlp := min + (sec / 60);
zeiger(bm.canvas, MZeiger, hlp, abstm, MDicke);
end;
begin
decodetime(Time, Hour, Min, Sec, MSec);
if (sec <> secm) then begin
bm.canvas.draw(0, 0, hig);
secm := sec;
Hour := Hour * 5;
stundenhin;
minutenhin;
zeiger(bm.canvas, SZeiger, sec, absts, SDicke);
antialias(bm);
image1.canvas.draw(0, 0, bm);
end;
end;
procedure TClock.FormDestroy(Sender: TObject);
begin
writeposi;
bm.free;
hig.free;
end;
procedure TClock.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if button = mbright then close;
end;
procedure TClock.FormShow(Sender: TObject);
begin
showWindow(application.handle, sw_hide);
Timer1Timer(Timer1);
end;
procedure TClock.writeposi;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('\Software\DBRUHR', True)
then begin
Reg.WriteInteger('X', left);
Reg.WriteInteger('Y', top);
end;
finally
Reg.CloseKey;
Reg.Free;
end;
end;
procedure TClock.readposi;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('\Software\DBRUHR', False)
then begin
left := Reg.readInteger('X');
top := Reg.readInteger('Y');
end;
finally
Reg.CloseKey;
Reg.Free;
end;
end;
end.
|





