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.
Michael Puff