1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:

unit DVKList;

interface
uses
  SysUtils;

type
 pDVKListItem = ^tDVKListItem;
 tDVKListItem = class
  private
   fPrior, fNext, fData: tDVKListItem;
  public
   constructor create;
   destructor Destroy; override;
   property Prior: tDVKListItem read fPrior write fPrior;
   property Next : tDVKListItem read fNext  write fNext;
   property Data : tDVKListItem read fData  write fData;
 end;

 pDVKList = ^tDVKList;
 tDVKList = class
 private
  fAnkerAnfang, fAnkerEnde, fLauf: tDVKListItem;
  fcount: integer;
 public
  constructor Create;
  destructor  Destroy; override;
  function  First: Pointer;
  function  Last : Pointer;
  function  Next : Pointer;
  function  prior: Pointer;
  function  read : Pointer;
  function  BOF  : boolean;  //Begin of List
  function  EOF  : boolean;  //End of List
  procedure Add(myPointer: pointer);
  procedure Insert(myPointer: pointer);
  procedure del(myPointer: pointer);
  procedure DelCurrent;
  property  Count: Integer read fCount;
 end;


implementation


////////////////////////////////////////////////////////////////
{ tDVKList }
////////////////////////////////////////////////////////////////

procedure tDVKList.Add(myPointer: pointer);
var
 v: tDVKListItem;
begin
 if fAnkerAnfang = NIL then
 begin //1. Element
  v := tDVKListItem.create;  fAnkerAnfang := v;
  v := tDVKListItem.create;  fAnkerEnde   := v;
  v := tDVKListItem.create;  fLauf        := v;

  fLauf.fData := myPointer; //Daten zuweisen

  fAnkerAnfang.Next := fLauf;        //Anfang setzen
  fAnkerEnde.Prior  := fLauf;        //Ende setzen
  fLauf.Prior       := fAnkerAnfang; //vorgänger setzen
  fLauf.Next        := fAnkerEnde;   //nachfolger setzen

  fCount             := 1;            //Zähler setzen
 end
 else
 begin //Zum Schluss neuen Knoten einfügen
  v := tDVKListItem.create;            //Neues Item erstellen
  v.Data           := myPointer;       //Daten zuweisen
  v.Next           := fAnkerEnde;      //Nachfolger setzen
  v.Prior          := fAnkerEnde.Prior;//Vorgänger als neuen Vorgänger setzen
  v.Prior.Next     := v;               //Neuen Nachfolger beim alten Vorgänger setzen
  fAnkerEnde.Prior := v;               //Neuen Vorgänger setzen;

  inc(fCount);                         //Zähler setzen
 end;
end;

procedure tDVKList.Insert(myPointer: pointer);
var
 v,n,t: tDVKListItem;
begin
 if (fAnkerAnfang = NIL) OR (count = 0) then
 begin
  add(myPointer);
 end
 else
 begin
  t            := tDVKListItem.create;
  t.Data       := myPointer;

//Die beiden Zeilen eingefügt, nun klappt das ganze :-)
  if fLauf = fAnkerAnfang then fLauf := fAnkerAnfang.Next;
  if fLauf = fAnkerEnde then   fLauf := fAnkerEnde.Prior;

  v := fLauf;
  n := fLauf.Next;

  v.Next  := t;
  t.Prior := v;

  n.Prior := t;
  t.Next  := n;

  fLauf := t;
 end;
end;

function tDVKList.BOF: boolean;
begin
 if (fLauf = NIL)
 or (fLauf = fAnkerAnfang)
 or (fLauf.fPrior = NIL)  then
  result := true
 else
  result := false;
end;

function tDVKList.EOF: boolean;
begin
 if (fLauf = NIL)
 or (fLauf = fAnkerEnde)
 or (flauf.fNext = NIL) then
  result := true
 else
  result := false;
end;

constructor tDVKList.Create;
begin
 inherited;
 fAnkerAnfang := NIL;
 fAnkerEnde   := NIL;
 fLauf        := NIL;
 fcount       := 0;
end;

// hier nach den Pointer in fLauf.data suchen
// und dann diesen knoten freigeben
procedure tDVKList.del(myPointer: pointer);
begin
 if  (fAnkerAnfang       <> NIL)
 and (fAnkerAnfang.fNext <> NIL) then //Liste wurde mal erstellt.
 begin
  fLauf := fAnkerAnfang.Next;
  repeat
   if fLauf.Data = myPointer then
   begin
    delCurrent;  //akutellen knoten löschen
    Exit;
   end;
   fLauf := fLauf.Next;
  until fLauf.Next = fAnkerEnde;
 end;
end;

//Aktueller Knoten auf dem fLauf zeigt wird gelöscht und
//die Zeiger angepasst.
procedure tDVKList.DelCurrent;
var
 v,n,t: tDVKListItem;

begin
 if  (fLauf        <> NIL)
 and (fAnkerAnfang <> NIL)
 and (fAnkerEnde   <> NIL)
 and (fLauf        <> fAnkerAnfang)
 and (fLauf        <> fAnkerEnde)  then
 begin
  dec(fcount);      //Zähler verminden

  t := fLauf; //Laufvariable sichern
  v := fLauf.Prior; //Vorgänger merken
  n := fLauf.Next;  //Nachfolger merken

  v.Next  := n; //Pointer des Nachfolgers des Vorgängers auf Nachfolger setzen
  n.Prior := v; //Pointer des Vorgängers des Nachfolgers auf Vorgänger setzen

  //Knoten freigeben
  freeAndNil(t);

  //Laufvariable neu Positionieren
  if v <> fAnkerAnfang then
   fLauf := v     //Wenn noch Vorgänger vorhanden, auf Vorgänger positioieren
  else
   if n <> fAnkerEnde then
    fLauf := n    //Wenn noch Nachfolger vorhanden, auf Nachfolger positionieren
   else
    fLauf := NIL; //Wenn kein Item mehr vorhanden, auf NIL setzen
 end;
end;

destructor tDVKList.Destroy;
var
 v: tDVKListItem;
begin

 //Liste durchlaufen und freigeben
 if  (fAnkerAnfang <> NIL)
 and (fAnkerAnfang.fNext <> NIL) then //wenn knoten vorhanden sind
 begin
  fLauf := fAnkerAnfang; //auf ersten knoten setzen
  repeat
   v := fLauf.fNext;  //nachfolger merken
   FreeAndNIL(fLauf); //objekt freigeben

   fLauf := v;        //auf nächsten knoten setzen
  until v = NIL;      //solange bis kein knoten mehr existiert
 end;

 inherited;
end;

function tDVKList.First: Pointer;
begin
 result := NIL;
 if (fAnkerAnfang <> NIL)
 or (fLauf        <> NIL) then
 begin
  fLauf := fAnkerAnfang.fNext;
  result := flauf.Data;
 end;
end;

function tDVKList.Last: Pointer;
begin
 result := NIL;
 if (fAnkerEnde <> NIL)
 or (fLauf      <> NIL) then
 begin
  fLauf := fAnkerEnde.fPrior;
  result := fLauf.Data;
 end;
end;

function tDVKList.Next: Pointer;
begin
 result := NIL;
 if not Eof then
 begin
  fLauf := fLauf.Next;
  result := fLauf.Data;
 end;
end;

function tDVKList.prior: Pointer;
begin
 result := NIL;
 if not BOF then
 begin
  fLauf := fLauf.Prior;
  result := flauf.Data;
 end;
end;

function tDVKList.read: Pointer;
begin
 result := NIL;
 if fLauf <> NIL then result := fLauf.Data;
end;


////////////////////////////////////////////////////////////////
{ tDVKListItem }
////////////////////////////////////////////////////////////////

constructor tDVKListItem.create;
begin
 inherited;
 Prior:= NIL;
 Next := NIL;
 Data := NIL;
end;

destructor tDVKListItem.Destroy;
begin
 inherited;
end;

end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:

unit uTest;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DVKList, ComCtrls;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    msg: TStatusBar;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen }
    dvkList: tDVKList;
  public
    { Public-Deklarationen }
  end;
var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.einfuegen(Sender: TObject);
var
 i: integer;
 pc: pchar;
 s: string;
begin
 memo1.Clear;
 for I := 1 to 3 do
 begin
  s := inttostr(i);
  pc := strnew(pAnsiChar(s));
  dvkList.insert(pc); //hier kommt fehler beim insert
 end;

 //DEBUG: Listausgabe
 dvkList.first;
 while not dvkList.EOF do
 begin
  s := pChar(dvkList.read);
  memo1.Lines.Add(s);
  dvkList.Next;
 end;
end;

procedure TForm1.loeschen(Sender: TObject);
var
  i: Integer;
begin
 i := 0;

//delete 1 from 2
 if dvkList <> NIL then
 begin
  dvkList.First;
  while not dvkList.EOF do
  begin
   inc(i);
   if (i mod 2) = 0 then
   begin
    StrDispose(dvkList.read);
    dvkList.DelCurrent;
   end;
   dvkList.Next;
  end;

   //DEBUG: Listausgabe
  memo1.Clear;
  dvkList.First;
  while not dvkList.EOF do
  begin
   memo1.Lines.Add(pChar(dvkList.read)^);
   dvkList.Next;
  end;
 end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 dvkList := tDVKList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 if dvkList <> NIL then
 begin
  dvkList.First;
  while not dvkList.EOF do
  begin
   StrDispose(dvkList.read);   //Item freigeben
   dvkList.Next;
  end;
  dvkList.Free;
 end;
end;

end.					

1:
2:

  if fLauf = fAnkerAnfang then fLauf := fAnkerAnfang.Next;
  if fLauf = fAnkerEnde then   fLauf := fAnkerEnde.Prior;					

1:

procedure tDVKList.Insert(myPointer: pointer);