Delphi - Analoguhr

{
  Author  : http://developer.luckie-online.de
  Date    : 2005-03-22
  License : PUBLIC DOMAIN
}


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  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);
  public
    { Public declarations }
  end;

const
  RADIUS = 100;

var
  Form1        : TForm1;

implementation

{$R *.dfm}

uses
  Math;

{------------------------------------------------------------------------------}
{  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;

{------------------------------------------------------------------------------}
{  Form erzeugen                                                               }
{------------------------------------------------------------------------------}
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;

{------------------------------------------------------------------------------}
{  OnPaint der Paintbox                                                        }
{  Bitmap im Speicher auf die Paintbox kopieren                                }
{------------------------------------------------------------------------------}
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  BitBlt(Paintbox1.Canvas.Handle, 0, 0, Paintbox1.Width, Paintbox1.Height,
    BackBitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;

{------------------------------------------------------------------------------}
{  Größe des Bitmap im Speicher auf null setzen                                }
{------------------------------------------------------------------------------}
procedure TForm1.FormResize(Sender: TObject);
begin
  BackBitmap.Width := 0;
  BackBitmap.Height := 0;
end;

end.