Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 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.47 MB
Время: 0.007 c
1-1252242428
Ruzzz
2009-09-06 17:07
2011.04.17
Сериализация, хочу найти лучшее решения


15-1293831003
Юрий
2011-01-01 00:30
2011.04.17
С днем рождения ! 1 января 2011 суббота


15-1293917399
Юрий
2011-01-02 00:29
2011.04.17
С днем рождения ! 2 января 2011 воскресенье


2-1295060421
mfender
2011-01-15 06:00
2011.04.17
Не получается создать объект указанного класса


3-1256786873
alshtam
2009-10-29 06:27
2011.04.17
Выполнить скрипт из текстового файла