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



Zugriffe seit 6.9.2001 auf Delphi-Ecke