www.TrSek.com/en/cover/guran/gzoznam.pas -

{ gzoznam.pas               Copyright (c) TrSek alias Zdeno Sekerak  }
{ Implemantacia ZOZNAM                                               }
{   - linearny obojsmerny zretazeny zoznam s hlavou                  }
{                                                                    }
{ Datum:17.04.2007                              http://www.trsek.com }
unit GZoznam;
 
interface
const KNIHY_TXT = 'knihy.txt';
 
TYPE    TKniInfo  = record
                     nazov: string;
                     autor: string;		{ index zo zoznamu autorov }
                     vydal: string;		{ index zo zoznamu vydavatelstiev }
                   end;
 
        PPrvok   = ^TPrvok;
        TPrvok   = record
                     Info : TKniInfo;
                     Pred : PPrvok;		{ predosly zaznam }
                     Nasl : PPrvok;		{ nasledovny zaznam }
                   end;
 
        cEvidKni = object
                Aktual : PPrvok;       { pozicia aktualna }
                Hlava  : PPrvok;
 
                Pocet  : integer;
                Index  : integer;
 
                { filtre }
                je_filter : boolean;
                filter    : TKniInfo;
 
                constructor Init;
                destructor  Done; virtual;
 
                function    Mohutnost: integer;	    { zisti pocet zaznamov  }
                function    JePrazdna: boolean;	    { urci ci je zoznam prazdny }
                procedure   Status;					{ zobrazi status riadok }
 
                { posuvace }
                procedure   MoveFirst;			{ posun na prvy prvok }
                procedure   MoveLast;			{ posun na posledny prvok }
                procedure   MovePrev;			{ posun na predosly prvok }
                procedure   MoveNext;			{ posun na dalsi prvok }
 
                { hladace }
                procedure   NajdiKniha  (naz: string );
                procedure   NajdiAutora (aut: string );
                procedure   NajdiVydal  (vyd: string );
                function    VyhovujeFiltru: boolean;
                procedure   ZrusFilter;
                procedure   Search;
 
                { zobrazovace }
                procedure   UkazZaznam;
                procedure   UkazZaznamList;
 
                { pridavace, mazace }
                procedure   Pridaj (prvok: TKniInfo);	{ prida novy prvok }
                procedure   PridajZozbraz;              { input/output }
                procedure   ZmenAktual;                 { zmeni aktualny prvok  }
                procedure   VyradAktual;		{ vyradi aktualny prvok }
                procedure   VyradVsetko;		{ zrusi vsetky prvky    }
 
                { praca so subormi }
                procedure   UlozNaDisk;			{ ulozi zoznam na disk }
                procedure   CitajZDisku;		{ vycita zoznam z disku }
               End;
 
implementation
uses crt;
 
 
{ inicializacia objektu }
constructor cEvidKni.Init;
begin
  Aktual := nil;
  Hlava  := nil;
  Pocet  := 0;
 
  { filter znulujeme }
  je_filter := false;
  filter.nazov := '';
  filter.autor := '';
  filter.vydal := '';
 
  { precitaj z disku }
  CitajZDisku;  
end;
 
 
{ ukoncenie objektu }
destructor cEvidKni.Done;
begin
  { ulozime aby sme to nestratili }
  UlozNaDisk;
  { pokial nieco je alokovane zrus }
  cEvidKni.VyradVsetko;
end;
 
 
{ prida novy prvok za aktualny }
procedure cEvidKni.Pridaj (prvok: TKniInfo);
var pom: PPrvok;
begin
  { alokujeme }
  New(pom);
 
  { problem s pametou }
  if( pom = nil )then
  begin
    writeln('Problem pri alokacii pamete');
    halt(1);
  end;
 
  Pocet:=Pocet+1;
  Index := Index+1;
 
  { prehodime }
  pom^.Info.nazov := prvok.nazov;
  pom^.Info.autor := prvok.autor;
  pom^.Info.vydal := prvok.vydal;
  pom^.Pred := nil;
  pom^.Nasl := nil;
 
  { existuje aktualny }
  if( Aktual <> nil )then
  begin
    { ak za aktualnym nieco je }
    if( Aktual^.Nasl <> nil )then
     begin
       Aktual^.Nasl^.Pred := pom;
       pom^.Nasl := Aktual^.Nasl;
     end;
 
    { pripojime za nasledovnika }
    Aktual^.Nasl := pom;
    pom^.Pred := Aktual;
  end;
 
  { aktualny je teraz tento }
  Aktual := pom;
 
  { ak prvy este nejestvuje }
  if( Hlava = nil )then
      Hlava := pom;
end;
 
 
{ zmeni aktualny prvok }
procedure cEvidKni.ZmenAktual;
begin
  if( Aktual = nil )then
      exit;
 
   clrscr;
   writeln('Editovanie zaznamu');
   repeat
     writeln ('  Nazov knihy: ', Aktual^.Info.nazov);
     write   ('         novy: ');
     readln( Aktual^.Info.nazov );
   until (Aktual^.Info.nazov <> '' );
 
   repeat
     writeln;
     writeln ('        autor: ',Aktual^.Info.autor);
     write   ('         novy: ');
     readln( Aktual^.Info.autor );
   until (Aktual^.Info.autor <> '' );
 
   repeat
     writeln;
     writeln ('Vydavatelstvo: ',Aktual^.Info.vydal);
     write   ('         nove: ');
     readln( Aktual^.Info.vydal );
   until (Aktual^.Info.vydal <> '' );
end;
 
 
{ pridaj dalsi zaznam - zobrazenie }
procedure cEvidKni.PridajZozbraz;
var Info : TKniInfo;
begin
   clrscr;
   writeln('Pridanie noveho zaznamu');
   repeat
     write ('  Nazov knihy: ');
     readln( Info.nazov );
   until (Info.nazov <> '' );
 
   repeat
     write ('        autor: ');
     readln( Info.autor );
   until (Info.autor <> '' );
 
   repeat
     write ('Vydavatelstvo: ');
     readln( Info.vydal );
   until (Info.vydal <> '' );
 
   { pridaj }
   Pridaj( Info );
end;
 
 
{ zisti pocet zaznamov  }
{ vrati len cislo pocet zaznamov }
function cEvidKni.Mohutnost;
begin
  Mohutnost := Pocet;
end;
 
 
{ povie ci je prazdna }
function cEvidKni.JePrazdna:boolean;
begin
  if( Hlava = nil )then
      JePrazdna := true
  else
      JePrazdna := false;
end;
 
 
{ vyradi aktualny prvok }
procedure cEvidKni.VyradAktual;
var pom: PPrvok;
begin
  { niet co }
  if( Hlava = nil )then
      exit;
 
  pom := Aktual;
  Pocet := Pocet-1;
 
  { ak je to hlava }
  if( Hlava = Aktual )then
  begin
    Hlava := Aktual^.Nasl;
    Aktual := Aktual^.Nasl;
    if( Hlava <> nil )then
        Hlava^.Pred := nil
    else
        Index := 0;
    Dispose(pom);
    exit;
  end;
 
  { ak je posledny - nie hlava }
  if( Aktual^.Nasl = nil )then
  begin
    Aktual := Aktual^.Pred;
    Aktual^.Nasl := nil;
    Index := Index-1;
    Dispose(pom);
    exit;
  end;
 
  { rozpojime }
  Aktual^.Pred^.Nasl := Aktual^.Nasl;
  Aktual^.Nasl^.Pred := Aktual^.Pred;
  Aktual := Aktual^.Nasl;
 
  { uvolnime mem }
  Dispose(pom);
end;
 
 
{ zrusi vsetky prvky    }
procedure cEvidKni.VyradVsetko;
begin
  while ( Aktual <> nil ) do
    VyradAktual;
end;
 
 
{ zisti ci prvok vyhovuje zadanemu filtru }
function cEvidKni.VyhovujeFiltru: boolean;
begin
  { ak nic tak ani filter }
  if( Aktual = nil )then
   begin
     VyhovujeFiltru := false;
     exit;
   end;
 
  { zatial ano }
  VyhovujeFiltru := true;
 
  { aplikuj podmienky }
  if( je_filter )then
  begin
    { uz teraz nie }
    VyhovujeFiltru := false;
 
    { na nazov }
    if( filter.nazov <> '' )then
    if( Copy( Aktual^.Info.nazov, 1, length( filter.nazov)) = filter.nazov )then
     begin
        VyhovujeFiltru := true;
        exit;
     end;
 
    { na autora }
    if( filter.autor <> '' )then
    if( Copy( Aktual^.Info.autor, 1, length( filter.autor)) = filter.autor )then
     begin
        VyhovujeFiltru := true;
        exit;
     end;
 
    { na vydavatestvo }
    if( filter.vydal <> '' )then
    if( Copy( Aktual^.Info.vydal, 1, length( filter.vydal)) = filter.vydal )then
     begin
        VyhovujeFiltru := true;
        exit;
     end;
  end;
end;
 
 
{ posun na prvy prvok }
procedure cEvidKni.MoveFirst;
begin
  Aktual := Hlava;
  Index := 1;
 
  { pozor teraz filter }
  while(( cEvidKni.VyhovujeFiltru = false )
    and ( Aktual <> nil )
    and ( Aktual^.Nasl <> nil ))do
    begin
      Aktual := Aktual^.Nasl;
      Index := Index+1;
    end;
end;
 
 
{ posun na posledny prvok }
procedure cEvidKni.MoveLast;
var pom: PPrvok;
   ipom: integer;
begin
   pom := nil;
   ipom := Index;
 
   { u filtra nikdy neviem }
   if(( Aktual = nil ) or je_filter )then
    begin
       Aktual := Hlava;
       Index := 1;
       ipom := 1;
    end;
 
   { najdi posledny }
   if( Aktual <> nil )then
       repeat
       { posledny co vyhovuje filtru }
       if( cEvidKni.VyhovujeFiltru )then
	   begin
	     pom := Aktual;
	     ipom := Index;
	   end;
 
 
       { dalsi }
       if( Aktual <> nil )then
	 begin
	   Aktual := Aktual^.Nasl;
	   Index := Index+1;
	 end;
 
       until (Aktual = nil );
 
  { tento bol posledny }
  Aktual := pom;
  Index := ipom;
end;
 
 
{ posun na predosly prvok }
procedure cEvidKni.MovePrev;
var pom: PPrvok;
   ipom: integer;
begin
  pom := Aktual;
  ipom := Index;
 
  if(( Aktual <> nil )
  and ( Aktual^.Pred <> nil ))then
   begin
     Aktual := Aktual^.Pred;
     Index := Index-1;
   end;
 
  while(( cEvidKni.VyhovujeFiltru = false )
    and ( Aktual <> nil )
    and ( Aktual^.Pred <> nil ))do
    begin
      Aktual := Aktual^.Pred;
      Index := Index-1;
    end;
 
  { naspat posledny }
  if( cEvidKni.VyhovujeFiltru = false )then
   begin
     Aktual := pom;
     Index := ipom;
   end;
end;
 
 
{ posun na dalsi prvok }
procedure cEvidKni.MoveNext;
var pom: PPrvok;
   ipom: integer;
begin
  pom := Aktual;
  ipom := Index;
 
  if(( Aktual <> nil )
  and ( Aktual^.Nasl <> nil ))then
   begin
     Aktual := Aktual^.Nasl;
     Index := Index+1;
   end;
 
  while(( cEvidKni.VyhovujeFiltru = false )
    and ( Aktual <> nil )
    and ( Aktual^.Nasl <> nil ))do
    begin
      Aktual := Aktual^.Nasl;
      Index := Index+1;
    end;
 
  { naspat posledny }
  if( cEvidKni.VyhovujeFiltru = false )then
   begin
     Aktual := pom;
     Index := ipom;
   end;
end;
 
 
{ hladacie funkcie }
procedure cEvidKni.NajdiKniha (naz: string );
begin
  { zapnem filter }
  je_filter := true;
  filter.nazov := naz;
 
  { ak nevyhovuje aktualny - najdi prvy co vyhovuje }
  if( cEvidKni.VyhovujeFiltru = false )then
      MoveFirst;
end;
 
 
procedure cEvidKni.NajdiAutora (aut: string );
begin
  { zapnem filter }
  je_filter := true;
  filter.autor := aut;
 
  { ak nevyhovuje aktualny - najdi prvy co vyhovuje }
  if( cEvidKni.VyhovujeFiltru = false )then
      MoveFirst;
end;
 
 
procedure cEvidKni.NajdiVydal (vyd: string );
begin
  { zapnem filter }
  je_filter := true;
  filter.vydal := vyd;
 
  { ak nevyhovuje aktualny - najdi prvy co vyhovuje }
  if( cEvidKni.VyhovujeFiltru = false )then
      MoveFirst;
end;
 
{ zrusi spusteny filter }
procedure cEvidKni.ZrusFilter;
begin
  je_filter := false;
  filter.nazov := '';
  filter.autor := '';
  filter.vydal := '';
end;
 
 
{ hladaj input/output }
procedure cEvidKni.Search;
var Info : TKniInfo;
begin
    clrscr;
    writeln('Hladanie zaznamu (prazdny znamena nehladaj)');
    write ('  Nazov knihy: ');
    readln( Info.nazov );
    if( Info.nazov <> '')then
        NajdiKniha(Info.nazov);
 
    write ('        Autor: ');
    readln( Info.autor );
    if( Info.autor <> '')then
        NajdiAutora(Info.autor);
 
    write ('Vydavatelstvo: ');
    readln( Info.vydal );
    if( Info.vydal <> '')then
        NajdiVydal(Info.vydal);
end;
 
 
{ ulozi zoznam na disk }
procedure cEvidKni.UlozNaDisk;
var f:text;
    pom: PPrvok;
begin
  assign(f, KNIHY_TXT );
  rewrite(f);
 
  pom:=Hlava;
  while( pom <> nil )do
   begin
     writeln(f, pom^.Info.nazov);
     writeln(f, pom^.Info.autor);
     writeln(f, pom^.Info.vydal);
     pom := pom^.Nasl;
   end;
 
  close(f);
end;
 
 
{ vycita zoznam z disku }
procedure cEvidKni.CitajZDisku;
var f:text;
    kniha: TKniInfo;
    pom: PPrvok;
begin
  { odstranime ak nieco uz je }
  VyradVsetko;
 
  assign(f, KNIHY_TXT );
  {$I-}
  reset(f);
  {$I+}
 
  { citame ak je ok }
  if( IOResult = 0 )then
  begin
    while( not(eof(f)))do
    begin
       readln(f, kniha.nazov);
       readln(f, kniha.autor);
       readln(f, kniha.vydal);
       Pridaj(kniha);
    end;
 
    close(f);
  end;
end;
 
 
{ ukaze aktualny zaznam }
procedure cEvidKni.UkazZaznam;
begin
   gotoxy(40, 3); writeln('-------------------------------------');
 
   { iba ak existuje }
   if( Aktual <> nil )then
   begin
     gotoxy(40, 4); writeln('  Nazov knihy: ', Aktual^.Info.nazov );
     gotoxy(40, 5); writeln('        Autor: ', Aktual^.Info.autor );
     gotoxy(40, 6); writeln('Vydavatelstvo: ', Aktual^.Info.vydal );
   end
   else
   begin
     gotoxy(40, 4); writeln('data niesu dostupne');
   end;
 
   gotoxy(40, 7); writeln('-------------------------------------');
end;
 
 
{ ukaze aktualny zaznam ako pruh }
procedure cEvidKni.UkazZaznamList;
begin
  writeln('|');
  writeln( Aktual^.Info.nazov:40, '|' );
  writeln( Aktual^.Info.autor:20, '|' );
  writeln( Aktual^.Info.vydal:20, '|' );
end;
 
 
{ zobrazi status }
procedure cEvidKni.Status;
begin
  gotoxy(40,2); write('Zaznam c.', Index, ' (celkom ', Pocet,')');
 
  { ak je zapnuty filter }
  if( je_filter )then
   begin
     gotoxy(40, 11); writeln('--------------- filter --------------');
     gotoxy(40, 12); writeln('  Nazov knihy: ', filter.nazov );
     gotoxy(40, 13); writeln('        Autor: ', filter.autor );
     gotoxy(40, 14); writeln('Vydavatelstvo: ', filter.vydal );
     gotoxy(40, 15);writeln('-------------------------------------');
   end;
  gotoxy(40,16); write('HEAP = ',MaxAvail:6, ' / ' , MemAvail:6);
end;
 
 
begin
end.
Navigační menu

Osobní nástroje

Hledat

Pascal source

Pascal Wiki

Bonus

Contacts

Languages
