Heterogénna evidencia kníh
Delphi & Pascal (česká wiki)
Kategória: KMP (Klub mladých programátorov)
Program: Eknihy.pas, Gzoznam.pas, Gfront.pas, Gzasob.pas
Súbor exe: Eknihy.exe
Potrebné: Knihy.txt
Program: Eknihy.pas, Gzoznam.pas, Gfront.pas, Gzasob.pas
Súbor exe: Eknihy.exe
Potrebné: Knihy.txt
Heterogénna evidencia kníh. Používa tieto zoznamy
- ZASOBNIK - dynamické pole so smerníkmi na obsah
- ZOZNAM - lineárny zreťazený zoznam s hlavou
- FRONT - dynamické pole
- ZASOBNIK - dynamické pole so smerníkmi na obsah
- ZOZNAM - lineárny zreťazený zoznam s hlavou
- FRONT - dynamické pole
{ 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.