Możecie mi pomóc zrobić procedure "Usun pierwszy element o podanej wartosci klucza", bo kolejna z usuwaniem wszystkich elementów raczej będzie identyczna tylko bez boolean, żeby sprawdzać czy już coś usunąłem.
Zmienne w strukturze mam narzucone.
program zad;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
tdana = integer;
plista_d=^tlista_d;
tlista_d = record
klucz: tdana;
nast, pop: plista_d
end;
var
menu: integer;
pocz, kon: plista_d;
dane: textfile;
procedure Dodaj(var pocz:plista_d; var kon:plista_d);
var
nowy: plista_d;
begin
new(nowy);
nowy^.klucz:= random(10)+1;
if (pocz = nil) then begin
pocz:= nowy;
pocz^.pop:= nil;
kon:= nowy;
end else
begin
kon^.nast:= nowy;
nowy^.pop:= kon;
kon:= nowy;
end;
end;
procedure Wyswietl(pocz:plista_d);
begin
while (pocz <> nil) do begin
writeln(pocz^.klucz);
pocz:= pocz^.nast;
end;
end;
procedure UsunElement(var pocz:plista_d);
var
delete: plista_d; //delete = pomocniczy
i, number: integer;
CzyUsuniety: boolean;
begin
CzyUsuniety:= false;
writeln('Jaka wastosc chcesz usunac z pierwszego elementu?');
readln(number);
if (pocz^.nast = nil) then begin
writeln('Nie ma 2 elementu');
while (pocz^.pop <> nil) do begin
if (pocz^.klucz = number) then begin
if (pocz^.nast = nil) and (pocz^.pop <> nil) and (CzyUsuniety = false) then begin
delete:= pocz;
pocz:= pocz^.pop;
dispose(delete);
pocz^.nast:= nil;
CzyUsuniety:= true;
end;
end;
end;
end;
end;
procedure ZapiszDoPliku(pocz:plista_d; var plik:textfile);
begin
if (pocz <> nil) then begin
AssignFile(plik,'C:\Users\Mario\Desktop\Plik123.txt');
rewrite(plik);
while (pocz <> nil) do begin
writeln(plik, pocz^.klucz);
pocz:= pocz^.nast;
end;
CloseFile(plik);
writeln('Dane zostaly zapisane do pliku tekstowego');
end else
writeln('Brak elementow w liscie!');
end;
begin
pocz:= nil;
kon:= nil;
repeat
randomize;
writeln(' MENU ');
writeln('-------------------------');
writeln('1. Dodaj element do listy dwukierunkowej');
writeln('2. Usun pierwszy element o podanej wartosci klucza');
writeln('3. Usun wszystkie elementy o podanej wartosci klucza');
writeln('4. Wyswietl liste dwukierunkowa');
writeln('5. Zapisz do pliku tekstowego wszystkie elementy listy');
writeln('6. Koniec');
readln(menu);
writeln('-------------------------');
case (menu) of
1: Dodaj(pocz, kon);
2: UsunElement(pocz);
//3: Wyswietl(pocz);
4: Wyswietl(pocz);
5: ZapiszDoPliku(pocz, dane);
end;
until(menu = 6);
end.
Delphi 