Welcome, guest! Login / Register - Why register?
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

Your Name: Code Language: