Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)
Paste
Pasted by kenny ( 15 years ago )
program Lr18_17;{Laboratornaya rabota 18, variant 14, gruppa 93492, viplonil
Kudryavcev Sergey
Dobavte novie ob'ekty:tochku, okruzhnost,sfer u,shar,krug i prodemonstriruyte
ih ispolzovanie}
uses
Crt, Graph;
type
PGraphObject=^TGraphObject;
TGraphObject=object {bazoviy ob'ekt}
Active: Boolean; {priznak vidimosti ob'ekta}
x,y: Integer; {koordinaty ob'ekta}
Color: Integer; {cvet ob'ekta}
constructor Init; {konstruktor ob'ekta}
destructor Done;virtual; {destruktor}
procedure Locate (Nx,Ny:Integer); {zadanie koordinat}
procedure Step (Dx,Dy:Integer); {sdvig ob'ekta}
procedure Move; {haotichnoe dvizhenie}
procedure Show; {otobrazit' ob'ekt na ekrane}
procedure Hide; {skrit ob'ekt}
procedure Paint;virtual; {risovanie ob'ekta}
procedure Clear;virtual; {stiranie ob'ekta}
end;
PPoint=^TPoint;
TPoint=object(TGraphObject) {Tochka}
{zadanie koordinat i cveta tochki}
constructor InitData(Nx,Ny,c:Integer);
procedure Paint;virtual;
procedure Clear;virtual;
end;
PSphere=^TSphere;
TSphere=object(TGraphObject) {sfera}
r:Integer; {radius}
constructor InitData(Nx,Ny,Nr,c:Integer);
procedure Paint;virtual;
procedure Clear;virtual;
end;
PCircle=^TCircle;
TCircle=object(TGraphObject) {okruzhnost}
r:integer; {radius}
constructor InitData(Nx,Ny,Nr,c:integer);
procedure Paint; virtual;
procedure Clear; virtual;
end;
PCircleFill=^TCircleFill;
TCircleFill=object(TGraphObject) {krug}
r:integer;
constructor InitData(Nx,Ny,Nr,c:integer);
procedure Paint; virtual;
procedure Clear; virtual;
end;
PShar=^TShar;
TShar=object(TGraphObject)
r,color2:integer;
constructor InitData(Nx,Ny,Nr,c,c2:integer);
procedure Paint; virtual;
procedure Clear; virtual;
end;
constructor TGraphObject.Init;
begin
Active:=False; {iznachalno ob'ekt vidim}
end;
destructor TGraphObject.Done;
begin
Hide; {pered unichtozheniem stiraem ob'ekt s ekrana}
end;
procedure TGraphObject.Locate;
begin
Hide; {skroem ob'ekt}
x:=Nx; {zadadim novie koordinaty}
y:=Ny;
Show; {otobrazim na novom meste}
end;
procedure TGraphObject.Step;
begin
Hide; {skroem ob'ekt}
x:=x+Dx; {peremestim ob'ekt}
y:=y+Dy;
Show; {otobrazim na novom meste}
end;
procedure TGraphObject.Move;
begin
Step(Random(5)-2,Random(5)-2); {shagnem sluchaynim obrazom}
end;
procedure TGraphObject.Show;
begin
if not Active then {esli ob'ekt nevidim, to}
begin
Active:=True; {ustanovim flazhok visimosti}
Paint; {narisuem ob'ekt}
end;
end;
procedure TGraphObject.Hide;
begin
if Active then {esli ob'ekt vidim to...}
begin
Active:=False; {sbrosim flazhok vidimosti}
Clear; {sotrem ob'ekt}
end;
end;
procedure TGraphObject.Paint;
begin
end;
procedure TGraphObject.Clear;
begin
end;
constructor TPoint.InitData;
begin
inherited Init; {inicializaciya unasledovannih poley}
x:=Nx; {ustanovim koordinaty}
y:=Ny;
Color:=c; {zadadim cvet}
end;
procedure TPoint.Paint;
begin
PutPixel(x,y,Color);
end;
procedure TPoint.Clear;
begin
PutPixel(x,y,0);
end;
constructor TShar.InitData;
begin
inherited Init;
x:=Nx;
y:=Ny;
r:=Nr;
Color:=c;
Color2:=c2;
end;
procedure TShar.Paint;
begin
setcolor(color2);
Circle(x,y,r);
SetFillStyle(1,color);
Fillellipse(x,y,r,r);
Setcolor(color2);
Ellipse(x,y,0,359,r,r-3);
end;
procedure TShar.Clear;
begin
setcolor(0);
Circle(x,y,r);
SetFillStyle(1,0);
Fillellipse(x,y,r,r);
Ellipse(x,y,0,359,r,r-3);
end;
constructor TSphere.InitData;
begin
inherited Init;
x:=Nx;
y:=Ny;
r:=Nr;
Color:=c;
end;
procedure TSphere.Paint;
begin
setcolor(color);
Circle(x,y,r);
Ellipse(x,y,0,359,r,r-5);
end;
procedure TSphere.Clear;
begin
SetColor(0);
Circle(x,y,r);
Ellipse(x,y,0,359,r,r-5);
end;
constructor TCircle.InitData;
begin
inherited init;
x:=Nx;
y:=Ny;
r:=Nr;
color:=c;
end;
procedure TCircle.Paint;
begin
setcolor(color);
Circle(x,y,r);
end;
procedure TCircle.Clear;
begin
setcolor(0);
circle(x,y,r);
end;
constructor TCircleFill.InitData;
begin
inherited init;
x:=Nx;
y:=Ny;
r:=Nr;
color:=c;
end;
procedure TCircleFill.Paint;
begin
setcolor(color);
Circle(x,y,r);
SetFillStyle(1,color);
FillEllipse(x,y,r,r);
end;
procedure TCircleFill.Clear;
begin
Setcolor(0);
SetFillStyle(0,0);
FillEllipse(x,y,r,r);
end;
{perehod v graficheskiy rezhim}
procedure InitVideo;
var
grDriver,grMode:Integer;
begin
grDriver:=Detect;
InitGraph(grDriver,grMode,'');
if GraphResult<>grOk then
begin
Writeln('Ошибка при инициализации графики !');
Halt(1);
end;
end;
{vozvrat v tekstoviy rezhim}
procedure DoneVideo;
begin
CloseGraph;
end;
var
a:array[1..150] of PGraphObject; {massiv proizvolih ob'ektov}
i:Integer;
begin
ClrScr; {perehod v graficheskiy rezhim}
InitVideo;
{inicializiruem generator sluchaynih chisel}
Randomize;
{sozdaem 150 graficheskih ob'ektov}
for i:=1 to 150 do
case Random(5) of
0:{tochku} a[i]:=New(PPoint,InitData(
20+Random(600), 20+Random(440), {koordinaty}
1+Random(14))); {cvet}
1:{sozdaem sferu}
a[i]:=New(PSphere,InitData(20+Random(600),20+Random(440),5+Random(5),1+Random(14)));
2:{sozdaem okruzhnost}
a[i]:=New(PCircle, InitData(20+Random(600),20+Random(440),5+Random(5),1+Random(14)));
3: {sozdaem krug}
a[i]:=New(PCircleFill, InitData(20+Random(600),20+Random(440),5+Random(5),1+Random(14)));
4:a[i]:=New(PShar,InitData(20+Random(600),20+Random(440),5+Random(5),1+Random(14),1+Random(14)));
end;
while not KeyPressed do
for i:=1 to 150 do
a[i]^.Move; {haotichno peremeshaem ob'ekt}
ReadKey;
{unichtozhaem ob'ekt}
for i:=1 to 150 do
Dispose (a[i],Done);
{vozvrashemsya v tekstoviy rezhim}
DoneVideo;
end.
Revise this Paste