Lista dwukierunkowa - usuwanie danego elementu

0

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.
4

W poprzednim wątku napisałem Ci, żebyś porządnie formatował kod, a Ty nadal tego nie robisz; Wywal wszystkie polskie słowa i zastąp je angielskimi; Zacznij namiętnie używać Shiftu, wywal też wszystkie zmienne globalne, bo masz konflikt z pocz - tak nazywa się zmienna globalna (i tak widoczna we wszytkich procedurach) oraz parametry w procedurach; I typy danych nazwij sensownie, tak jak pokazałem Ci w tamtym wątku;

Sam sobie sprawiasz kłopot, bo kod piszesz bardzo niedbale i nikomu nie będzie się chciało go analizować; Co najwyżej dostaniesz link do Google czy pomocnych artykułów;

Pierwszy tip: procedurę Randomize wywołuje sie raz, a Ty to robisz w każdym obiegu pętli.

1 użytkowników online, w tym zalogowanych: 0, gości: 1