úloha v Pascalu – Pascal – Fórum – Programujte.com

Ahoj, mám docela velkej problém a byl bych moc rád, kdyby mi mohl někdo aspoň trošku poradit. Studuju vysokou školu a máme i předmět základy programování, který není zrovna mou silnou stránkou :o(

Dostali jsme dva zdrojáky: soubor linsezn.pas, který obsahuje lineární seznam a do souboru karta.pas máme něco připsat, abychom vytvořili:

Inteligentni vyhledavani - vybereme, podle ceho chceme vyhledavat (autor, nazev..), pokud dana kniha neexistuje, zobrazi se aspon ty zacinajici stejnym pismenem


Kdyby mi někdo mohl poradit byl bych moc rád, protože si s tím vůbec nevím rady :o(

Zdrojový kód souboru karta.pas:
program kartoteka;
uses linsezn,crt;
const soubor = 'karty.dat';
Extended = chr(0);
CursorUp = chr(72);
CursorDown = chr(80);
type
Ukarta = ^karta;
karta = record
jmeno: string [20];
prijmeni: string [20];
email: string[40];
icq: string[10];
vek: byte;
rodnecislo: string[11];
end;

var sez:seznam;
c:char;

function jecislice(c: char): boolean;
begin
if (c>='0') and (c<='9') then jecislice := true
else jecislice:=false;
end;

function Cislo(c:char): integer;
begin
Cislo:=ord(c)-ord('0');
end;

function overrc (s:string) : boolean;
var b: boolean;
soucet: integer;
i,j: integer;
begin
soucet:= 0;
b:=true;
for i:=1 to 6 do
begin
if jecislice(s[i])=false then b:=false
else
begin
if (i mod 2)=0 then {overuji delitelnost jedenacti}
soucet:=soucet+Cislo(s[i])
else
soucet:=soucet-Cislo(s[i]);
end;
end;
i:=7;
if (s[7]='/') then inc(i);
j:=i;
while i<=Length(s) do begin
if jecislice(s[i])=false then b:=false
else
soucet:=soucet+(1-2*((i+j-7) mod 2))*Cislo(s[i]);
inc(i);
end;
if (soucet mod 11) <> 0 then b := false;
if not (i - j = 4) then b:=false;
OverRC := b;
end;

procedure pokr;
begin
writeln('Pokracujte libovolnou klavesou..');
readkey;
end;

procedure Vypiskartu(k:pointer; akt:boolean);
var d: ukarta;
begin
d:=k;
if akt then textcolor(yellow);
writeln(d^.jmeno,' ',d^.prijmeni,'; ',d^.email);
textcolor(lightgray);
end;

procedure NactiKartu(var k:Ukarta);
begin
writeln ('Zadejte jmeno');
readln (k^.jmeno);
writeln ('Zadejte prijmeni');
readln (k^.prijmeni);
writeln('Zadejte e-mail');
readln(k^.email);
writeln('Zadejte ICQ');
readln(k^.icq);

repeat
writeln ('Kolik je Vam let?');
{$I-}
readln (k^.vek);
{$I+}
until ioresult = 0;
{
repeat
writeln ('Rodne cislo');
readln (k^.rodnecislo);
until overrc (k^.rodnecislo);}
end;

procedure pridej;
var k: ukarta;
begin
new(k);
NactiKartu(k);
sez.VlozNaKon(k);
writeln('Udaje vlozeny');
pokr;
end;

procedure edituj;
var k: ukarta;
begin
if sez.prazdny then writeln('Seznam je prazdny')
else
begin
k:=sez.dejdata;
nactikartu(k);
writeln('Udaje zmeneny');
end;
pokr;
end;

procedure Odeber;
var k: ukarta;
c:char;
begin
clrscr;
writeln('Chcete odstranit kartu a/n ?');
vypiskartu(sez.dejdata,true);
c:=readkey;
if upcase(c)='A' then
begin
sez.OdstranAkt;
writeln('Karta odstranena');
end
else writeln('Karta ponechana');
pokr;
end;

procedure VymazSeznam;
var c:char;
begin
clrscr;
writeln('Opravdu chcete vymazat cely seznam a/n ?');
c:=readkey;
if upcase(c)='A' then
begin
sez.Vymaz;
writeln('Seznam vymazan');
end
else writeln('Operace zrusena');
pokr;
end; 

procedure NactiSeznam;
var f: file of karta;
k: ukarta;
d: char;
begin
{$I-}
assign(f,soubor);
reset(f);
{$I+}
if IOResult=0 then
begin
if sez.Prazdny then d:='a' else
begin
writeln('Aktualni data budou ztracena, chcete pokracovat a/n?');
d:=readkey;
end;
if upcase(d)='A' then
begin
sez.Vymaz;
while not eof(f) do begin new(k); read(f,k^); sez.VlozNaKon(k); end;
end;
close(f);
end
else
begin
writeln('Soubor s daty neexistuje');
pokr;
end;
end;

procedure UlozSeznam;
var f: file of karta;
k: ukarta;
d: char;
b: boolean;
begin
d:='a';
{$I-}
assign(f,soubor);
reset(f);
close(f);
{$I+}
if IOResult=0 then
begin
writeln('Soubor jiz existuje, chcete jej prepsat a/n?');
d:=readkey;
end;
if upcase(d)='A' then
begin
rewrite(f);
sez.JdiNaZac;
b:=false;
if not sez.prazdny then
repeat
b:=sez.JeKonec;
k:=sez.DejData;
write(f,k^);
sez.JdiNaDalsi
until b;
close(f);
writeln('Soubor ulozen');
end else writeln('Operace zrusena');
pokr;
end;

procedure Menu(x1,y1,x2,y2: integer);
begin
window(x1,y1,x2,y2);
TextBackground(blue);
clrScr;
writeln('[P]ridat polozku');
writeln('[O]debrat polozku');
writeln('[E]ditovat polozku');
writeln('[U]loz do souboru');
writeln('[N]acti ze souboru');
writeln('[',chr(24),']predchozi udaj');
writeln('[',chr(25),']dalsi udaj');
writeln('[V]ymazat seznam');
write('[K]onec');
end;

begin
TextBackground(black);
clrscr;
Menu(60,2,79,10);
window(2,2,58,39);
clrscr;

sez.Vytvor;
repeat
clrscr;
sez.zpracuj(vypisKartu);
c:=readkey;
case upcase(c) of
'P': pridej;
'E': edituj;
'O': odeber;
'U': UlozSeznam;
'N': NactiSeznam;
'V': VymazSeznam;
Extended: begin
c:=readkey;
case c of
CursorUp: sez.JdiNaPredch;
CursorDown: sez.JdiNaDalsi;
end; end;
end;
until upcase(c) = 'K';
sez.Zrus;
end.

Zdrojový kód souboru linsezn.pas:
unit linsezn;

interface
type proc=procedure(d:pointer; akt:boolean);

uprvek = ^Tprvek;
Tprvek = object
predch: uprvek;
dalsi: uprvek;
public
data: pointer;
constructor Vytvor(d: pointer);
destructor Zrus;

end;
seznam = object
hlava: uprvek;
konec: uprvek;
aktual: uprvek;
constructor Vytvor;
destructor Zrus;
procedure Vymaz;
procedure PridejNaZac(p: uprvek);
procedure PridejNaKon(p: uprvek);
function prazdny: boolean;
function DejData: pointer;
procedure OdstranAkt; { odstrani aktualni prvek}
procedure JdiNaZac;
procedure JdiNaKon;
procedure JdiNaDalsi;
procedure JdiNaPredch;
function JeKonec: boolean;
procedure VlozNaZac(d:pointer);
procedure VlozNaKon(d:pointer);
procedure Zpracuj(p:proc);
end;


implementation

destructor Tprvek.Zrus;
begin
dispose(data);
data := nil;
end;

constructor Tprvek.Vytvor (d: pointer);
begin
data := d;
dalsi := nil;
predch := nil;
end;

constructor seznam.Vytvor;
begin
hlava := nil;
konec := nil;
aktual := nil;
end;

destructor seznam.Zrus;
begin
Vymaz;
end;

procedure seznam.Vymaz;
begin
while hlava <> nil do
begin
aktual := hlava;
hlava := hlava^.dalsi;
dispose(aktual, Zrus);
end;
aktual := nil; {tady se to vymazani rovna destruktoru}
konec := nil;
end;

function seznam.DejData: pointer;
begin
if aktual<> nil then DejData:=aktual^.data else DejData:=nil;
end;

function seznam.prazdny: boolean;
begin
if hlava=nil then prazdny:=true else prazdny:=false;
end;

function seznam.JeKonec:boolean;
begin
if aktual=konec then JeKonec:=true else JeKonec:=false;
end;

procedure seznam.OdstranAkt;
var p: uprvek;
begin
if aktual <> nil then
begin
p:=nil;
if aktual = hlava then { odstranujeme hlavu }
begin
hlava := aktual^.dalsi;
hlava^.predch := nil;
end
else { aktual <> hlava, odstranujeme nehlavu }
begin
aktual^.predch^.dalsi := aktual^.dalsi;
if p=nil then p:=aktual^.predch;
end;
if aktual = konec then { odstranujeme konec }
begin
konec:=aktual^.predch;
konec^.dalsi:=nil;
end
else
begin
aktual^.dalsi^.predch := aktual^.predch;
if p=nil then p:=aktual^.dalsi;
end;
dispose(aktual,zrus);
aktual:=p;
end else {prazdny seznam}

end;

procedure Seznam.VlozNaZac(d:pointer);
var prv:uprvek;
begin
new(prv,Vytvor(d));
PridejNaZac(prv);
end;

procedure Seznam.VlozNaKon(d:pointer);
var prv:uprvek;
begin
new(prv,Vytvor(d));
PridejNaKon(prv);
end;

procedure seznam.PridejNaZac(p: uprvek);
begin
if hlava = nil then
begin
hlava := p;
konec := p;
end
else
begin
hlava^.predch := p;
p^.dalsi := hlava;
hlava := p;
end;
aktual := p;
end;

procedure seznam.PridejNaKon(p :uprvek);
begin
if hlava = nil then
begin
hlava := p;
konec := p;
end
else
begin
konec^.dalsi := p;
p^.predch := konec;
konec := p;
end;
aktual := p;

end;

procedure seznam.JdiNaZac;
begin
aktual:=hlava;
end;

procedure seznam.JdiNaKon;
begin
aktual:=konec;
end;

procedure seznam.JdiNaDalsi;
begin
if aktual<>nil then if aktual^.dalsi<>nil then aktual:=aktual^.dalsi;
end;

procedure seznam.JdiNaPredch;
begin
if aktual<>nil then if aktual^.predch<>nil then aktual:=aktual^.predch;
end;

procedure seznam.Zpracuj(p:proc);
var q: UPrvek;
begin
q:=hlava;
while q<>nil do
begin
p(q^.data,q=aktual);
q:=q^.dalsi;
end;
end;

end.

Ta kartotéka je na čtenáře a ne na knihy :-).

Jestli to dobře chápu, tak jediné co musíš udělat je v tom seznamu něco najít.
Takže: necháš si zadat, podle čeho se má v tom seznamu hledat (stiskněte J pro hledání podle jména, R pro hledání podle RČ atd.). Potom si necháš zadat hodnotu, která se má hledat (hledané jméno atd.). Pak ten seznam projdeš od prvního prvku do posledního a vypíšeš obsah těch prvků, ve kterých se příslušná položka rovná té zadané (a zapamatuješ si, jestli jsi to našel nebo ne). Pokud dojedeš až na konec a nenarazil jsi na přesnou shodu, napíšeš, že to v seznamu není, projedeš ho ještě jednou a testuješ, jestli se rovná alespoň první písmeno a pokud ano, vypíšeš to na obrazovku.

Umíš pracovat se spojovými seznamy? Jestli ne, tak pro začátek doporučuji třeba tohle http://mircosoft.ic.cz/texty/UKAZ.TXT.

Jestli ti tahle "rada" nestačí, zeptej se konkrétněji, kde přesně je problém. To, že programování není tvojí silnou stránkou, neberu jako omluvu - měl jsi celý semestr na to, aby ses to naučil. Hotový program ode mě nečekej...

P.S.: Co takhle dát nadpis "vyhledávání v lineárním seznamu"? Témat s názvem "úloha v pascalu" je tu spousta a nic moc to neřekne.