Помощь - Поиск - Пользователи - Календарь
Полная версия: Часы с плавно передвигающейся минутной стрелкой
Форум «Всё о Паскале» > Современный Паскаль и другие языки > Делфи
Lis
Уважаемые господа.
Есть простенькая программка с часами, которая показывает данное время.. Но одно я осилить не могу..
Дело в том что секундная стрелка передвигается резко, а нужно сделать так чтоб передвигалась плавно (типа как в швейцарских часах =) )
Не будете так добры подсказать способ?

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Timer1: TTimer;
Button1: TButton;
procedure DrawArrows(DrawColor: TColor);
procedure FormCreate(Sender: TObject);
procedure FormPaint(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
CenterY:= Form1.ClientHeight div 2;
CenterX:= CenterY;
Radius:=CenterX - 20;
HourArrow:=Radius - 30;
MinArrow:= Radius - 20;
SecArrow:= Radius- 10;
end;

procedure TForm1.FormPaint(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');
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
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:='Stop';
Timer1.Enabled:=true;
end
else begin
Button1.Caption:='Старт';
Timer1.Enabled:=false;
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.

Client
прикрепи проект
скопировал я код, назначил обработчики - появляются "часы", а точнее пару точек в левом верхнем углу
Цитата
передвигается резко, а нужно сделать так чтоб передвигалась плавно
т.е. раз в секунда передвигается? сделай тогда интервал меньше в таймере, 100мс должно хватить...
Lis
приношу свои глубочайшие извинения за не точную информацию!
Не секундную, а минутную стрелку! Т.е. чтоб минутная после прохода круга секундной не резко перешла на следующую минуту, а плавно переходила в след за секундной, ну понимаете как на наручных часах типа швейцарских =)
volvo
procedure TForm1.Timer1Timer(Sender: TObject);
begin
DrawArrows(ClWhite);
DecodeTime(Time, Hour, min, sec, msec);
HourAngle:=(Hour mod 12) / 12 *(2*pi);
MinAngle:=(min + sec / 60) / 60 * (2* Pi); // <--- Вот так
SecAngle:=sec/ 60 *(2*pi);
DrawArrows(clRed);
end;
Lis
Спасибо большое! Все отлично!
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.