Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
28
Добавлен:
16.04.2013
Размер:
5.54 Кб
Скачать
unit Var19;



interface

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


type
TForm1 = class(TForm)
Button2: TButton;
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;






type
TPoints = class
X,Y:Integer;
Visible:Boolean;
constructor Init(A,B:Integer);
function GetX:Integer;
function GetY:Integer;
procedure Show;virtual;
procedure Hide;virtual;
procedure Move(DX,DY:Integer);
end;





type
TCircle = class(TPoints)
Radius:Word;
Ex:word;
constructor Init(A,B:Integer;R:Word;exentr:word);
function GetR:Word;
procedure Show;override;
procedure Hide;override;
end;





type
CirFill = class(TCircle)
Color:TColor;
constructor Init(A,B:Integer;R:Word;C:TColor);
function GetC:TColor;
procedure Show;override;
procedure Hide;override;
end;







implementation
{$R *.dfm}




constructor TPoints.Init(A,B:Integer);
begin
X:=A;
Y:=B;
Visible:=False
end;





function TPoints.GetX:Integer;
begin
GetX:=X;
end;






function TPoints.GetY:Integer;
begin
GetY:=Y;
end;




procedure TPoints.Show;
begin
Form1.Canvas.Pixels[X,Y]:=Form1.Canvas.Pen.Color;
Visible:=True
end;





procedure TPoints.Hide;
begin
Form1.Canvas.Pixels[X,Y]:= Form1.Color;
Visible:=False
end;




procedure TPoints.Move(DX,DY:Integer);
var
B:Boolean;
begin
B:=Visible;
if B then
Hide;
X:=X+DX;
Y:=Y+DY;
if B then
Show
end;












constructor TCircle.Init(A,B:Integer;R:Word;exentr:word);
begin
inherited Init(A,B);
Radius:=R;
ex:=exentr
end;




function TCircle.GetR:Word;
begin
GetR:=Radius;
end;



procedure TCircle.Show;
begin
Form1.Canvas.Chord(X-Radius*ex,Y-Radius,X+Radius*ex,Y+Radius,X,Y-Radius,X,Y+Radius);
Visible:=True;
end;




procedure TCircle.Hide;
var
Color:TColor;
begin
Color:= Form1.Canvas.Pen.Color;
Form1.Canvas.Pen.Color := Form1.Color;
Show;
Visible:=False;
Form1.Canvas.Pen.Color:=Color;
end;











constructor CirFill.Init(A,B:Integer;R:Word;C: TColor);
begin
inherited Init(A,B,R,2); { Задать центр и радиус }
Color:=C { Задать цвет круга }
end;




function CirFill.GetC:TColor;{ Вернуть цвет круга }
begin
GetC:=Color
end;




procedure CirFill.Show; {Нарисовать закрашенный круг }
begin
inherited Show; { Нарисовать окружность }
//Form1.Canvas.FloodFill(X-1,Y+1,color,fsSurface);
Form1.Canvas.Brush.Color:=color ;
Visible:=True; { Установить признак светимости}
end;





procedure CirFill.Hide; { Стереть круг }
begin
Form1.Canvas.Brush.Color:= Form1.Color;
Form1.Canvas.pen.Color:=Form1.Color;
inherited Show;
Visible:=False;
Form1.Canvas.Brush.Color:=color ;
Form1.Canvas.pen.Color:=clBlack;
end;







procedure AnyHlop(Any:TCircle);
var
R:Word;
begin
with Any do
begin
R:=Radius; { Запомнить радиус окружности }
while Radius>0 do{ "Стянуть" окружность в точку, }
begin { постепенно уменьшая её радиус }
Show;
sleep(1);
Hide;
Dec(Radius);
end;
Visible:=False; { Сбросить признак светимости }
Radius:=R; { Восстановить исходный радиус }
end;
end;




procedure AnyPolh(Any:TCircle);
var
R:Word;
begin
with Any do
begin
R:=Radius; { Запомнить радиус окружности }
Radius:=0;
while Radius<R do{"Восстановить" окружность из точки}
begin { постепенно увеличивая её радиус }
sleep(1);
Hide;
Inc(Radius);
Show;
end;
Visible:=True; { Установить признак светимости }
Radius:=R; { Восстановить исходный радиус }
end;
end;







procedure TForm1.Button2Click(Sender: TObject);
var
C:TCircle; { Объект - окружность }
CF:CirFill; { Объект - закрашенный круг }
A,B:Integer; { Координаты центра круга }
R:Word; { Радиус круга }
Col:TColor; { Цвет круга }
Bool:Boolean;
i:Word;
begin
Form1.Color := clbtnface; {Установить текущие цвета}
Form1.Canvas.Pen.Color:= clBlack;{фона и линий }
Randomize;
Bool:=True;
C := TCircle.Create;
CF :=CirFill.Create;
for i:=1 to 10 do
begin
R:=Random(100)+50; { Выбрать радиус 50<=R<150 }
A:=Random(Form1.ClientWidth-2*R)+R;{ Выбрать центр круга }
B:=Random(Form1.ClientHeight-2*R)+R;
Col:=Random(65535); { Выбрать цвет круга }
if Bool then
begin
Form1.Color := clbtnface; {Установить текущие цвета}
Form1.Canvas.Pen.Color:= clBlack;{фона и линий }
Form1.Canvas.Brush.Color:= clbtnface;
C.Init(A,B,R,2); { Задать окружность }
C.Show; { Нарисовать окружность }
AnyHlop(C); { "Стянуть" её в точку }
AnyPolh(C); { "Восстановить её из точки}
end
else
begin
CF.Init(A,B,R,Col) ;{ Задать круг }
CF.Show; { Нарисовать круг }
AnyHlop(CF); { "Стянуть" круг в точку }
AnyPolh(CF); { "Восстановить" круг }
end;
Bool:=not Bool; { Сменить признак выбора типа объекта }
end;
C.Destroy;
CF.Destroy;
end;



end.

Соседние файлы в папке laba5(var6,15,24)
  • #
    16.04.20138.62 Кб26Var19.dcu
  • #
    16.04.201351 б27Var19.ddp
  • #
    16.04.2013497 б26Var19.dfm
  • #
    16.04.20135.54 Кб28Var19.pas
  • #
    16.04.201351 б26Var19.~ddp
  • #
    16.04.2013497 б26Var19.~dfm
  • #
    16.04.20135.5 Кб26Var19.~pas
  • #
    16.04.2013416 б26_Var19.cfg
  • #
    16.04.20132.02 Кб26_Var19.dof