تبلیغات :
ماهان سرور
آکوستیک ، فوم شانه تخم مرغی ، پنل صداگیر ، یونولیت
دستگاه جوجه کشی حرفه ای
فروش آنلاین لباس کودک
خرید فالوور ایرانی
خرید فالوور اینستاگرام
خرید ممبر تلگرام

[ + افزودن آگهی متنی جدید ]




نمايش نتايج 1 به 10 از 10

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

  1. #1
    حـــــرفـه ای Aminzikzak's Avatar
    تاريخ عضويت
    May 2006
    پست ها
    6,216

    پيش فرض یکی کمک کنه میخوام تو دلفی ساعت آنالوگ بسازم.

    چطور تو دلفی به یه خط بگم که هر ثانیه یکبار بچرخه مثل عقربه ساعت؟ اگه میشه کدش رو هم بدید

  2. #2
    آخر فروم باز soldier's Avatar
    تاريخ عضويت
    May 2006
    پست ها
    2,505

    پيش فرض

    سلام دوست عزيز
    من اونو دارم.
    اما فعلا كه نمي تونم آژ لودش كنم.
    واسه ي اسكرين سيور خودم گذاشتمش.
    با كد هاي دلفي
    جالبه
    بعدا آپ لودش مي كنم.

  3. #3
    آخر فروم باز soldier's Avatar
    تاريخ عضويت
    May 2006
    پست ها
    2,505

    پيش فرض

    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.
    Last edited by soldier; 27-05-2006 at 10:37.

  4. این کاربر از soldier بخاطر این مطلب مفید تشکر کرده است


  5. #4

  6. این کاربر از soldier بخاطر این مطلب مفید تشکر کرده است


  7. #5
    حـــــرفـه ای Aminzikzak's Avatar
    تاريخ عضويت
    May 2006
    پست ها
    6,216

    پيش فرض

    دمت گرم ... ولی من تازه دلفی شروع کردم هر چی برنامه رو زیر و رو کردم چیزی نفهمیدم، میشه توضیحات بیشتری بدین...لطفا...
    یه سوالم داشتم این کد روی همه شئ ها کارمیده مثلا ابزار Button یا Edit ... البته میشه این کارا رو تو فلش هم انجام داد بعد تو دلفی استفاده کرد ولی پروژه درسیه نمیشه از فلش استفاده کرد.

  8. #6
    آخر فروم باز soldier's Avatar
    تاريخ عضويت
    May 2006
    پست ها
    2,505

    1

    سلام
    اگه می خوای یکی یکی قسمت های مختلف رو آموزش بدم.
    در مورد فلش هم که میشه اما با دلفی بهتره.
    خوب در مورده اینکه میگی ( این کد روی همه شئ ها کارمیده )
    بله شما می تونید کد 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;

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



    امید وارم که شما دوست گرامی
    از این آموزش بهره برده باشید
    اگر غلط یا ناکامل بود ببخشید
    و بهم بگید که کامل تر توضیح بدم.
    به اینجا هم یه سری بزن
    [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

  9. #7
    حـــــرفـه ای Aminzikzak's Avatar
    تاريخ عضويت
    May 2006
    پست ها
    6,216

    پيش فرض

    soldier جان از صمیم قلب تشکر میکنم ... خدا بچه هات رو واست حفظ کنه... تو کجا بودی تا حالا من نمی دونستم؟

  10. #8
    آخر فروم باز soldier's Avatar
    تاريخ عضويت
    May 2006
    پست ها
    2,505

    پيش فرض

    سلام
    خواهش مي كنم.
    وظيفم بود كه به يه دوست كمك كنم.
    و خوشحالم كه از اين آموزش استفاده كرده اي.
    اگه باز هم سوالي داشتي در خدمت هستم.

  11. #9
    در آغاز فعالیت
    تاريخ عضويت
    May 2011
    پست ها
    3

    پيش فرض

    من دلفی 7 دارم
    رو اونم کار می کنه؟
    من همون فایل زیپیکه قرار داده بودید رو باز کردم
    اما هیچ کنترلی رو فرم نداره

  12. #10
    آخر فروم باز soldier's Avatar
    تاريخ عضويت
    May 2006
    پست ها
    2,505

    پيش فرض

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

  13. این کاربر از soldier بخاطر این مطلب مفید تشکر کرده است


Thread Information

Users Browsing this Thread

هم اکنون 1 کاربر در حال مشاهده این تاپیک میباشد. (0 کاربر عضو شده و 1 مهمان)

User Tag List

قوانين ايجاد تاپيک در انجمن

  • شما نمی توانید تاپیک ایحاد کنید
  • شما نمی توانید پاسخی ارسال کنید
  • شما نمی توانید فایل پیوست کنید
  • شما نمی توانید پاسخ خود را ویرایش کنید
  •