Program in OOP (Object-oriented programming in Pascal)

{ PIZZA.PAS                                Copyright (c) Roman Milo }
{ Program v OOP (Objektove programovanie v Pascale)                 }
{ Program demonstruje objednavanie pizze.                           }
{ Obsahuje viacnasobne dedenie triedy. Objednavky uklada do suboru. }
{                                                                   }
{ Datum:21.06.2006                             http://www.trsek.com }
 
program Pizza;
uses crt;
var ch:char;
 
type	{Deklaracie tried a ich metod}
 
OPizza=object	{1. trieda - povodca}
  Nazov:string;
  Hmotnost:string;
  Zaklad:string;
  constructor Init(ANazov:string;AHmotnost:string);
  procedure ZadajPizza;
  procedure VypisPizza;  Virtual;	{1. virtualna metoda}
end;
 
PPizza1=^OPizza1;
OPizza1=object(OPizza)	{2. trieda - 1. potomok objektu OPizza}
  PocetPriloh:string;
  CenaPizza:integer;
  function VypocitajCenu(Cena:integer):integer;	{Prekryvanie}
  Procedure VypisPizza; Virtual;
  Destructor Done;
end;
 
PPizza2=^OPizza2;	{3. trieda - 2. potomok triedy OPizza}
OPizza2=object(OPizza1)
  CasPripravy:integer;
  function VypocitajCenu(Cena:integer):string;	{Prekryvanie metody OPizza1}
  procedure DoplnUdaje;
  function WritePizza:string;
  procedure VypisPizza; Virtual;
  Destructor Done;
end;
 
PReadPizza=^OReadPizza;
OReadPizza=object
 
    procedure Citaj;
    end;
 
PNewPizza=^ONewPizza;
ONewPizza=object(OReadPizza)	{Dedene z OReadPizza}
    Zaznam:integer;
    end;
 
PReadPizzaDO=^OReadPizzaDO;
OReadPizzaDO=object
CenaDO:integer;
 
constructor Init(ACenaDO:integer);
procedure VypisDO; Virtual;
destructor done;
end;
 
 
constructor OReadPizzaDO.Init(ACenaDO:integer);
begin
 CenaDO:=ACenaDO;
end;
 
 
destructor OReadPizzaDO.Done;
begin
end;
 
 
procedure OReadPizzaDO.VypisDO;	{Pizza zoznam}
var subor:text;
begin
end;
 
 
procedure OReadPizza.citaj;
var subor:text;
    PorCislo:integer;
    riadok,SPorCislo:string;
begin
 textbackground(1);
 Writeln('Vasa pizza bola pridana do Pizza zoznamu:');
 textbackground(0);
 writeln;
 
 assign(subor,'Pizza.txt');
 reset(subor);
 PorCislo:=0;
 
 while not Eof(subor) do
  begin
    Readln(subor, riadok);
    PorCislo:=PorCislo+1;
    str(PorCislo,SPorcislo);
 
    if (PorCislo < 100) then 
       Sporcislo:='  '+SporCislo;
 
    {Odelovac zaznamov}
    while Pos('/', riadok) > 0 do
       riadok[Pos('/', riadok)] := ' ';
 
    Writeln(Sporcislo,' ',riadok);
  end;
 
 close(subor);
end;
 
 
{Deklaracia triedy OPizza2}
function OPizza2.WritePizza:string;
var CCasPripravy:string;
begin
 str(CasPripravy,CCasPripravy);
 clrscr;
 WritePizza:=(Nazov+' Pizza / '+Hmotnost+' g / '
             +Zaklad+' (zaklad) / '+PocetPriloh+' (prilohy) / '
             +CCasPripravy+' min / '+VypocitajCenu(CenaPizza)+' Sk');
end;
 
 
procedure OPizza2.DoplnUdaje;
begin
 writeln('Pocet Priloh: ');
 readln(PocetPriloh);
 writeln('Cas Pripravy: ');
 readln(CasPripravy);
 Writeln('Cena Pizze: ');
 readln(CenaPizza);
end;
 
 
procedure OPizza2.VypisPizza;
begin
 clrscr;
 writeln('Nazov: ', Nazov);
 writeln('Hmotnost: ',Hmotnost,' g');
 writeln('Zaklad Pizze: ',Zaklad);
 writeln('Pocet Priloh: ',PocetPriloh);
 writeln('Cas Pripravy: ',CasPripravy,' min');
 writeln('Cena Pizze je: ',vypocitajcenu(CenaPizza),' Sk');
end;
 
function OPizza2.VypocitajCenu(Cena:integer):string;
var CenaTmp:integer;
    CenaStr:string;	{Zmena vystupu na string}
    const Zisk1=50;
    const Zisk2=25;	{Ak je cas pripravy viac ako 15 min}
    const Zisk3=75;	{Ak je cas pripravy menej ako 5 min}
begin
 if (CasPripravy > 15) then CenaTmp:=Cena+Zisk2
                       else CenaTmp:=Cena+Zisk1;
 
 if (CasPripravy <  5) then CenaTmp:=CenaTmp+Zisk3;
 
 str(CenaTmp,CenaStr);
 VypocitajCenu:=CenaStr;
end;
 
 
destructor OPizza2.Done;
begin
end;
 
 
{Deklaracia triedy OPizza1}
function OPizza1.VypocitajCenu(Cena:integer):integer;
begin
VypocitajCenu:=Cena+10;
end;
 
procedure OPizza1.VypisPizza;
begin
 clrscr;
 writeln('Nazov: ', Nazov);
 writeln('Hmotnost: ',Hmotnost,' g');
end;
 
destructor OPizza1.Done;
begin
end;
 
{Deklaracie triedy OPizza}
constructor OPizza.Init(ANazov:string;AHmotnost:string);
begin
 Nazov:=ANazov;
 Hmotnost:=AHmotnost;
end;
 
 
procedure OPizza.ZadajPizza;
begin
 clrscr;
 writeln('Zadaj Nazov: ');
 readln(Nazov);
 writeln('Zadaj Hmotnost: ');
 readln(Hmotnost);
 writeln('Zadaj Zaklad: ');
 readln(Zaklad);
end;
 
procedure OPizza.VypisPizza;
begin
 clrscr;
 writeln('Nazov: ', Nazov);
 writeln('Hmotnost: ',Hmotnost,' g');
end;
{Koniec deklaracie tried a ich metod}
 
 
const test=99;	           {Skusobna konstanta pre inicializaciu ukazovatela}
var
   PxPizza:PPizza2;
   IO_FILE:text;
   PxReadPizza:PReadPizza;
   PxNewPizza:PNewPizza;
   PxReadPizzaDO:PReadPizzaDO;
 
begin
 clrscr;
 
 repeat
   PxPizza:=New(PPizza2,Init('Nazov','Hmotnost'));	{Inicialnizuje ukazovatel}
   PxPizza^.ZadajPizza;
   PxPizza^.DoplnUdaje;
   PxPizza^.VypisPizza;
 
   writeln;
   writeln;
   writeln;
   textbackground(1);
   writeln('Stlacte ENTER pre pokracovanie...');
   textbackground(0);
   readln;
   clrscr;
 
   {Zapis do suboru}
   assign(IO_File,'Pizza.txt');
   {$I-}
   append(IO_FILE);
   {$I+}
   if (IOresult <> 0) then	{Subor chyba...}
    begin
     rewrite(IO_FILE);
    end;
 
   writeln(IO_FILE,PxPizza^.WritePizza);
   close(IO_FILE);
 
   writeln(PxPizza^.WritePizza);
   Dispose(PxPizza,done);	{Uz ho nepotrebujem, tak ho znicim...}
   PxNewPizza^.citaj;		{Cita subor Pizza.txt}
   PxReadPizzaDO:=New(PReadPizzaDO,Init(test));	{Inicialnizuje ukazovatel}
   PxReadPizzaDO^.VypisDO;
   Dispose(PxReadPizzaDO,done);
 
   writeln;
   writeln;
   writeln;
   textbackground(1);
   writeln('Chcete pridat dalsiu pizzu? (A/N)');
   textbackground(0);
 
   ch:=readkey;
 until ((ch='n') or (ch='N'));
 
 writeln;
 textbackground(5);
 writeln('*** DOVIDENIA ***');
 textbackground(0);
END.