Einzelnen Beitrag anzeigen

ajaxson

Registriert seit: 6. Sep 2007
14 Beiträge
 
#3

Re: ADT-Liste Listenelement anhaengen

  Alt 7. Apr 2008, 18:15
mh ok hat sich erledigt...lag am hauptprogramm und nicht an der unit adtliste..
die unit dürfte funktionieren..ich poste mal das ganze ding..

Delphi-Quellcode:
unit ADTRIngliste;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type TInhalt=integer;
     TZeiger=^TElement;
     TElement=Record
               inhalt:TInhalt;
               naechster:TZeiger;
              end;

     TRingliste = Record
               erstes,aktuelles,letzte:TZeiger;
             end;

procedure erzeugen(var liste:TRIngliste);
procedure gehe_naechstes(var liste:TRIngliste);
procedure anhaengen(element:integer;var liste:TRIngliste);
procedure loeschen(var liste:TRIngliste);
function leer(liste:TRIngliste):boolean;
procedure gehe_erstes(var liste:TRIngliste);
function hole(liste:TRIngliste):TInhalt;
procedure SchreibeEintrag(var liste:TRingliste;inhalt:TInhalt);

var Ringliste:TRingliste;


implementation

procedure erzeugen(var liste:TRIngliste);
begin
  Ringliste.erstes:=NIL;
  Ringliste.aktuelles:=NIL;
  Ringliste.letzte:=NIL;
end;

function leer(liste:TRIngliste):boolean;
begin
 if Ringliste.erstes=NIL then result:=true
                         else result:=false;
end;

procedure gehe_erstes(var liste:TRIngliste);
begin
if not leer(liste) then Ringliste.aktuelles:=Ringliste.erstes
              else showmessage('Liste Leer');
end;

Procedure gehe_naechstes(var liste:TRIngliste);
begin
 if not (leer(liste)) then
                RIngliste.aktuelles:=Ringliste.aktuelles^.naechster
               else
                showmessage('Liste Leer');
end;

function hole(liste:TRIngliste):TInhalt;
begin
  if not (leer(liste)) then result:=ringliste.aktuelles^.inhalt
               else
                showmessage('Liste Leer');
end;

procedure anhaengen(element:integer;var liste:TRIngliste);
var neues:TZeiger;
begin
 NEW(neues);
 neues^.inhalt:=element;
 neues^.naechster:=ringliste.erstes;
 if not (leer(liste)) then begin
                      ringliste.letzte^.naechster:=neues;
                      ringliste.letzte:=neues;
                      ringliste.aktuelles:=neues;
                     end
               else begin
                      Ringliste.erstes:=neues;
                      Ringliste.aktuelles:=neues;
                      Ringliste.letzte:=neues;
                    end;
end;

function davor(liste:TRingliste):TZeiger;
var zeiger:TZeiger;
begin
    if liste.aktuelles=liste.erstes then result:=NIL
    else begin
        zeiger:=liste.erstes;
        while zeiger^.naechster <> liste.aktuelles do zeiger:=zeiger^.naechster;
    end;
   result:=zeiger;
end;

procedure SchreibeEintrag(var liste:TRingliste;inhalt:TInhalt);
begin
 if not(leer(liste)) then
  ringliste.aktuelles^.inhalt:=inhalt;
end;

procedure loeschen(var liste:TRingliste);
var voraktuelles,blub:TZeiger;
begin
    if not(leer(liste)) then
    begin
        if liste.erstes=liste.letzte then
        begin
            dispose(liste.aktuelles);
            liste.aktuelles:=NIL;
            liste.letzte:=NIL;
            liste.erstes:=NIL;
        end
        else if liste.aktuelles=liste.letzte then
        begin
            voraktuelles:=davor(liste);
            dispose(liste.letzte);
            liste.letzte:=voraktuelles;
            liste.letzte^.naechster:=liste.erstes;
            liste.aktuelles:=liste.erstes;
        end
        else if liste.aktuelles=liste.erstes then
        begin
            liste.aktuelles:=liste.aktuelles^.naechster;
            dispose(liste.erstes);
            liste.erstes:=liste.aktuelles;
            liste.aktuelles:=liste.erstes;
        end
        else begin
            voraktuelles:=davor(liste);
            blub:=liste.aktuelles^.naechster;
            dispose(liste.aktuelles);
            liste.aktuelles:=blub;
            voraktuelles^.naechster:=liste.aktuelles;
        end;
    end;
end;

end.
  Mit Zitat antworten Zitat