Delphi Tutorial


 

Analog clock

 

      

Download this example

          This is the main procedure that draws the clock needles. It has some basic trigonometric mathematics to find circular coordinates.

procedure TForm1.UpdateClock(Sender: TObject);
Var
     DateTime : TDateTime;
     Xo, Yo, Xs, Ys, Xm, Ym, Xh, Yh, H, M, S, Rs, Rm, Rh :      Integer;
begin
     { Get current time }
     DateTime:=Time;

     { Display time in form title }
     Caption:=' '+FormatDateTime('hh:nn:ss AM/PM',DateTime);

     { Set center point }
     Xo:=Form1.Width Div 2;
     Yo:=Form1.Height Div 2;

     { Clock radius }
     Rs:=Yo-50;
     Rm:=Rs;
     Rh:=Rs-50;

     { Extract hours }
     H:=StrToInt(Copy(FormatDateTime('hh      AM/PM',DateTime),1,2));
     { Extract minutes }
     M:=StrToInt(FormatDateTime('nn',DateTime));
     { Extract seconds }
     S:=StrToInt(FormatDateTime('ss',DateTime));

     { Set coordinates for seconds }
     Xs:=Xo+Round(Rs*Sin(S*6*Pi/180));
     Ys:=Yo-Round(Rs*Cos(S*6*Pi/180));

     { Set coordinates for minutes }
     Xm:=Xo+Round(Rm*Sin(M*6*Pi/180));
     Ym:=Yo-Round(Rm*Cos(M*6*Pi/180));

     { Set coordinates for hours }
     Xh:=Xo+Round(Rh*Sin((H*30+M/2)*Pi/180));
     Yh:=Yo-Round(Rh*Cos((H*30+M/2)*Pi/180));

     { Erase previous line for seconds }
     If Not FirstDraw Then
     Begin
          Form1.Canvas.Pen.Color:=clBlack;
          Form1.Canvas.Pen.Width:=1;
          Form1.Canvas.MoveTo(Xo,Yo);
          Form1.Canvas.LineTo(OldSX,OldSY);
     End Else
          Form1.Canvas.Pen.Mode:=pmNotXor;

     { Draw seconds line }
     Form1.Canvas.Pen.Color:=clBlack;
     Form1.Canvas.Pen.Width:=1;
     Form1.Canvas.MoveTo(Xo,Yo);
     Form1.Canvas.LineTo(Xs,Ys);
     OldSX:=Xs;
     OldSY:=Ys;

     If FirstDraw Then
     Begin
          { Draw minutes line }
          Form1.Canvas.Pen.Color:=clGreen;
          Form1.Canvas.Pen.Width:=2;
          Form1.Canvas.MoveTo(Xo,Yo);
          Form1.Canvas.LineTo(Xm,Ym);
          OldMX:=Xm;
          OldMY:=Ym;

          { Draw hour line }
          Form1.Canvas.Pen.Color:=clMaroon;
          Form1.Canvas.Pen.Width:=3;
          Form1.Canvas.MoveTo(Xo,Yo);
          Form1.Canvas.LineTo(Xh,Yh);
          OldHX:=Xh;
          OldHY:=Yh;
     End;

     { Refresh minute new position }
     If (OldMX<>Xm) Or (OldMY<>Ym) Then
     Begin
          { Erase previous one }
          Form1.Canvas.Pen.Color:=clGreen;
          Form1.Canvas.Pen.Width:=2;
          Form1.Canvas.MoveTo(Xo,Yo);
          Form1.Canvas.LineTo(OldMX,OldMY);

          { Draw new line }
          Form1.Canvas.MoveTo(Xo,Yo);
          Form1.Canvas.LineTo(Xm,Ym);
          OldMX:=Xm;
          OldMY:=Ym;
     End;

     { Refresh hour new position }
     If (OldHX<>Xh) Or (OldHY<>Yh) Then
     Begin
          { Erase previous one }
          Form1.Canvas.Pen.Color:=clMaroon;
          Form1.Canvas.Pen.Width:=3;
          Form1.Canvas.MoveTo(Xo,Yo);
          Form1.Canvas.LineTo(OldHX,OldHY);

          { Draw new line }
          Form1.Canvas.MoveTo(Xo,Yo);
          Form1.Canvas.LineTo(Xh,Yh);
          OldHX:=Xh;
          OldHY:=Yh;
     End;
End;

 

 

 

          This one draws clock circular frame.

procedure TForm1.ClockFrame(Sender: TObject);
Var
     A, R, Xo, Yo, X, Y : Integer;
Begin
     { Set center point }
     Xo:=Width Div 2;
     Yo:=Height Div 2;

     If Yo<Xo Then R:=Yo-30 Else R:=Xo-30;

     For A:=0 to 12 Do
     Begin
          X:=Xo+Round(R*Sin(30*A*Pi/180));
          Y:=Yo-Round(R*Cos(30*A*Pi/180));
          Canvas.Brush.Color:=clGreen;
          Canvas.Ellipse(X-4,Y-4,X+4,Y+4);
     End;
End;

 

 

        Call these two procedure in FormPaint event and system timer events.

procedure TForm1.Timer1Timer(Sender: TObject);
Begin
     UpDateClock(Self);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
     FirstDraw:=True;
     ClockFrame(Self);
     UpDateClock(Self);
     FirstDraw:=False;
end;

 

DOWNLOAD this example

Click here to download this complete example for Delphi 6. (File size 4KB)

 

Go top

 


Previous Page First Page Next Page
 
Copyright © 2002 digitalcoding.com. All rights reserved.