Добавил:
korayakov
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:2004 ИС (Илюшечкин) / ВМИП / Labs / laba5(var6,15,24) / Var19
.pas 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.
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)