Главная страница
    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.45 MB
Время: 0.003 c
2-1295345106
Novi4ok1992
2011-01-18 13:05
2011.04.17
Ошибки отладки Дельфи 7


15-1294003799
Юрий
2011-01-03 00:29
2011.04.17
С днем рождения ! 3 января 2011 понедельник


2-1295100435
volkafff
2011-01-15 17:07
2011.04.17
Вопросы новичка про цикл и неповторяющиеся числа в массиве.


2-1295243332
bagos
2011-01-17 08:48
2011.04.17
перебор возможных вариантов


6-1236688524
maxistent
2009-03-10 15:35
2011.04.17
Передача данных через прокси





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский