یکی کمک کنه میخوام تو دلفی ساعت آنالوگ بسازم.

Printable View

27-05-2006, 05:48
Aminzikzak

یکی کمک کنه میخوام تو دلفی ساعت آنالوگ بسازم.

چطور تو دلفی به یه خط بگم که هر ثانیه یکبار بچرخه مثل عقربه ساعت؟ اگه میشه کدش رو هم بدید
27-05-2006, 10:24
soldier

سلام دوست عزيز
من اونو دارم.
اما فعلا كه نمي تونم آژ لودش كنم.
واسه ي اسكرين سيور خودم گذاشتمش.
با كد هاي دلفي
جالبه
بعدا آپ لودش مي كنم.
27-05-2006, 10:31
soldier

unit Transp_Clock;

interface

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

type
TForm1 = class(TForm)
Timer1: TTimer;
procedure ClockFrame(Sender: TObject);
procedure UpdateClock(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
OldH, OldM, OldSX, OldSY, OldMX, OldMY,
OldHX, OldHY : Integer;
FirstDraw : Boolean;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
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;
R:=Yo-30;

{ Set font properties }
Canvas.Font.Style:=[fsBold];
Canvas.Font.Name:='TimesNewRoman';

{ Set font background color to transparent . . . }
Canvas.Brush.Style:=bsClear;

{ Display numbers in a circle from 1 to 12 }
Canvas.Font.Size:=40;
Canvas.Font.Color:=clBlack;
For A:=1 to 12 Do
Begin
X:=Xo+Round(R*Sin(30*A*Pi/180));
Y:=Yo-Round(R*Cos(30*A*Pi/180))-20;
Canvas.TextOut(X,Y,IntToStr(A));
End;

Canvas.Font.Size:=35;
Canvas.Font.Color:=clYellow;
For A:=1 to 12 Do
Begin
X:=Xo+Round(R*Sin(30*A*Pi/180));
Y:=Yo-Round(R*Cos(30*A*Pi/180))-20;
Canvas.TextOut(X,Y,IntToStr(A));
End;
End;

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:=10;
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:=10;
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:=20;
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:=30;
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:=20;
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:=30;
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;

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

procedure TForm1.FormCreate(Sender: TObject);
begin
FirstDraw:=True;

{ Set Form background to transparent }
Brush.Style:=bsClear;
end;

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

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
{ Close the program if any key is pressed . . . }
Close;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
{ Close the program if mouse click . . . }
Close;
end;

end.
27-05-2006, 10:35
soldier

[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]
آپ لودش کردم.
27-05-2006, 18:50
Aminzikzak

دمت گرم ... ولی من تازه دلفی شروع کردم هر چی برنامه رو زیر و رو کردم چیزی نفهمیدم، میشه توضیحات بیشتری بدین...لطفا...
یه سوالم داشتم این کد روی همه شئ ها کارمیده مثلا ابزار Button یا Edit ... البته میشه این کارا رو تو فلش هم انجام داد بعد تو دلفی استفاده کرد ولی پروژه درسیه نمیشه از فلش استفاده کرد.
28-05-2006, 18:14
soldier

سلام
اگه می خوای یکی یکی قسمت های مختلف رو آموزش بدم.
در مورد فلش هم که میشه اما با دلفی بهتره.
خوب در مورده اینکه میگی ( این کد روی همه شئ ها کارمیده )
بله شما می تونید کد UpDateClock(Self); رو روی هر شی بزارید.
اونوقت میشه با یه کلیک روی دکمه ساعت بروز بشه.

خوب حالا آموزش :
TForm1.FormKeyDown وTForm1.FormMouseDown یعنی
وقتی که موس روی صفحه کلیک کردی و یا کلیدی از صفحه کلید زدی دستور Close(بسته) میده.

حالا TForm1.UpdateClock :
یه متغیر به نام DateTime وجود داره.
DateTime:=Time یعنی متغیر DateTime رو از زمان کنونی میگیره.
Caption:=' '+FormatDateTime('hh:nn:ss AM/PM',DateTime)
اینه که بالای صفحه زمان رو درج میکنه.

Xo:=Form1.Width Div 2;
Yo:=Form1.Height Div 2;
این قسمت XO نصف صفحه میشه و همچنین YO
Rs:=Yo-50;
Rm:=Rs;
Rh:=Rs-50;
این قسمت هم که فکر کنم حدث بزنید Rs از Yo پنجاه تا کمتر میشه.
و RM دقیقا مقدار RS رو می گیره. RH هم از RS پنجاه تا کمتر.

H:=StrToInt(Copy(FormatDateTime('hh AM/PM',DateTime),1,2));
M:=StrToInt(FormatDateTime('nn',DateTime));
S:=StrToInt(FormatDateTime('ss',DateTime));
متغیر H متعلق به ساعته یعنی از متغیر DateTime ساعت رو دریافت میکنه.
متغیر M هم دقیقه رو و متغیر S هم ثانیه.

Xs:=Xo+Round(Rs*Sin(S*6*Pi/180));
Ys:=Yo-Round(Rs*Cos(S*6*Pi/180));

Xs افق ثانیه است که از وسط صفحه به مقداری زیاد میشه.
Ys طوا ثانیه است که...

Xm:=Xo+Round(Rm*Sin(M*6*Pi/180));
Ym:=Yo-Round(Rm*Cos(M*6*Pi/180));

این هم دقیقا مثل ثانیه اما برای رقیقه کار میکنه.

Xh:=Xo+Round(Rh*Sin((H*30+M/2)*Pi/180));
Yh:=Yo-Round(Rh*Cos((H*30+M/2)*Pi/180));

این هم با تغیراتی برای ساعت کار میکنه.

If Not FirstDraw Then
Begin
Form1.Canvas.Pen.Color:=clBlack;
Form1.Canvas.Pen.Width:=10;
Form1.Canvas.MoveTo(Xo,Yo);
Form1.Canvas.LineTo(OldSX,OldSY);
End Else
Form1.Canvas.Pen.Mode:=pmNotXor;
این برای تنظیم کردن رنگ و عرض مداد و رفتن به وسط و کشیدن خطه.
که اگر برعکس FirstDraw مساوی True بود این اعمال انجام می گیره.
اگر هم نبود مد مداد رو بیرنگ می کنه.

Form1.Canvas.Pen.Color:=clBlack;
Form1.Canvas.Pen.Width:=10;
Form1.Canvas.MoveTo(Xo,Yo);
Form1.Canvas.LineTo(Xs,Ys);
OldSX:=Xs;
OldSY:=Ys;
کشیدن خط ثانیه.
که رنگ رو سایه و عرض مداد رو ده و به وسط صفخه رفته
و خط تا Xs , Ys که قبلا توضیح دادیم میره.

If FirstDraw Then
Begin
{ Draw minutes line }
Form1.Canvas.Pen.Color:=clGreen;
Form1.Canvas.Pen.Width:=20;
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:=30;
Form1.Canvas.MoveTo(Xo,Yo);
Form1.Canvas.LineTo(Xh,Yh);
OldHX:=Xh;
OldHY:=Yh;
End;

اگر FirstDraw = True بود
خط دقیقه و ساعت رو می کشه.
و مشخصات داده شده که فکر کنم اگه بخونی می فهمی.
برای دقیقه رنگ سبز رو انتخاب می کنه و عرض رو به 20
و برای ساعت رنگ قهوه ای و عرض 30

راستی بهتره بگم که در دستور if اگر باری متغیر Boolean به این صورت نوشتی
= True رو جانشین می کنه.
If Boolean then

و این قسمت
{ Refresh minute new position }
If (OldMX<>Xm) Or (OldMY<>Ym) Then
Begin
{ Erase previous one }
Form1.Canvas.Pen.Color:=clGreen;
Form1.Canvas.Pen.Width:=20;
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:=30;
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;

دقیقه و ساعت رو بروز می کنه.

خوب حالا TForm1.ClockFrame :
Xo:=Width Div 2;
Yo:=Height Div 2;
R:=Yo-30;
Xo برابر وسط صفحه میشه.
Yo هم همینطور.
R هم از Yo سی تا کمتر.

{ Set font properties }
Canvas.Font.Style:=[fsBold];
Canvas.Font.Name:='TimesNewRoman';
اینجا فونت رو تنظیم می کنه.

{ Set font background color to transparent . . . }
Canvas.Brush.Style:=bsClear;
اینجا وقتی که میخواد روی صفحه بنویسه
پشت نوشته ها بی رنگ میشه یعنی اگر این قسمت
رو حذف کنی می بینی پست نوشته ها رنگ فرمت رو میگیره.

{ Display numbers in a circle from 1 to 12 }
Canvas.Font.Size:=40;
Canvas.Font.Color:=clBlack;
For A:=1 to 12 Do
Begin
X:=Xo+Round(R*Sin(30*A*Pi/180));
Y:=Yo-Round(R*Cos(30*A*Pi/180))-20;
Canvas.TextOut(X,Y,IntToStr(A));
End;

Canvas.Font.Size:=35;
Canvas.Font.Color:=clYellow;
For A:=1 to 12 Do
Begin
X:=Xo+Round(R*Sin(30*A*Pi/180));
Y:=Yo-Round(R*Cos(30*A*Pi/180))-20;
Canvas.TextOut(X,Y,IntToStr(A));
End;
اینجا عدد ها را به صورت گردی یعنی عدد های ساعت
می نویسه . متغیر A توی حلقه از یک تا دوازده میره.
و بار اول با رنگ سیاه و سری بعد یعنی زیر این قسمت
با رنگ زرد مشخص می شه. برای اینکه جلوه ی زیبایی بگیره.
Canvas.TextOut(X,Y,IntToStr(A));
متغیر A رو روی صفحه می نویسه

X:=Xo+Round(R*Sin(30*A*Pi/180));
Y:=Yo-Round(R*Cos(30*A*Pi/180))-20;
X , Y رو برای نوشتن به صورت گرد در می آورد
یعنی 1 به سمت راست عدد 9 به سمت چپ.

procedure TForm1.Timer1Timer(Sender: TObject);
Begin
UpDateClock(Self);
end;
دستور میره که خط های دقیقه ساعت و ثانیه رو روی صفحه بکش
که اول توضیح دادم.

procedure TForm1.FormCreate(Sender: TObject);
begin
FirstDraw:=True;

{ Set Form background to transparent }
Brush.Style:=bsClear;
end;

Brush.Style:=bsClear;
میگه که صفحه بی رنگ باشه و صفحه پشت سر معلوم باشه.

FirstDraw:=True;
ثانیه رسم بشه.

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

این هم وقتی که صفحه باز شد و می خواست رسم بشه
دستور میده که اول شماره های ساعت رو بکش
و بعد دستور کشیدن خط های عقربه رو میده.

امید وارم که شما دوست گرامی
از این آموزش بهره برده باشید :laughing:
اگر غلط یا ناکامل بود ببخشید
و بهم بگید که کامل تر توضیح بدم. :blush:
به اینجا هم یه سری بزن :laughing:
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]
31-05-2006, 01:11
Aminzikzak

soldier جان از صمیم قلب تشکر میکنم ... خدا بچه هات رو واست حفظ کنه... تو کجا بودی تا حالا من نمی دونستم؟
31-05-2006, 08:55
soldier

سلام
خواهش مي كنم.
وظيفم بود كه به يه دوست كمك كنم.
و خوشحالم كه از اين آموزش استفاده كرده اي.
اگه باز هم سوالي داشتي در خدمت هستم.
12-05-2011, 10:08
اارکیده

من دلفی 7 دارم
رو اونم کار می کنه؟
من همون فایل زیپیکه قرار داده بودید رو باز کردم
اما هیچ کنترلی رو فرم نداره:41:
28-05-2011, 06:44
soldier

بله کار میکنه، یک تایمر روی فرم هست که تابع UpDateClock رو فراخوانی میکنه.