|
| |
Стрелочные часы
<<< Назад
Unit Chasiki;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Timer1: TTimer;
procedure DrawArrows(DrawColor: TColor);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private { Private declarations }
public { Public declarations }
end;
var
Form1: TForm1;
CenterX, CenterY, Radius: Integer;
HourArrow, MinArrow,SecArrow: Integer;
Hour, Min, Sec, MSec: Word;
HourAngle, MinAngle, SecAngle: real;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.BorderStyle:=bsSingle;
Form1.BorderIcons:=[biSystemMenu];
Timer1.Interval:=1000;
Timer1.Enabled:=false;
CenterY:=Form1.ClientHeight div 2;
CenterX:=CenterY;
Radius:=CenterX-20;
HourArrow:=Radius-30;
MinArrow:=Radius-20;
SecArrow:=Radius-10;
end;
procedure TForm1.Button1Click(Sender: TObject);
var i: Integer;
begin
//Прорисовка циферблата
with Form1.Canvas do begin
//Вывод окружности
Pen.Color:=clBlue;
Pen.Width:=4;
Brush.Color:=clWhite;
Ellipse(20, 20, 20+2*Radius, 20+2*Radius);
Pen.Width:=2;
//Вывод рисок
for i:=0 to 11 do begin
MoveTo(CenterX+Round((Radius-9)*sin(i/6*pi)), CenterY-Round((Radius-9)*cos(i/6*pi)));
LineTo(CenterX+Round((Radius)*sin(i/6*pi)), CenterY-Round((Radius)*cos(i/6*pi)));
end;
//Вывод цифр
Font.Height:=10;
Font.Color:=clBlack;
Brush.Color:=Form1.Color;
TextOut(CenterX-TextWidth('12') div 2,CenterY-Radius-TextHeight('12')-5,'12');
TextOut(CenterX+Radius+5, CenterY-TextHeight('3'),'3');
TextOut(CenterX-TextWidth('6') div 2, CenterY+Radius+5,'6');
TextOut(CenterX-Radius-TextWidth('9')-5, CenterY-TextHeight('9'),'9');
if Button1.Caption='Старт' then begin
//Запуск часов
DecodeTime(Time, Hour, Min, Sec, MSec);
HourAngle:=(Hour mod 12)/12*(2*pi);
MinAngle:=Min/60 * (2*pi);
SecAngle:=Sec/60 * (2*pi);
DrawArrows(clRed);
Button1.Caption:='Стоп';
Timer1.Enabled:=true;
end
else begin
//Остановка часов
Button1.Caption:='Старт';
Timer1.Enabled:=False;
end;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
//Стереть стрелки
DrawArrows(clWhite);
//Нарисовать стрелки на новом месте
DecodeTime(Time, Hour, Min, Sec, MSec);
HourAngle:=(Hour mod 12)/12*(2*pi);
MinAngle:=Min/60 * (2*pi);
SecAngle:=Sec/60 * (2*pi);
DrawArrows(clRed);
end;
procedure TForm1.DrawArrows(DrawColor: TColor);
begin
with Form1.Canvas do begin
Pen.Color:=DrawColor;
MoveTo(CenterX, CenterY);
//Часовая стрелка
Pen.Width:=3;
LineTo(CenterX+Round(HourArrow*sin(HourAngle)), CenterY-Round(HourArrow*cos(HourAngle)));
MoveTo(CenterX, CenterY);
//Минутная стрелка
Pen.Width:=2;
LineTo(CenterX+Round(MinArrow*sin(MinAngle)), CenterY-Round(MinArrow*cos(MinAngle)));
MoveTo(CenterX, CenterY);
//Секундная стрелка
Pen.Width:=1;
LineTo(CenterX+Round(SecArrow*sin(SecAngle)), CenterY-Round(SecArrow*cos(SecAngle)));
end;
end;
end.
<<< Назад |
|
|
|
|
