Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Media";
Текущий архив: 2011.04.17;
Скачать: [xml.tar.bz2];

Вниз

разработка класса для изображения квадрата   Найти похожие ветки 

 
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 вся ветка

Форум: "Media";
Текущий архив: 2011.04.17;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.45 MB
Время: 0.004 c
15-1293565837
TUser
2010-12-28 22:50
2011.04.17
Почему эбонит электризуется при натерании об шерсть?


2-1295201878
IPranker
2011-01-16 21:17
2011.04.17
Определить, является ли многоугольник выпуклым?


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


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


15-1294148572
alexdn_
2011-01-04 16:42
2011.04.17
c++





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский