Draw Animate Analog Clock

Beispiel 1:

var
  Form1: TForm1;
  coul : TColor;
  dh : TDateTime;
  s, s2 : LongInt;
  xp, yp, R : Integer;
  
//

procedure TForm1.FormResize(Sender: TObject);
begin
  Bevel1.Width := Form1.ClientWidth - 16;
  Bevel1.Height := Form1.ClientHeight - 16 - 65;
  PaintBox1.Width := Form1.ClientWidth - 18;
  PaintBox1.Height := Form1.ClientHeight - 18 - 65;
  Panel1.Width := Form1.ClientWidth - 16;
  Panel2.Width := Form1.ClientWidth - 16;
  Panel1.Top := Form1.ClientHeight - 16 - 48;
  Panel2.Top := Form1.ClientHeight - 16 - 15;
  if PaintBox1.Width <= PaintBox1.Height then R := PaintBox1.Width div 2 - PaintBox1.Width div 10
  else R := PaintBox1.Height div 2 - PaintBox1.Height div 10;
  xp := PaintBox1.Width div 2;
  yp := PaintBox1.Height div 2;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := true;
  coul := clLime;
  if PaintBox1.Width <= PaintBox1.Height then R := PaintBox1.Width div 2 - PaintBox1.Width div 10
  else R := PaintBox1.Height div 2 - PaintBox1.Height div 10;
  xp := PaintBox1.Width div 2;
  yp := PaintBox1.Height div 2;
end;

procedure TForm1.ColorClick(Sender: TObject);
begin
  if ColorDialog1.Execute then begin
    coul := ColorDialog1.Color;
    PaintBox1.Repaint;
    Panel1.Font.Color := coul;
    Panel2.Font.Color := coul;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var asec, amin, ahour : Real;
begin
  dh := Now;
  if Panel2.Caption <> DateToStr(dh) then Panel2.Caption := DateToStr(dh);
  //DecodeTime(dh, h, m, s, ms);
  //if (h < 10) then Panel1.Caption := '0' + IntToStr(h) + ':'
  //else Panel1.Caption := IntToStr(h) + ':';
  //if (m < 10) then Panel1.Caption := Panel1.Caption + '0' + IntToStr(m) + ':'
  //else Panel1.Caption := Panel1.Caption + IntToStr(m) + ':';
  //if (s < 10) then Panel1.Caption := Panel1.Caption +'0' + IntToStr(s)
  //else Panel1.Caption := Panel1.Caption + IntToStr(s);
  s := SecondOfTheDay(dh);
  if s <> s2 then begin
  PaintBox1.Repaint;
  if Panel1.Caption <> TimetoStr(dh) then Panel1.Caption := TimetoStr(dh);
  PaintBox1.Canvas.Pen.Color := coul;
  PaintBox1.Canvas.MoveTo(xp, yp);
  asec := s*Pi/30;
  PaintBox1.Canvas.LineTo(xp+round(R*cos(asec-Pi/2)), yp+round(R*sin(asec-Pi/2)));
  PaintBox1.Canvas.MoveTo(xp, yp);
  amin := s*Pi/1800;
  PaintBox1.Canvas.LineTo(xp+round((2*R/3)*cos(amin-Pi/2)), yp+round((2*R/3)*sin(amin-Pi/2)));
  PaintBox1.Canvas.MoveTo(xp, yp);
  ahour := s*Pi/21600;
  PaintBox1.Canvas.LineTo(xp+round((R/3)*cos(ahour-Pi/2)), yp+round((R/3)*sin(ahour-Pi/2)));
  end;
  s2 := s;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  i : integer;
  a : Real;
  myrect, minir : TRect;
begin
  myrect := Rect(0, 0, PaintBox1.Width, PaintBox1.Height);
  PaintBox1.Canvas.Brush.Color := clBlack;
  PaintBox1.Canvas.FillRect(myrect);
  for i:= 0 to 11 do begin
    a := i*Pi/6;
    minir := Rect(xp+round(R*cos(a))-2, yp+round(R*sin(a))-2, xp+round(R*cos(a))+2, yp+round(R*sin(a))+2);
    PaintBox1.Canvas.Brush.Color := coul;
    PaintBox1.Canvas.FillRect(minir);
  end;
end;

procedure TForm1.FormConstrainedResize(Sender: TObject; var MinWidth,
  MinHeight, MaxWidth, MaxHeight: Integer);
begin
  MinWidth := 90;
  MinHeight := 170;
end;

Beispiel 2:

uses Math

private
    { Private declarations }
    OldHrs, OldMins, OldSecs: Integer;  // alte Winkel
    BackBitmap: TBitmap;  // Bitmap im Speicher zum Zeichnen
    procedure ClearHands(Start: TPoint; Angle, Len: Integer; Thickness: Cardinal);
    procedure PaintHands(start: TPoint; Angle, Len: Integer; Thickness: Cardinal);

const
  RADIUS = 100;
  
//

//  Zeiger löschen
procedure TForm1.ClearHands(Start: TPoint; Angle, Len: Integer; Thickness: Cardinal);
var
  EndPos       : TPoint;
begin
  // Anfangspunkt in die Mitte des Bitmaps setzten
  BackBitmap.Canvas.Pen.Color := clWhite;
  BackBitmap.Canvas.Pen.Width := Thickness;
  // Zeiger neu zeichnen
  EndPos.X := Trunc(sin(DegToRad(Angle)) * (RADIUS+Len));
  EndPos.Y := Trunc(cos(DegToRad(Angle)) * -(RADIUS+Len));
  BackBitmap.Canvas.MoveTo(Start.X, Start.Y);
  BackBitmap.Canvas.LineTo(Start.X+EndPos.X, Start.Y+EndPos.Y);
end;

// Zeiger zeichnen

procedure TForm1.PaintHands(Start: TPoint; Angle, Len: Integer; Thickness: Cardinal);
var
  EndPos       : TPoint;
begin
  // Anfangspunkt in die Mitte des Bitmaps setzten
  BackBitmap.Canvas.Pen.Color := clBlack;
  BackBitmap.Canvas.Pen.Width := Thickness;
  // Zeiger neu zeichnen
  EndPos.X := Trunc(sin(DegToRad(Angle)) * (RADIUS+Len));
  EndPos.Y := Trunc(cos(DegToRad(Angle)) * -(RADIUS+Len));
  BackBitmap.Canvas.MoveTo(Start.X, Start.Y);
  BackBitmap.Canvas.LineTo(Start.X+EndPos.X, Start.Y+EndPos.Y);
end;

//  Winkel der Zeiger berechnen
procedure CalcAngels(var hrs, mins, secs, msec: Word);
begin
  DecodeTime(Time, hrs, mins, secs, msec);
  secs := secs * 6;
  mins := mins * 6;
  hrs := hrs * 30;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;
  // Bitmap im Speicher erzeugen
  BackBitmap := TBitmap.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  // Bitmap im Speicher wieder freigeben
  FreeAndNil(BackBitmap);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  hrs, mins,
    secs, msec : Word;
  Start        : TPoint;
begin
  // Zeit zur Kontrolle mitlaufen lassen
  Caption := TimeToStr(Time);

  // Größe des Bitmaps an die Größe der Paintbox (Align := alClient anpassen
  BackBitmap.Width := Paintbox1.Width;
  BackBitmap.Height := Paintbox1.Height;

  // Startpunkt berechnen (soll immer in der Mitte der Paintbox sein
  Start.X := Paintbox1.Width div 2;
  Start.Y := Paintbox1.Height div 2;

  // Winkel berechnen
  CalcAngels(hrs, mins, secs, msec);

  // Zeiger löschen
  ClearHands(Start, OldSecs, Paintbox1.Height div 2 div 2 - 40, 1);
  // Zeiger zeichnen
  PaintHands(Start, secs, Paintbox1.Height div 2 div 2 - 40, 1);
  // alten Winkel merken
  OldSecs := secs;

  ClearHands(Start, OldMins, Paintbox1.Height div 2 div 3 - 45, 2);
  PaintHands(Start, mins, Paintbox1.Height div 2 div 3 - 45, 2);
  OldMins := mins;

  ClearHands(Start, OldHrs, Paintbox1.Height div 2 div 6 - 55, 4);
  PaintHands(Start, hrs, Paintbox1.Height div 2 div 6 - 55, 4);
  OldHrs := hrs;

  // Neuzeichnen der Paintbox auslösen
  Paintbox1.Repaint;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  BitBlt(Paintbox1.Canvas.Handle, 0, 0, Paintbox1.Width, Paintbox1.Height,
    BackBitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  BackBitmap.Width := 0;
  BackBitmap.Height := 0;
end;