20.Prednaska

Z Pascal
Prejsť na: navigácia, hľadanie
20. Prednáška

úlohy | cvičenie

Virtuálne metódy triedy TRobot

Definícia triedy TRobot v RobotUnit.pas má skoro všetky metódy virtuálne. To znamená, že v našich programoch budeme môcť využívať polymorfizmus. Okrem toho, niektoré metódy triedy TRobot využívajú jeho iné metódy a teda ich predefinovanie má za následok zmenu správania aj týchto metód. Napr. ak opravíme SetXY, bude to mať vplyv aj na metódu Fd.



Príklad so zmenou SetXY


Pozrime príklad, v ktorom zmeníme SetXY. Zadefinujeme tri roboty, každý z ktorých bude mať inak zadefinovanú metódu SetXY a teda budú inak realizovať aj svoju metódu Fd. Robot v inštancii Robot bude nezmenený základný robot, a teda sa bude správať "normálne". Trieda TRobot1 a jeho inštancia Robot1 príkazom (metódou) SetXY(X, Y) mení iba Y-ovú súradnicu, pričom X-ová ostáva bez zmeny. Podobne trieda TRobot2 a jeho inštancia Robot2 príkazom (metódou) SetXY(X, Y) mení iba X-ovú súradnicu, pričom Y-ová ostáva bez zmeny. V aplikácii využívame časovač Timer1:

type
  TRobot1 = class(TRobot)
    procedure SetXY(NewX, NewY: Real); override;
  end;
 
  TRobot2 = class(TRobot)
    procedure SetXY(NewX, NewY: Real); override;
  end;
 
procedure TRobot1.SetXY(NewX, NewY: Real);
begin
  inherited SetXY(X, NewY);
end;
 
procedure TRobot2.SetXY(NewX, NewY: Real);
begin
  inherited SetXY(NewX, Y);
end;
 
var
  Robot, Robot1, Robot2: TRobot;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Robot := TRobot.Create;
  Robot.PW := 5;
  Robot.PC := clRed;
  Robot1 := TRobot1.Create;
  Robot1.PW := 5;
  Robot1.PC := clBlue;
  Robot2 := TRobot2.Create;
  Robot2.PW := 5;
  Robot2.PC := clGreen;
  Timer1.Interval := 30;
  Timer1.Enabled := True;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var
  Uhol: Integer;
begin
  CS;
  // Image1.Canvas.Pen.Color := clSilver;
  // Image1.Canvas.Pen.Width := 1;
  // Image1.Canvas.Line(0, Image1.Height div 2,Image1.Width, Image1.Height div 2);
  // Image1.Canvas.Line(Image1.Width div 2, 0, Image1.Width div 2, Image1.Height);
  Robot.Fd(5);
  Robot1.Fd(5);
  Robot2.Fd(5);
  Uhol := Random(10);
  Robot.Rt(Uhol);
  Robot1.Rt(Uhol);
  Robot2.Rt(Uhol);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Robot.Free;
  Robot1.Free;
  Robot2.Free;
end;

Ak by boli všetky tri roboty vytvorené tej istej triedy TRobot (t.j. napr. aj Robot1 := TRobot.Create;), tak by sme videli kresbu len jedného z nich (posledného - zeleného). Všimnite si, že všetky tri roboty sú deklarované ako premenné typu TRobot, ale priraďujeme im inštancie rôznych typov (TRobot, TRobot1 aj TRobot2).

Uvedomte si, že sme vďaka polymorfizmu upravili funkčnosť nejakej procedúry, ktorá je definovaná v inom unite a pritom sme do tohto unitu nemuseli ani zasahovať.



Príklad so zmenou SetH



Najprv naprogramujme, ako budú dva "obyčajné" roboty kresliť do plochy pri pohybe myšou:

var
  Robot1, Robot2: TRobot;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Robot1 := TRobot.Create;
  Robot1.PC := clLtGray;
  Robot1.PW := 7;
  Robot2 := TRobot.Create;
end;
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Robot1.MoveXY(X, Y);
  Robot2.MoveXY(X, Y);
end;
 
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
 Vzdial: Real;
begin
  if Shift = [ssLeft] then
  begin
    Vzdial := Robot1.Dist(X, Y);
    Robot1.Towards(X, Y);
    Robot1.Fd(Vzdial);
    Robot2.H := Robot1.H;
    Robot2.Fd(Vzdial);
  end;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Robot1.Free;
  Robot2.Free;
end;

Hoci trochu komplikovane, ale predsa oba roboty kreslia presne to isté: pri pohybe myšou najprv prvý robot nakreslí hrubšiu šedú čiaru a potom po nej prejde aj druhý robot tenkým čiernym perom. Metóda Towards otočí robota smerom k bodu (X, Y), Metóda Dist vypočíta vzdialenosť robota k zadanému bodu (X, Y). Príkazom Robot2.H := Robot1.H; nastavíme druhému robotu rovnaký uhol natočenia, ako má prvý.

Teraz dodefinujeme novú triedu, ktorej poopravíme metódu SetH tak, aby nastavovala uhol na opačný:

type
  TMojRobot = class(TRobot)
    procedure SetH(Uhol: Real); override;
  end;
 
procedure TMojRobot.SetH(Uhol: Real);
begin
  inherited SetH(-Uhol);
end;
 
...
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Robot1 := TRobot.Create;
  Robot1.PC := clLtGray;
  Robot1.PW := 7;
  Robot2 := TMojRobot.Create;
end;

Pozrite, ako sa teraz správa druhý robot (kreslí tenké čierne čiary): Robot2 kreslí zrkadlovo vzhľadom k Robot1, keďže namiesto Rt robí vlastne Lt.

Poexperimentujte s rôznymi úpravami metódy TMojRobot.SetH, napr.

inherited SetH(90 - Uhol);
inherited SetH(180 + Uhol);
inherited SetH(2 * Uhol);

Zaujímavý efekt vznikne aj vtedy, keď do FormCreate pridáme príkaz Robot1.PU;.



Príklad s kreslením domčeka



V ďalšej sérii príkladov demonštrujeme rôzne pozmenené správanie príkazov Fd a Rt.

Najprv pripravíme verziu programu, v ktorej bude kresliť ešte nepozmenený robot. Každé kliknutie do grafickej plochy na tomto mieste vytvorí robot, ktorý nakreslí domček zo štvorca a trojuholníka:

procedure Domcek(Robot: TRobot; Velkost: Real);
var
  I: Integer;
begin
  for I := 1 to 4 do
  begin
    Robot.Rt(90);
    Robot.Fd(Velkost);
  end;
  Robot.Rt(30);
  Robot.Fd(Velkost);
  Robot.Rt(120);
  Robot.Fd(Velkost);
end;
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Robot: TRobot;
begin
  Robot := TRobot.Create(X, Y);
  Domcek(Robot, 70);
  Robot.Free;
end;

Ak robot nedokáže robiť úsečky presnej dĺžky, ale s nejakou pravdepodobnosťou sa "mýli" o ±10%, môžu vznikať zaujímavé kresby:

type
  TRobot1 = class(TRobot)
    procedure Fd(Dlzka: Real); override;
  end;
 
procedure TRobot1.Fd(Dlzka: Real);
begin
  inherited Fd(Dlzka * (0.9 + Random(20) / 100));
end;
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Robot: TRobot;
begin
  Robot := TRobot1.Create(X, Y);
  Domcek(Robot, 70);
  Robot.Free;
end;

robot kreslí domčeky s nepresným Fd

Trieda TRobot2 má metódu Fd v poriadku (je odvodená z TRobot), ale otáčanie Rt nechodí presne, ale robot sa mýli o ±10%. Otestujte to na príklade s domčekom:

type
  TRobot2 = class(TRobot)
    procedure Rt(Uhol: Real); override;
  end;
 
procedure TRobot2.Rt(Uhol: Real);
begin
  inherited Rt(Uhol * (0.9 + Random(20) / 100));
end;
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Robot: TRobot;
begin
  Robot := TRobot2.Create(X, Y);
  Domcek(Robot, 70);
  Robot.Free;
end;

robot kreslí domčeky s nepresným Rt

Ak by sme odvodili triedu TRobot2 z TRobot1, dostali by sme robot, ktorý nevie robiť ani presné Fd ani presné Rt:

type
  TRobot2 = class(TRobot1)
    ...

Ďalšie dve triedy ilustrujú iné dva varianty zmenenej metódy Fd:

type
  TRobot3 = class(TRobot)
    procedure Fd(Dlzka: Real); override;
  end;
 
procedure TRobot3.Fd(Dlzka: Real);
begin
  inherited;               // to je to isté, ako inherited Fd(Dlzka);
  Lt(180 + Random(41) / 10 - 2);
  inherited;
  Lt(180 + Random(41) / 10 - 2);
  inherited;
end;

robot kreslí domčeky s umeleckým Fd
type
  TRobot4 = class(TRobot)
    procedure Fd(Dlzka: Real); override;
  end;
 
procedure TRobot4.Fd(Dlzka: Real);
begin
  Lt(60);
  while Dlzka >= 5 do
  begin
    inherited Fd(5);
    Rt(120);
    inherited Fd(5);
    Lt(120);
    Dlzka := Dlzka - 5;
  end;
  Rt(60);
  inherited Fd(Dlzka);
end;

robot kreslí domčeky so zubatým Fd

Všimnite si veľký rozdiel medzi týmito dvoma zápismi:

  inherited; Fd(Dlzka);
 
  inherited Fd(Dlzka);

Bodkočiarka za inherited úplne zmení význam zápisu.

Otestujte kreslenie domčeka robotom, ktorý je inštanciou týchto tried. Poexperimentujte aj s prípadmi, keď trieda TRobot3, resp. TRobot4 bude odvodená nie z TRobot ale z TRobot1 alebo TRobot2. Zamyslite sa nad tým, ako bude fungovať TRobot4.Fd pre zápornú hodnotu Dlzka, prípadne opravte túto metódu tak, aby pracovala pre záporné hodnoty správne.


Pole robotov

Nasledujúci jednoduchý príklad ilustruje pole 30 robotov, ktoré sa pohybujú po rôzne veľkých kružniciach. Do projektu sme vložili časovač s intervalom, napr. 10.

var
  Pole: array [1..30] of TRobot;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  for I := 1 to High(Pole) do
    Pole[I] := TRobot.Create(I * 10, 200);
  for I := 1 to High(Pole) do
    Pole[I].PW := 3;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var
  I: Integer;
begin
  for I := 1 to High(Pole) do
    Pole[I].Fd(3);
  for I := 1 to High(Pole) do
    Pole[I].Rt(I);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
var
  I: Integer;
begin
  for I := 1 to High(Pole) do
    Pole[I].Free;
end;

roboty naraz kreslia rôzne veľké kružnice

Ak v časovači (v procedúre Timer1Timer) vložíme zmazávanie plochy (CS), dostávame zaujímavý animovaný efekt:

procedure TForm1.Timer1Timer(Sender: TObject);
var
  I: Integer;
begin
  CS;
  for I := 1 to High(Pole) do
    Pole[I].Fd(3);
  for I := 1 to High(Pole) do
    Pole[I].Rt(I);
end;

pohyb robotov po rôzne veľkých kružniciach

Ak týmto robotom opravíme metódu SetXY, tak budeme vidieť tento pohyb po kružniciach "zboku":

var
  Pole: array [1..30] of TRobot;
 
type
  TRobot0 = class(TRobot)
    procedure SetXY(NewX, NewY: Real); override;
  end;
 
procedure TRobot0.SetXY(NewX, NewY: Real);
begin
  Inherited SetXY(X, NewY);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  for I := 1 to High(Pole) do
    Pole[I] := TRobot0.Create(I * 10, 200);
  for I := 1 to High(Pole) do
    Pole[I].PW := 3;
end;

pohyb robotov po rôzne veľkých kružniciach - pohľad zboku

Všimnite si, že hoci sú všetky prvky poľa deklarované ako TRobot, priradili sme im inštancie triedy TRobot0. V tomto príklade boli všetky prvky poľa rovnakého typu.



Zisťovanie príslušnosti k triede



V ďalšom príklade trochu upravíme činnosť v časovači, aby bolo lepšie vidieť zmenu správania, ak len niektoré roboty budú zmenené inštancie (TRobot1).

var
  Pole: array [1..30] of TRobot;
 
type
  TRobot1 = class(TRobot)
    procedure Fd(Dlzka: Real); override;
  end;
 
procedure TRobot1.Fd(Dlzka: Real);
begin
  inherited Fd(1.5 * Dlzka);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  Randomize;
  for I := 1 to High(Pole) do
    if Random(5) = 0 then
      Pole[I] := TRobot1.Create(I * 10, 200)
    else
      Pole[I] := TRobot.Create(I * 10, 200);
  for I := 1 to High(Pole) do
    Pole[I].PW := 3;
  for I := 1 to High(Pole) do
    if Pole[I] is TRobot1 then
      Pole[I].PC := clRed;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var
  I: Integer;
begin
  // CS;
  for I := 1 to High(Pole) do
    Pole[I].Fd(3);
  for I := 1 to High(Pole) do
    Pole[I].Rt(3);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
var
  I: Integer;
begin
  for I := 1 to High(Pole) do
    Pole[I].Free;
end;

pohyb robotov po kružniciach, inštancie TRobot1 sú červené


Všimnite si riadok, v ktorom sme zafarbili tie roboty, ktoré sú odvodené z TRobot1 - použili sme na to operátor is, ktorý otestuje, či je inštancia danej triedy (alebo triedy, ktorá je potomkom tejto triedy), t.j. či Pole[I] je kompatibilný s triedou TRobot1.

Častou začiatočníckou chybou je test if Pole[I] is TRobot then. Totiž všetky prvky Pole[I] sú kompatibilné s triedou TRobot aj keby to boli inštancie iných tried, ktoré sú potomkami TRobot. Preto je tento test pravdivý vždy.

V tomto príklade sa niektoré metódy často volajú pre všetky existujúce roboty (napr. najprv všetky urobia Fd a potom všetky urobia Rt). Tu by sa nám hodila nejaká nová trieda, ktorá "zapuzdrí" pole robotov a poskytne hromadné metódy pre toto pole.



Trieda TVela s poľom robotov



Vytvorme triedu, ktorá umožní do dynamického poľa robotov pridávať nové roboty (metóda Novy), dokáže všetkým robotom zmeniť ich hrúbku pera (property PW a metóda SetPW) a tiež metódy, v ktorých všetky roboty urobia Fd, resp. Rt. Najlepšie, keď túto triedu zadefinujeme v samostatnom unite, napr. VelaUnit.pas:

interface
 
uses
  Classes, SysUtils, RobotUnit;
 
type
  TVela = class
    Pole: array of TRobot;
    procedure Novy(Robot: TRobot);
    destructor Destroy; override;
    procedure SetPW(Hrubka: Integer);
    procedure Fd(Dlzka: Real);
    procedure Rt(Uhol: Real);
    property PW: Integer write SetPW;
  end;
 
implementation
 
procedure TVela.Novy(Robot: TRobot);
begin
  SetLength(Pole, Length(Pole) + 1);
  Pole[High(Pole)] := Robot;
end;
 
destructor TVela.Destroy;
var
  I: Integer;
begin
  for I := 0 to High(Pole) do
    Pole[I].Free;
end;
 
procedure TVela.SetPW(Hrubka: Integer);
var
  I: Integer;
begin
  for I := 0 to High(Pole) do
    Pole[I].PW := Hrubka;
end;
 
procedure TVela.Fd(Dlzka: Real);
var
  I: Integer;
begin
  for I := 0 to High(Pole) do
    Pole[I].Fd(Dlzka);
end;
 
procedure TVela.Rt(Uhol: Real);
var
  I: Integer;
begin
  for I := 0 to High(Pole) do
    Pole[I].Rt(Uhol);
end;
 
end.

Predchádzajúci príklad s 30 robotmi teraz opravíme takto:

uses
  RobotUnit, VelaUnit;
 
type
  TRobot1 = class(TRobot)
    procedure Fd(Dlzka: Real); override;
  end;
 
procedure TRobot1.Fd(Dlzka: Real);
begin
  inherited Fd(1.5 * Dlzka);
end;
 
var
  Vela: TVela;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  Randomize;
  Vela := TVela.Create;
  for I := 1 to 30 do
    if Random(5) = 0 then
      Vela.Novy(TRobot1.Create(I * 10, 200))
    else
      Vela.Novy(TRobot.Create(I * 10, 200));
  Vela.PW := 3;
  for I := 0 to High(Vela.Pole) do
    if Vela.Pole[I] is TRobot1 then
      Vela.Pole[I].PC := clRed;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  // CS;
  Vela.Fd(3);
  Vela.Rt(3);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Vela.Free;
end;

Všimnite si, že dynamické pole Pole obsahuje nielen "obyčajné" inštancie TRobot, ale aj novo vytvorené TRobot1. Už vieme, že tomu sa hovorí polymorfné pole.

Program by sme mohli prepísať aj s použitím príkazu with - teraz už bez globálnej premennej a bez časovača. Hoci predchádzajúce riešenie je výrazne kvalitnejšie, tu ukazujeme použitie with:

procedure TForm1.Button1Click(Sender: TObject);
var
  I, J: Integer;
begin
  CS;
  with TVela.Create do
  begin
    for I := 1 to 30 do
      if Random(5) = 0 then
        Novy(TRobot1.Create(I * 10, 200))
      else
        Novy(TRobot.Create(I * 10, 200));
    PW := 3;
    for I := 0 to High(Pole) do
      if not (Pole[I] is TRobot1) then
        Pole[I].PC := clRed;
    for J := 1 to 120 do
    begin
      // CS;
      Fd(3);
      Rt(3);
      Wait(10);
    end;
    Free;
  end;
end;

V tomto riešení sme nepotrebovali premennú Vela typu TVela. Tento objekt existoval len počas platnosti príkazu with.

Príkaz if not (Pole[I] is TRobot1) then ... testuje tie roboty, ktoré nie sú triedy TRobot1 a teda sú to všetky ostatné.



Indexované property



O virtuálnych stavových premenných property vieme, že je to premenná ľubovoľného typu a prístupná je pomocou metódy na čítanie (píšeme za read, hovoríme tomu getter) a metódy na zápis (píšeme za write, hovoríme tomu setter). Prípadne namiesto metód sa môžeme priamo odvolať na niektorú stavovú premennú rovnakého typu ako samotné property.

V Pascale môžeme zadefinovať aj virtuálne premenné, ktoré majú index. Vyzerajú, ako keby boli dvojrozmerným poľom, ale v skutočnosti sa opäť pracuje s metódami (setter a getter), ktoré majú o jeden parameter (index) navyše. Vďaka tomu môžu samotné metódy skôr ako zaindexujú skontrolovať, resp. prepočítať tento index. Dokonca by skutočná premenná, do ktorej takto pristupujeme prostredníctvom indexovaného property, mohla byť privátna a prístup by vtedy musel ísť len cez metódy setter a getter. V niektorých prípadoch je užitočné, aby indexom nebol ordinálny typ, ale napr. Real alebo string a pri indexovaní sa tieto hodnoty prepočítajú, napr. na celé čísla.

Ukážme to na príklade s triedou TVela. Do deklarácie triedy pridáme:

type
  TVela = class
    Pole: array of TRobot;
    procedure Novy(Robot: TRobot);
    destructor Destroy; override;
    procedure SetPW(Hrubka: Integer);
    procedure Fd(Dlzka: Real);
    procedure Rt(Uhol: Real);
    property PW: Integer write SetPW;
    property R[Index: Integer]: TRobot read GetRobot write SetRobot;
  end;

Stlačíme Ctrl-Shift-C a automaticky sa dopíšu nielen deklarácie nových metód GetRobot a SetRobot, ale sa vytvoria aj príslušné prázdne ich definície (trochu sme to ešte preusporiadali):

type
  TVela = class
    Pole: array of TRobot;
    procedure Novy(Robot: TRobot);
    destructor Destroy; override;
    procedure SetPW(Hrubka: Integer);
    procedure Fd(Dlzka: Real);
    procedure Rt(Uhol: Real);
    function GetRobot(Index: Integer): TRobot;
    procedure SetRobot(Index: Integer; AValue: TRobot);
    property PW: Integer write SetPW;
    property R[Index: Integer]: TRobot read GetRobot write SetRobot;
  end;
 
function TVela.GetRobot(Index: Integer): TRobot;
begin
 
end;
 
procedure TVela.SetRobot(Index: Integer; AValue: TRobot);
begin
 
end;

Tieto dve metódy môžeme zadefinovať napr. takto:

function TVela.GetRobot(Index: Integer): TRobot;
begin
  if (Index < 0) or (Index > High(Pole)) then
    Result := nil
  else
    Result := Pole[Index];
end;
 
procedure TVela.SetRobot(Index: Integer; AValue: TRobot);
begin
  if (Index >= 0) or (Index <= High(Pole)) then
    Pole[Index] := AValue;
end;

S takouto indexovanou property premennou sa pracuje rovnako ako s bežným poľom (v našom prípade s poľom Pole), len tu nám samotné metódy môžu strážiť pretečenie indexu poľa. Treba si ale uvedomiť, že s takýmto virtuálnym poľom nefungujú, napr. ani funkcia High, resp. príkaz SetLength.

Ešte pripomíname, že už vieme pracovať s farebnými bodmi grafickej plochy pomocou Image1.Canvas.Pixels[X, Y]. Aj Pixels je indexované property a keby sme sa pozreli do deklarácie TCanvas v grafickej knižnici, našli by sme

type
  TCanvas = class ...
    ...
    function GetPixel(X, Y: Integer): TColor; virtual;
    procedure SetPixel(X, Y: Integer; Value: TColor); virtual;
    ...
    property Pixels[X, Y: Integer]: TColor read GetPixel write SetPixel;
  end;

Vidíme, že property Pixels má až dva indexy X a Y a asi si vieme predstaviť, ako to celé funguje.


Pretypovanie inštancie

V nasledujúcom príklade ukážeme, že v niektorých situáciách musíme inštanciu pretypovať. Stane sa to napríklad vtedy, keď odvodená trieda (potomok) má novú metódu alebo stavovú premennú, ktorú nepozná základná trieda (predok). Vďaka kompatibilite inštancií môžeme do premennej typu základná trieda (napr. TRobot) priradiť inštanciu nejakej odvodenej triedy (napr. TMojRobot). Pre takúto inštanciu správne fungujú všetky zdedené aj prepísané virtuálne metódy, ale nedostaneme sa už k novým metódam.

Napíšme príklad, v ktorom roboty nakreslia sínus:

uses
  RobotUnit, VelaUnit;
 
type
  TMojRobot = class(TRobot)
  private
    K: Real;
  public
    constructor Create(XX, YY: Real; U: Real = 0);
    procedure Koef(NoveK: Real);
    procedure Fd(Dlzka: Real); override;
  end;
 
constructor TMojRobot.Create(XX, YY, U: Real);
begin
  inherited;     // najprv skonštruuje obyčajný robot
  K := 1;
end;
 
procedure TMojRobot.Koef(NoveK: Real);
begin
  K := NoveK;
end;
 
procedure TMojRobot.Fd(Dlzka: Real);
begin
  inherited Fd(Dlzka * K);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
begin
  with TVela.Create do
  begin
    for I := 1 to Image1.Width div 2 do
    begin
      Novy(TMojRobot.Create(2 * I, 150));
      (Pole[High(Pole)] as TMojRobot).Koef(Sin(2 * Rad * I));    // posledne vyrobený robot
    end;
    Fd(140);
    Free;         // uvoľní inštanciu TVela - pole robotov
  end;
end;

Všimnite si, že hoci je Pole[I] deklarované ako inštancia triedy TRobot obsahuje premennú typu TMojRobot. Lenže "klasický" TRobot nepozná metódu Koef a bez pretypovania by kompilátor hlásil chybu. Použili sme tu operáciu as, ktorá kompilátoru oznámi, že daná inštancia je v skutočnosti niektorého odvodeného typu a teda by mala mať prístup k novo definovaným metódam a stavovým premenným. Samozrejme, že kompilátor toto naše pretypovanie overí, či je pravda, že je kompatibilné s uvedeným typom a ak nie, nastane chybová správa. Pretypovať môžeme aj iným zápisom takto: TMojRobot(Pole[High(Pole)]) - závisí od nás, ktorý z nich použijeme.

Ďalej upravíme tento program tak, aby tieto "sinusové" roboty kmitali hore dole. Celé to pobeží pomocou časovača s intervalom 10:

var
  Vela: TVela;
  Pocet: Integer;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  Vela := TVela.Create;
  for I := 1 to Image1.Width div 2 do
  begin
    Vela.Novy(TMojRobot.Create(2 * I, 150));
    TMojRobot(Vela.Pole[High(Vela.Pole)]).Koef(Sin(2 * Rad * I));
  end;
  Vela.PW := 3;
  Vela.Fd(140);
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if Pocet = 0 then
  begin
    Pocet := 70;
    Vela.Rt(180);
  end;
  CS;
  Vela.Fd(4);
  Dec(Pocet);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Vela.Free;
end;

Teraz sme sa už nezaobišli bez globálnej premennej Vela - inštancie triedy TVela.


Ukážkový projekt

Naprogramujte takúto aplikáciu: V akváriu plávajú rybičky a my ich kŕmime tak, že zhora sypeme potravu. Potrava pomaly klesá ku dnu a ak ju nejaká rybka nezje, tak tam zmizne. Rybky sa pohybujú podľa takýchto pravidiel:

  • pri narodení majú náhodný smer;
  • hýbu sa rýchlosťou 5;
  • pri okrajoch plochy sa odrážajú (podobne ako biliardové gule);
  • raz začas (s pravdepodobnosťou 1:50) sa náhodne otočia o uhol z intervalu -30 .. 30;
  • ak je nejaká potrava k rybke vo vzdialenosti menšej ako 100, tak sa rybka natočí smerom k nej - ak je takýchto potráv viac, tak sa rybka natočí k najbližšej z nich;
  • ak je nejaká potrava k rybke vo vzdialenosti aspoň 10, tak rybka ju zje - ak je takýchto viac, tak ich zje naraz všetky.

Každá rybka má svoje vnútorné počítadlo, pomocou ktorého sa počíta jej životnosť:

  • pri narodení ma hodnotu 200,
  • za každú zjedenú potravu sa zvýši o 20;
  • pri každom tiknutí časovača sa zníži o 1;
  • ak je hodnota počítadla menšia ako 20, rybka hynie (z akvária zmizne);
  • hodnota počítadla sa používa aj pri vykresľovaní rybky: rybka sa kreslí ako čiara dĺžky počítadlo/4 a hrúbky 20 - táto čiara sa kreslí opačným smerom, ako je smer pohybu, pričom v pozícii rybky sa na nej nakreslí aj jej oko: čierna bodka veľkosti 5 (t.j danou hrúbkou a farbou Fd(-dĺžka); Fd(dĺžka); čierny Point(5);). Pri narodení rybky sa vygeneruje náhodná farba rybky. .

Potravu kreslite zelenými bodkami veľkosti 5. Každá potrava sa pomaly hýbe náhodnou rýchlosťou z intervalu 0.5 .. 1.5 smerom nadol, pričom na dolnom okraji zmizne.

Rybky vytvárame klikaním pravým tlačidlom myši, potravu klikaním a tiež ťahaním ľavým tlačidlom myši. Rybky aj potravu reprezentujte objektmi, ktoré budú odvodené od TRobot. Všetky roboty v programe uchovávajte v jedinom dynamickom poli typu TRobot. Nepoužívajte žiadne iné objektové premenné typu TRobot (ani odvodené od TRobot), napr.

var
  Pole: array of TRobot;            // jediné pole všetkých rybiek a všetkej potravy

Využite tieto deklarácie (môžete si ich aj trochu upraviť):

type
  TObj = class(TRobot)
    procedure Pohni; virtual;
  end;
 
  TRybka = class(TObj)
    Pocitadlo: Integer;
    constructor Create(XX, YY: Integer);
    procedure Pohni; override;
  end;
 
  TPotrava = class(TObj)
    constructor Create(XX, YY: Integer);
    procedure Pohni; override;
  end;

Tieto triedy zadefinujte v samostatnej programovej jednotke, ktorá okrem štandardných unitov bude používať len RobotUnit a nebude obsahovať žiadne globálne premenné.

Metóda Pohni posunie rybku, resp. potravu podľa pravidiel a tiež tento objekt vykreslí. Uvedomte si, že v časovači (s intervalom 50 ms) sa postupne

  • zrušia všetky rybky, ktoré majú príliš malé počítadlo;
  • pohnú sa všetky objekty (rybky aj potrava);
  • zjedia sa všetky potravy, ktoré sú blízko nejakých rybiek;
  • odstránia sa všetky potravy, ktoré vypadli z plochy;
  • zníži sa počítadlo všetkých rybiek o 1;
  • rybky, ktoré majú blízko nejakú potravu (aspoň 100), sa ku nej natočia.



Riešenie



V programovej jednotke Unit2 zadefinujeme všetky tri triedy:

unit Unit2;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, RobotUnit, Graphics;
 
type
  TObj = class(TRobot)
    procedure Pohni; virtual;
  end;
 
  TRybka = class(TObj)
    Pocitadlo: Integer;
    F: TColor;
    constructor Create(XX, YY: Integer);
    procedure Pohni; override;
  end;
 
  TPotrava = class(TObj)
    constructor Create(XX, YY: Integer);
    procedure Pohni; override;
  end;
 
implementation
 
procedure TObj.Pohni;
begin
  raise Exception.Create('toto sa nemoze stat');
end;
 
constructor TRybka.Create(XX, YY: Integer);
begin
  inherited Create(XX, YY, Random(360));
  Pocitadlo := 200;
  PW := 20;
  F := Random($1000000);
end;
 
procedure TRybka.Pohni;
begin
  PU;
  Fd(5);
  if Random(50) = 0 then
    Rt(Random(61) - 30);
  PD;
  PC := F;;
  FD(- Pocitadlo / 4);
  FD(Pocitadlo / 4);
  PC := clBlack;
  Point(5);
end;
 
constructor TPotrava.Create(XX, YY: Integer);
begin
  inherited Create(XX, YY, 180);
  PC := clGreen;
  PW := 5;
  PU;
end;
 
procedure TPotrava.Pohni;
begin
  Fd(0.5 + Random(11) / 10);
  Point;
end;
 
end.

Samotný unit s formulárom musí obsahovať grafickú plochu a časovač. Okrem FormCreate spracováva aj udalosti Image1MouseDown, Image1MouseMove a Timer1Timer:

uses
  RobotUnit, Unit2;
 
var
  Pole: array of TRobot;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  CS;
  Timer1.Interval := 100;
  Timer1.Enabled := True;
end;
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Shift = [ssRight] then
  begin
    SetLength(Pole, Length(Pole) + 1);
    Pole[High(Pole)] := TRybka.Create(X, Y);
  end;
 
  if Shift = [ssLeft] then
  begin
    SetLength(Pole, Length(Pole) + 1);
    Pole[High(Pole)] := TPotrava.Create(X, Y);
  end;
end;
 
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Shift = [ssLeft] then
  begin
    SetLength(Pole, Length(Pole) + 1);
    Pole[High(Pole)] := TPotrava.Create(X, Y);
  end;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var
  I, J, K: Integer;
  Treba: Boolean;
  Najblizsie, D: Real;
begin
  CS;
  for I := 0 to High(Pole) do
    TObj(Pole[I]).Pohni;
  for I := 0 to High(Pole) do
    if Pole[I] <> nil then
      if Pole[I] is TRybka then      // je to rybka
        with TRybka(Pole[I]) do
        begin
          Treba := True;
          K := -1;
          Najblizsie := 100;
          for J := 0 to High(Pole) do   // zistuj potravu v blizkosti rybky
            if (Pole[J] <> nil) and (Pole[J] is TPotrava) then
            begin
              D := Dist(Pole[J].X, Pole[J].Y);
              if D < 10 then
              begin
                Inc(Pocitadlo, 20);
                Pole[J].Free;
                Pole[J] := nil;
                Treba := False;
              end
              else if Treba and (D < Najblizsie) then
              begin
                K := J;
                Najblizsie := D;
              end;
            end;
          if Treba and (K >= 0) then
            Towards(Pole[K].X, Pole[K].Y)
          else if (X < 0) or (X > Image1.Width) or (Y < 0) or (Y > Image1.Height) then
            Rt(90);
          Dec(Pocitadlo);
          if Pocitadlo < 20 then
          begin
            Free;
            Pole[I] := nil;
          end;
        end
      else                        // je to potrava
        if Pole[I].Y > Image1.Height then
        begin
          Pole[I].Free;
          Pole[I] := nil;
        end;
  J := 0;                         // z Pola vyhodi vsetky nil
  for I := 0 to High(Pole) do
    if Pole[I] <> nil then
    begin
      Pole[J] := Pole[I];
      Inc(J);
    end;
  SetLength(Pole, J);
end;

Všimnite si, že väčšina akcií ja realizuje v časovači: všetky objekty sa pohybujú, kontrolujú navzájom, niektoré rušia a na záver sa celé pole uprace, t.j. vyhodia sa nil-ové hodnoty, ktoré ostali po zrušených objektov. Zrejme by to fungovalo aj bez záverečného vyhadzovania prázdnych objektov v poli, ale vtedy by sa neúmerne nafukovalo a väčšinu miesta v poli by časom boli skoro samé nil. Tiež si všimnite, kde v programe sme museli pretypovať nejakú inštanciu.


späť | ďalej