Конференция "Media" » разработка класса для изображения квадрата [D7]
 
  • Staska © (26.05.08 18:19) [0]
    Здравствуйте, уважаемые мастера!
    Есть программка по созданию класса для изображения квадрата! Посмотрите ее пожалуйста, может что-то улучшить или упростить?
    Спасибо!

    unit unit_form;

    interface

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

    type
     TForm1 = class(TForm)
       Panel2: TPanel;
       Edit1: TEdit;
       Label1: TLabel;
       Edit2: TEdit;
       Label2: TLabel;
       Edit3: TEdit;
       Label3: TLabel;
       Edit4: TEdit;
       Label4: TLabel;
       Label5: TLabel;
       ColorBox1: TColorBox;
       Button1: TButton;
       Edit5: TEdit;
       Label6: TLabel;
       Edit6: TEdit;
       Label7: TLabel;
       Button2: TButton;
       Panel3: TPanel;
       procedure Button2Click(Sender: TObject);
       procedure Button1Click(Sender: TObject);
     private
       { Private declarations }
     public
       { Public declarations }
     end;

     TMyAnimateClass = class
     private
       { Private declarations }
       d_k,s_k:integer;
       beg_pos,end_pos:TPoint;
       color_k:TColor;
       out_can:TCanvas;
     public
       { Public declarations }
       constructor Create(d,s:integer;bp:TPoint;c:TColor;canva:TObject);
       procedure SetEndPos(end_p:TPoint);
     end;

    var
     Form1: TForm1;
     my_obj:TMyAnimateClass;
    implementation

    {$R *.dfm}
    constructor TMyAnimateClass.Create(d,s:integer;bp:TPoint;c:TColor;canva:TObject);
    begin
    //вызовем унаследованый конструктор и присвоим полям класса значения
    inherited Create;
    d_k:=d;
    s_k:=s;
    color_k:=c;
    beg_pos.X:=bp.X;
    beg_pos.Y:=bp.Y;
    out_can:=canva as TCanvas;
    out_can.Brush.Color:=color_k;
    out_can.Pen.Color:=color_k;
    out_can.Rectangle(beg_pos.X,beg_pos.Y,beg_pos.X+d_k,beg_pos.Y+d_k);
    end;
    ////////////////////////////////////////////////////////////////////////////////
    procedure TMyAnimateClass.SetEndPos(end_p:TPoint);
    var i,j:integer;
    begin
    //определим поле для рисования
    end_pos:=end_p;
    // по Х
    if beg_pos.X>end_pos.X then begin
    for i:=beg_pos.X downto end_pos.X do begin
    out_can.Rectangle(i,beg_pos.Y,i+d_k,beg_pos.Y+d_k);
    sleep(300 div s_k);
    end;
    end else
    for i:=beg_pos.X to end_pos.X do begin
    out_can.Rectangle(i,beg_pos.Y,i+d_k,beg_pos.Y+d_k);
    sleep(300 div s_k);
    end;
    //теперь по У
    if beg_pos.Y>end_pos.Y then begin
    for i:=beg_pos.Y downto end_pos.Y do begin
    out_can.Rectangle(end_pos.X,i,end_pos.X+d_k,i+d_k);
    sleep(300 div s_k);
    end;
    end else
    for i:=beg_pos.Y to end_pos.Y do begin
    out_can.Rectangle(end_pos.X,i,end_pos.X+d_k,i+d_k);
    sleep(300 div s_k);
    end;
    end;
    ////////////////////////////////////////////////////////////////////////////////
    procedure TForm1.Button2Click(Sender: TObject);
    var p:TPoint;
    begin
    p.X:=StrToInt(Edit5.Text);
    p.Y:=StrToInt(Edit6.Text);
    my_obj.SetEndPos(p);
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    var p:TPoint;
    begin
    Form1.Refresh;//очистка экрана
    p.X:=StrToInt(Edit2.Text);//формируем запись
    p.Y:=StrToInt(Edit3.Text);
    my_obj:=TMyAnimateClass.Create(StrToInt(Edit1.Text),StrToInt(Edit4.Text),p,Color Box1.Selected,Form1.Canvas);
    end;

    end.
  • Сергей М. © (26.05.08 19:09) [1]

    > может что-то улучшить или упростить?


    Проще выбросить все это добро на свалку.

    Скажи, чем не угодил существующий класс TShape ?
 
Конференция "Media" » разработка класса для изображения квадрата [D7]
Есть новые Нет новых   [134431   +15][b:0][p:0]