Witam. Mam do napisania program, który pobiera z pliku dane o filmach, które są rozpisane w linijkach w taki sposób: Rezyser; Tytul; etykieta1, etykieta2,...,etykietan. Program ma tworzyć plik wyjściowy zawierający wszystkie filmy posortowane wg etykiet. Właściwie już skończyłem i wszystko działa jednak wydaje mi się, że nie zrobiłem tego do końca tak jak miało być. Z programowania jestem raczej słaby bo dopiero zaczynam. Bardzo proszę zerknąć na ten kod i napisać co i jak można zrobić lepiej.
program filmyv;
type
PFilm=^Film ;
Film=record
autortytul:string;
etykieta:string;
nastepny:Pfilm;
end;
Pelement = ^Element;
Element = record
et: string;
nastepny: Pelement;
end;
var
plik1, plik2: text;
wpis,wpis2,filmy:string;
srednik1,srednik2,i,j,przecinek:integer;
ks,tmp: PFilm;
lista: Pelement;
//----------------PROCEDURA DODAWANIA ETYKIETY DO LISTY -------------------//
procedure dodajetykiete(glowa: Pelement; nowa_et: string);
var
tmp: Pelement;
begin
New(tmp);
tmp^.et := nowa_et;
if glowa = nil then
begin
lista := tmp;
tmp^.nastepny := nil;
end
else
begin
tmp^.nastepny := glowa^.nastepny;
glowa^.nastepny:= tmp;
end;
end;
//-------procedura dodawania filmow do listy------------//
procedure dodajfilm(var glowa: Pfilm; new_film: string; new_et:string);
begin
New(tmp);
tmp^.autortytul := new_film;
tmp^.etykieta:=new_et;
if glowa = nil then
begin
ks := tmp;
tmp^.nastepny := nil;
end
else
begin
tmp^.nastepny := glowa^.nastepny;
glowa^.nastepny := tmp;
end;
end;
//-----------PROCEDURA SPRAWDZAJĄCA CZY DANA ETYKIETA JUZ ISTNIEJE----//
function istnieje(lista: Pelement; szukana: string):boolean;
var
tmp: Pelement;
begin
tmp := lista;
istnieje := false;
while tmp <> nil do
begin
if tmp^.et= szukana then
istnieje := true;
tmp := tmp^.nastepny;
end;
end;
procedure otworzpliki;
begin
Assign(plik1, 'dane.txt');
Reset(plik1);
Assign(plik2, 'dane2.txt');
Rewrite(plik2);
end;
procedure dodaniedolisty;
begin
i:=0;
j:=0;
while not eof(plik1) do
begin
inc(i);
Readln(plik1, wpis);
srednik1 := Pos(';', wpis);
Delete(wpis, srednik1, 1);
srednik2 := Pos(';', wpis); //szukanie drugiego srednika
Delete(wpis, Pos(';', wpis), 1);
insert(';',wpis,srednik1); //wstawianie spowrotem pierwszego srednika
filmy:=Copy(wpis,0,srednik2); //zapis filmow do tablicy
delete(wpis,1,srednik2+1); //usuwanie z pliku danych zapisanych już w tablicy
wpis2:=wpis;
przecinek:=pos(',',wpis);
while przecinek>0 do
begin
dodajfilm(ks,filmy,copy(wpis,1,przecinek-1));
if not istnieje(lista,copy(wpis,1,przecinek-1)) then
dodajetykiete(lista,copy(wpis,1,przecinek-1));
delete(wpis, 1,przecinek+1);
inc(j);
przecinek:=pos(',',wpis);
end;
dodajfilm(ks,filmy,copy(wpis,1,20));
if not istnieje(lista,copy(wpis,1,20)) then
dodajetykiete(lista,copy(wpis,1,20));
end;
end;
procedure wypisanie;
begin
writeln(plik2,'POSORTOWANY WG ETYKIET SPIS FILMOW');
writeln(plik2,'');
while lista<>nil do
begin
writeln(plik2,upcase(lista^.et),':');
writeln(plik2,'==============================================');
while ks<>nil do
begin
if ks^.etykieta=lista^.et then
writeln(plik2,'* ',ks^.autortytul);
ks:=ks^.nastepny;
end;
ks:=tmp;
lista:=lista^.nastepny;
writeln(plik2,'');
end;
end;
//------------PROGRAM WŁAŚCIWY---------------------------//
begin
lista := nil;
ks:=nil;
otworzpliki;
dodaniedolisty;
wypisanie;
Close(plik1);
Close(plik2);
writeln('OPERACJA WYKONANA POPRAWNIE');
readln;
end.
Opiszę jeszcze w skrócie co robi program. Najpierw procedura 'dodaniedolisty' kopiuje wyrazy między znakami interpunkcyjnymi z pliku i zapisuje do listy jednokierunkowej pary film-etykieta (filmy mogą się powtarzać, ponieważ niektóre mają wiele etykiet), dodatkowo każda etykieta jest zapisywana do drugiej listy jednokierunkowej(tym razem bez żadnych powtórzeń). Później procedura 'wypisanie' wypisuje etykiety z listy samych etykiet, a pod każdą z nich filmy z tej pierwszej listy jednokierunkowej, przy których wartość etykiety jest równa z wyżej wypisaną.