// 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. |