Mam taki program : Robiony na liście ; Baza studentów. Problem polega na tym, że wszystko kompiluje się bez problemu ale podczas usuwania studenta o podanym nazwisku wywala błąd. Usunie go ale błąd wyskakuje za kazdym razem :( Program: lazarus. Błąd wskazuje linijkę Q:=Q^.next w procedurze "Usun_studenta"
program project1;
uses CRT,Dos;
type TNazwa = string[50];
TStudent = record
nazwisko:TNazwa;
imie:TNazwa;
data_ur:DateTime;
kier:TNazwa;
end;
TWsk = ^TElement;
TElement = record
student:TStudent;
prev,next:TWsk;
end;
var P,K:TWsk;
{*******************************************************************}
procedure Wprowadz_studenta(var x:TStudent);
begin
with x do
begin
write('Nazwisko: '); readln(nazwisko);
write('Imie: '); readln(imie);
write('Data urodzenia: ');
with data_ur do readln(day,month,year);
write('Kierunek studiow: '); readln(kier);
end;
end;
{*******************************************************************}
procedure Pokaz_studenta(x:TStudent);
begin
with x do
begin
write(nazwisko); GotoXY(30,WhereY);
write(imie); GotoXY(50,WhereY);
with data_ur do write(day:2,'.',month:2,'.',year:4);
GotoXY(66,WhereY); writeln(kier);
end;
end;
{*******************************************************************}
function Miejsce_wstawienia(P:TWsk; x:Tstudent):TWsk;
var d1,d2:longint;
begin
PackTime(x.data_ur,d1);
PackTime(P^.student.data_ur,d2);
while (P<>NIL) and (d2<d1) do
begin
P:=P^.next;
if P<>NIL then PackTime(P^.student.data_ur,d2);
end;
Miejsce_wstawienia:=P;
end;
{*******************************************************************}
procedure Dodaj_do_listy(var P,K:TWsk ; x:Tstudent);
var Q,W:TWsk;
begin
New(Q);
Q^.student:=x; Q^.next:=NIL;
if P=NIL then begin
P:=Q; K:=Q;
end
else begin
W:=Miejsce_wstawienia(P,x);
if W=P then begin
P^.prev:=Q; Q^.next:=P;
P:=Q;
end
else if W=NIL then begin
K^.next:=Q; Q^.prev:=K;
K:=Q;
end
else begin
W^.prev^.next:=Q;
Q^.prev:=W^.prev;
W^.prev:=Q;
Q^.next:=W;
end;
end;
end;
{*******************************************************************}
procedure Dodaj_nowe_dane(var P,K:TWsk);
var x:TStudent;
z:char;
begin
write('Czy chcesz dodac nowe dane ? (T/N) : ');
repeat
z:=UpCase(ReadKey)
until z in ['N','T'];
writeln(z);
while z='T' do
begin
Wprowadz_studenta(x);
Dodaj_do_listy(P,K,x);
write('Czy chcesz dodac nowa osobe ? (T/N) : ');
repeat
z:=UpCase(ReadKey)
until z in ['N','T'] ;
writeln(z);
end;
end;
{*******************************************************************}
procedure Wyswietl_liste(P:Twsk);
begin
while P<>NIL do
begin
Pokaz_studenta(P^.student);
P:=P^.next;
end;
end;
{*******************************************************************}
procedure Wyszukaj_nazwisko(P,K:TWsk);
var nazwisko:string[30];
begin
writeln('Podaj nazwisko: '); readln(nazwisko);
while (P<>NIL) or (P=K) do
begin
if (nazwisko=P^.student.nazwisko) then Pokaz_studenta(P^.student);
P:=P^.next;
end;
end;
{*******************************************************************}
procedure Do_pliku(P,K:TWsk;n_p:string);
var plik:file of TStudent;
begin
Assign(plik,n_p); rewrite(plik);
while (P<>NIL) do
begin
write(plik,P^.student);
P:=P^.next;
end;
close(plik);
end;
{*******************************************************************}
procedure Z_pliku(var P,K:TWsk;n_p:string);
var plik:file of TStudent;
x:TStudent;
begin
Assign(plik,n_p);
Reset(plik);
while not EOF(plik) do
begin
read(plik,x);
Dodaj_do_listy(P,K,x);
end;
close(plik);
end;
{*******************************************************************}
procedure Usun_studenta(P,K:TWsk;W:TWsk);
var Q:TWsk;
begin
Q:=P;
while (Q^.next<>W) do
begin
Q:=Q^.next; <------- Tutaj jest błąd
end;
if W=P then begin
P:=P^.next;
if P=NIL then K:=NIl;
end
else begin
Q^.next:=W^.next;
if W=K then K:=Q;
end;
Dispose(W);
end;
{*******************************************************************}
Function Wyszukaj_element_po_nazwisku(P,K:TWsk):TWsk;
var nazwisko:string[30];
W:TWsk;
begin
writeln('Podaj nazwisko osoby, ktora chcesz usunac: '); read(nazwisko);
while (P<>NIL) do
begin
if (nazwisko=P^.student.nazwisko) then W:=P;
P:=P^.next;
end;
Wyszukaj_element_po_nazwisku:=W;
end;
{*******************************************************************}
procedure Usun_liste(P,K:TWsk);
begin
while P<>NIL do
begin
Usun_studenta(P,K,P);
P:=P^.next;
end;
end;
{*******************************************************************}
begin
P:=NIL; K:=NIL;
ClrScr;
//Z_pliku(P,K,'C:\Users\Karol\Documents\Lazarus projekty\lista\studenci.dat');
Dodaj_nowe_dane(P,K);
writeln('Wprowadzone dane : ');
Wyswietl_liste(P);
Usun_studenta(P,K,Wyszukaj_element_po_nazwisku(P,K));
Do_pliku(P,K,'C:\Users\Karol\Documents\Lazarus projekty\lista\studenci.dat');
writeln('Lista: ' );
Wyswietl_liste(P);
Usun_liste(P,K);
//writeln('Wyszukaj po nazwisku: ');
//Wyszukaj_nazwisko(P,K);
ReadKey;
end.