Текущий архив: 2011.04.17;
Скачать: CL | DM;
Внизразработка класса для изображения квадрата Найти похожие ветки
← →
Staska © (2008-05-26 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.
← →
Сергей М. © (2008-05-26 19:09) [1]
> может что-то улучшить или упростить?
Проще выбросить все это добро на свалку.
Скажи, чем не угодил существующий класс TShape ?
Страницы: 1 вся ветка
Текущий архив: 2011.04.17;
Скачать: CL | DM;
Память: 0.45 MB
Время: 0.003 c