// Es wird eine analoge Uhr auf Form1 dargestellt. Damit nicht
// ständig gezeichnet werden muss, wird die Zeichenroutine jede
// Sekunde aufgerufen (wobei der
Timerintervall weit geringer
// eingestellt ist, um ein Ruckeln zu
vermeiden). Das hat zur
// Folge, dass der Senkundenzeiger von Sekunde zu Sekunde springt
//
(Bahnhofsuhr). Ob der Minuten- und Stundenzeiger ebenfalls
// springen oder ob sie auch Zwischenstellungen einnehmen, wird
// über die Konstante "sprung" geregelt.
// Getestet mit D4 unter WinME
const
sprung: boolean = true;
Hourm: double = 301;
Minm: double = 61;
Secm: double = 61;
SZeiger = clred;
MZeiger = clblue;
HZeiger = clblack;
randfrb = clmaroon;
Zahlenfrb = clgreen;
untergrund = $AAFFFF;
innenkreis = 4;
SDicke = 1;
MDicke = 2;
HDicke = 3;
var
breite, hoehe, links, oben, mittex, mittey, txtl: integer;
absts, abstm, absth: double;
procedure TForm1.FormCreate(Sender: TObject);
begin
breite := 100;
hoehe := 100;
links := 75;
oben := 130;
mittex := breite div 2 + links;
mittey := hoehe div 2 + oben;
absts := (breite + hoehe) / 20;
abstm := (breite + hoehe) / 22;
absth := (breite + hoehe) / 12;
canvas.Font.name := 'Courier New';
canvas.Font.size := 8;
canvas.Font.style := [fsbold];
canvas.Font.color := zahlenfrb;
txtl := (breite - canvas.textwidth('00:00:00')) div 2 + links;
timer1.interval := 125;
end;
function x(w, d, b: double): integer;
begin
b := b / 2 - d;
result := trunc(cos((pi / 30) * w - pi / 2) * b + mittex);
end;
function y(w, d, h: double): integer;
begin
h := h / 2 - d;
result := trunc(sin((pi / 30) * w - pi / 2) * h + mittey);
end;
procedure zeiger(c: TCanvas; farbe: TColor; wert, diff: double;
dicke: integer);
begin
c.pen.color := farbe;
c.pen.width := dicke;
c.moveto(mittex, mittey);
c.lineto(x(wert, diff, breite), y(wert, diff, hoehe));
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
Hour, Min, Sec, MSec: Word;
hlp: double;
bezug: TTime;
procedure weg;
begin
zeiger(canvas, untergrund, hourm, absth, HDicke);
zeiger(canvas, untergrund, minm, abstm, MDicke);
zeiger(canvas, untergrund, secm, absts, SDicke);
end;
procedure stundenhin;
begin
hlp := hour + (min / 12 + sec / 720) * ord(not sprung);
zeiger(canvas, HZeiger, hlp, absth, HDicke);
hourm := hlp;
end;
procedure minutenhin;
begin
hlp := min + (sec / 60) * ord(not sprung);
zeiger(canvas, MZeiger, hlp, abstm, MDicke);
minm := hlp;
end;
begin
bezug := Time;
decodetime(bezug, Hour, Min, Sec, MSec);
if (sec <> secm) or (sender = Form1) then begin
Hour := Hour * 5;
canvas.brush.color := untergrund;
weg;
canvas.textout(txtl, mittey + hoehe div 10, formatdatetime('hh:nn:ss',
bezug));
stundenhin;
minutenhin;
zeiger(canvas, SZeiger, sec, absts, SDicke);
secm := sec;
canvas.brush.color := SZeiger;
canvas.ellipse(mittex - innenkreis, mittey - innenkreis, mittex +
innenkreis, mittey + innenkreis);
end;
end;
procedure TForm1.FormPaint(Sender: TObject);
var i: integer;
begin
canvas.brush.color := untergrund;
canvas.pen.color := randfrb;
canvas.pen.width := 2;
canvas.Ellipse(links, oben, links + breite, oben + hoehe);
i := 0;
while i < 59 do begin
canvas.moveto(x(i, 0, breite - 5), y(i, 0, hoehe - 5));
canvas.lineto(x(i, 0, breite + 3), y(i, 0, hoehe + 3));
inc(i, 5);
end;
Timer1Timer(Sender);
end;
|