Autor |
Beitrag |
meolus
Beiträge: 78
Gentoo, Debian, Win7 64-bit, WinXP
Delphi 2006 Prof., Delphi 2005 PE
|
Verfasst: Sa 24.01.04 14:13
Eines der letzten "Projekte" was ich in der Schule machen sollte waren einfach verkettete Listen mit Pointern. Nachdem ich das ganze auch noch in anderen Programmen verwendet habe beschloss ich das ganze in eine eigene Unit zu verfrachten, die ich überall einfach und schnell einbinden kann:
Beschreibung der Funktionen/Proceduren der Unit (auch zu finden auf meiner HP unter meolus.de/delphi/detail?id=10):
Zitat: | Diese Delphi-Unit beinhaltet die Klasse TLinkedList, welche eine einfach verkettete Liste darstellt! Es können folgende Methoden angewandt werden:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21:
| constructor Create; destructor Destroy; override; procedure Add(s: string; pos: Integer); procedure AddEnd(s: string); procedure AddFirst(s: string); procedure Clear; function Count: Integer; procedure DelAll; procedure DelAllFromPos(pos: Integer); procedure Delete(pos: Integer); function FIFODequeue: string; procedure FIFOEnqueue(s: string); function GetData(pos: Integer): string; function GetItemCount: Integer; function GetPos(s: string): Integer; function High: Integer; function LIFOPop: string; procedure LIFOPush(s: string); procedure LoadFromFile(Filename: string); procedure SaveToFile(Filename: string); procedure Show(var Memo: TMemo); |
Der Startindex der Liste ist 0!
Anwendung:
1.) LinkedList.pas in das Verzeichnis des Programms kopieren
2.) Im Programm unter "uses" (ganz oben) "LinkedList" hinzufügen
3.) Eine Variable von dem Typ: TLinkedList erstellen, createn, verwenden und schließlich wieder destroyen
Beispielprogramm:
Formelparser 2.0 |
Der Code der Unit:
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: 284: 285: 286: 287: 288: 289:
| unit LinkedList;
interface
uses StdCtrls, SysUtils;
type PItem = ^TItem; TItem = record Data: string; Next: PItem; end;
TLinkedList = class private procedure DelAllFromItem(var Item: PItem); function GetItem(pos: Integer): PItem; protected StartItem: PItem; ItemCount: Integer; public constructor Create; destructor Destroy; override; procedure Add(s: string; pos: Integer); procedure AddEnd(s: string); procedure AddFirst(s: string); procedure Clear; function Count: Integer; procedure DelAll; procedure DelAllFromPos(pos: Integer); procedure Delete(pos: Integer); function FIFODequeue: string; procedure FIFOEnqueue(s: string); function GetData(pos: Integer): string; function GetItemCount: Integer; function GetPos(s: string): Integer; function High: Integer; function LIFOPop: string; procedure LIFOPush(s: string); procedure LoadFromFile(Filename: string); procedure SaveToFile(Filename: string); procedure Show(var Memo: TMemo); end;
implementation
procedure TLinkedList.DelAllFromItem(var Item: PItem); begin if Item <> nil then begin if Item^.Next <> nil then DelAllFromItem(Item^.Next); Dispose(Item); Item := nil; end; end;
function TLinkedList.GetItem(pos: Integer): PItem; var akt_item: PItem; begin Result := nil; if pos = 0 then Result := StartItem else if pos <= ItemCount then begin akt_item := StartItem; repeat akt_item := akt_item^.Next; Dec(pos); until pos = 0; Result := akt_item; end; end;
constructor TLinkedList.Create; begin inherited; StartItem := nil; ItemCount := 0; end;
destructor TLinkedList.Destroy; begin inherited; DelAll; end;
procedure TLinkedList.Add(s: string; pos: Integer); var akt_item, neu_item: PItem; begin New(neu_item); neu_item^.Data := s;
if pos = 0 then begin akt_item := StartItem; neu_item^.next := akt_item; StartItem := neu_item; Inc(ItemCount); end else if pos <= ItemCount then begin akt_item := GetItem(pos-1); neu_item^.next := akt_item^.next; akt_item^.next := neu_item; Inc(ItemCount); end else Dispose(neu_item); end;
procedure TLinkedList.AddEnd(s: string); begin Add(s, ItemCount); end;
procedure TLinkedList.AddFirst(s: string); begin Add(s, 0); end;
procedure TLinkedList.Clear; begin DelAll; end;
function TLinkedList.Count: Integer; begin Result := High+1; ItemCount := Result; end;
procedure TLinkedList.DelAll; begin if StartItem <> nil then DelAllFromItem(StartItem); ItemCount := 0; end;
procedure TLinkedList.DelAllFromPos(pos: Integer); var akt_item: PItem; begin if pos = 0 then DelAllFromItem(StartItem) else begin akt_item := GetItem(pos-1); DelAllFromItem(akt_item^.Next); akt_item^.Next := nil; end; ItemCount := Count; end;
procedure TLinkedList.Delete(pos: Integer); var del_item, akt_item: PItem; begin if StartItem <> nil then if pos = 0 then begin del_item := StartItem; StartItem := StartItem^.Next; Dispose(del_item); Dec(ItemCount); end else if pos < ItemCount then begin akt_item := GetItem(pos-1); del_item := akt_item^.Next; akt_item^.Next := del_item^.Next; Dispose(del_item); Dec(ItemCount); end; end;
function TLinkedList.FIFODequeue: string; begin Result := GetData(0); Delete(0); end;
procedure TLinkedList.FIFOEnqueue(s: String); begin AddEnd(s); end;
function TLinkedList.GetData(pos: Integer): string; begin if pos > ItemCount-1 then Result := 'Element '+IntToStr(pos)+' existiert nicht!' else Result := GetItem(pos)^.Data; end;
function TLinkedList.GetItemCount: Integer; begin Result := ItemCount; end;
function TLinkedList.GetPos(s: string): Integer; var akt_item: PItem; begin result := -1; akt_item := StartItem; if akt_item <> nil then begin result := 0; while akt_item <> nil do begin if akt_item^.Data = s then Exit else begin Inc(Result); akt_item := akt_item^.Next; end; end; result := -1; end; end;
function TLinkedList.High: Integer; var akt_item: PItem; begin akt_item := StartItem; Result := -1; if akt_item <> nil then begin Inc(Result); while akt_item^.Next <> nil do begin akt_item := akt_item^.Next; Inc(Result); end; end; end;
function TLinkedList.LIFOPop: string; begin Result := GetData(0); Delete(0); end;
procedure TLinkedList.LIFOPush(s: String); begin AddFirst(s); end;
procedure TLinkedList.LoadFromFile(FileName: string); var MyFile: Textfile; ctemp: string; begin if FileExists(Filename) then begin DelAll; Assign(MyFile, Filename); Reset(MyFile); while not EoF(MyFile) do begin ReadLn(MyFile, ctemp); AddEnd(ctemp); end; CloseFile(MyFile); end; end;
procedure TLinkedList.SaveToFile(Filename: string); var MyFile: Textfile; akt_item: PItem; begin Assign(MyFile, Filename); akt_item := StartItem; if akt_item <> nil then begin ReWrite(MyFile); while akt_item <> nil do begin WriteLn(MyFile, akt_item^.Data); akt_item := akt_item^.Next; end; CloseFile(MyFile); end; end;
procedure TLinkedList.Show(var Memo: TMemo); var akt_item: PItem; begin akt_item := StartItem; Memo.Clear; while akt_item <> nil do begin Memo.Lines.Add(akt_item^.Data); akt_item := akt_item^.Next; end; end;
end. |
Gruß Meolus
Moderiert von Peter Lustig: Code- durch Delphi-Tags ersetzt
EDIT:
Thread mit Tags ausgestattet und Datei dem Thread angehängt, damit dies unabhängig von meiner Homepage ist.
EDIT2: URLs aktualisiert
Einloggen, um Attachments anzusehen!
_________________ Real programmers don't comment their code;
if it was hard to write, it should be hard to read.
Zuletzt bearbeitet von meolus am Mo 05.01.09 15:42, insgesamt 9-mal bearbeitet
|
|
obbschtkuche
Gast
Erhaltene Danke: 1
|
Verfasst: Sa 24.01.04 15:07
DelAllFromPos mit Pos > 0 funzt nicht. (Next vom neuen Letzten Item wird nicht auf nil gesetzt.)
Ich habs mal neuprogrammiert (nicht-rekursiv)
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:
| TLinkedList = class private ... function GetPreviousItem(Item: PItem): PItem; protected
...
function TLinkedList.GetPreviousItem(Item: PItem): PItem; var tmp: PItem; begin if (StartItem = nil) or (StartItem = Item) then begin result := nil; exit; end; tmp := StartItem; while (tmp^.Next <> Item) and (tmp^.Next <> nil) do tmp := tmp^.Next; result := tmp; end;
procedure TLinkedList.DelAllFromItem(var Item: PItem); var tmp: PItem; begin tmp := GetPreviousItem(Item); if tmp <> nil then tmp^.Next := nil; if Item <> nil then begin while Item^.Next <> nil do begin tmp := Item^.Next; dispose(item); item := tmp; end; dispose(item); item := nil; end; end; |
|
|
meolus
Beiträge: 78
Gentoo, Debian, Win7 64-bit, WinXP
Delphi 2006 Prof., Delphi 2005 PE
|
Verfasst: Sa 24.01.04 16:52
Hm? kannste mir das bitte nochmal genauer erläutern?
Wenn ich das letzte Item dispose, dann ist doch egal, was für werde davon next und data haben, weil es schon aus dem Speicher entfernt wurde?!
Gruß Meolus
_________________ Real programmers don't comment their code;
if it was hard to write, it should be hard to read.
|
|
obbschtkuche
Gast
Erhaltene Danke: 1
|
Verfasst: Sa 24.01.04 17:26
Eigentlich wäre das kein Problem, aber wenn noch ein "Next" von einem Item auf ein nicht mehr vorhandenes Item zeigt, kommt es zur AV wenn die Items nacheinander durchgegangen werden. (High, Show, ...)
//Edit:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16:
| begin with TLinkedList.Create do try AddEnd('test'); AddEnd('test'); AddEnd('test'); AddEnd('test'); AddEnd('test');
DelAllFromPos(2); Show(memo1); finally free; end; end; |
|
|
meolus
Beiträge: 78
Gentoo, Debian, Win7 64-bit, WinXP
Delphi 2006 Prof., Delphi 2005 PE
|
Verfasst: Sa 24.01.04 18:59
@obbschtkuche: Vielen Dank für dein Gespür
Hab es jetzt nicht ganz so gemacht, wie du vorgeschlagen hast, sondern so:
DelAllFromPos (vorher):
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10:
| procedure TLinkedList.DelAllFromPos(pos: Integer); var akt_item: PItem; begin if pos = 0 then DelAllFromItem(StartItem) else begin akt_item := GetItem(pos); DelAllFromItem(akt_item); end; ItemCount := Count; end; |
DelAllFromPos (nachher):
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11:
| procedure TLinkedList.DelAllFromPos(pos: Integer); var akt_item: PItem; begin if pos = 0 then DelAllFromItem(StartItem) else begin akt_item := GetItem(pos-1); DelAllFromItem(akt_item^.Next); akt_item^.Next := nil; end; ItemCount := Count; end; |
Außerdem ist mir in der Anzeigeprocedure noch eine überflüssige Abfrage aufgefallen, die ich nun auch entfernt habe:
Show (vorher):
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11:
| procedure TLinkedList.Show(var Memo: TMemo); var akt_item: PItem; begin akt_item := StartItem; Memo.Clear; if akt_item <> nil then while akt_item <> nil do begin Memo.Lines.Add(akt_item^.Data); akt_item := akt_item^.Next; end; end; |
Show (nachher):
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10:
| procedure TLinkedList.Show(var Memo: TMemo); var akt_item: PItem; begin akt_item := StartItem; Memo.Clear; while akt_item <> nil do begin Memo.Lines.Add(akt_item^.Data); akt_item := akt_item^.Next; end; end; |
Der aller erste Beitrag und die Daten auf meiner Hompage wurden dem entsprechend auch korrigiert!!!
_________________ Real programmers don't comment their code;
if it was hard to write, it should be hard to read.
|
|
O'rallY
Beiträge: 563
|
Verfasst: Fr 25.03.05 14:53
Die Unit von meolus lässt sich auch einfach so anpassen, dass sie mit jedem x-beliebigen Datentyp verwendet werden kann.
(Hier hab ich zur Speicherreservierung direkt die WinAPI (GlobalAlloc) benutzt. Es lässt sich natürlich auch mit New und Dispose realisieren.):
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:
| unit List;
interface uses Windows;
type PItem = ^TItem; TItem = packed record Data: Pointer; Next: PItem; end;
type TList = class private procedure DelAllFromItem(var Item: PItem); function GetPreviousItem(Item: PItem): PItem; function GetItem(Pos: integer): PItem; protected StartItem: PItem; ItemCount: Integer; public constructor Create; destructor Destroy; override;
procedure Add(Data: Pointer; Size: LongWord; pos: integer = -1); procedure Delete(Pos: integer); procedure Clear; function GetItemData(Pos: integer): Pointer;
property Count: integer read ItemCount; end;
function MGetMem(Size: Integer) : Pointer; function MFreeMem(P: Pointer) : Integer;
implementation
function MGetMem(Size: Integer) : Pointer; begin if Size = 0 then Result := nil else Result := GlobalAllocPtr(GMEM_FIXED, Size); end;
function MFreeMem(P: Pointer) : Integer; begin Result := GlobalFreePtr(P); end;
constructor TList.Create; begin StartItem := nil; ItemCount := 0; inherited; end;
destructor TList.Destroy; begin Clear; inherited; end;
procedure TList.Add(Data: Pointer; Size: LongWord; pos: integer = -1); var cur_item, new_item: PItem; begin new_item := MGetMem(SizeOf(TItem)); new_item^.Data := MGetMem(Size); if new_item^.Data = nil then begin MFreeMem(new_item); exit; end; CopyMemory(new_item^.Data, Data, Size);
if pos = -1 then pos := ItemCount;
if pos = 0 then begin cur_item := StartItem; new_item^.next := cur_item; StartItem := new_item; Inc(ItemCount); end else if pos <= ItemCount then begin cur_item := GetItem(pos-1); new_item^.next := cur_item^.next; cur_item^.next := new_item; Inc(ItemCount); end else begin MFreeMem(new_item^.Data); MFreeMem(new_item); end; end;
procedure TList.Delete(Pos: integer); var del_item, cur_item: PItem; begin if StartItem <> nil then if pos = 0 then begin del_item := StartItem; StartItem := StartItem^.Next; MFreeMem(del_item^.Data); MFreeMem(del_item); Dec(ItemCount); end else if pos < ItemCount then begin cur_item := GetItem(pos-1); del_item := cur_item^.Next; cur_item^.Next := del_item^.Next; MFreeMem(del_item^.Data); MFreeMem(del_item); Dec(ItemCount); end; end;
function TList.GetPreviousItem(Item: PItem): PItem; var tmp: PItem; begin if (StartItem = nil) or (StartItem = Item) then begin result := nil; exit; end; tmp := StartItem; while (tmp^.Next <> Item) and (tmp^.Next <> nil) do tmp := tmp^.Next; result := tmp; end;
procedure TList.DelAllFromItem(var Item: PItem); var tmp: PItem; begin tmp := GetPreviousItem(Item); if tmp <> nil then tmp^.Next := nil; if Item <> nil then begin while Item^.Next <> nil do begin tmp := Item^.Next; MFreeMem(Item^.Data); MFreeMem(Item); item := tmp; end; MFreeMem(Item^.Data); MFreeMem(Item); Item := nil; end; end;
procedure TList.Clear; begin if StartItem <> nil then DelAllFromItem(StartItem); ItemCount := 0; end;
function TList.GetItem(Pos: integer): PItem; var cur_item: PItem; begin Result := nil; if Pos >= ItemCount then exit; if Pos = 0 then Result := StartItem else if pos <= ItemCount then begin cur_item := StartItem; repeat cur_item := cur_item^.Next; Dec(Pos); until Pos = 0; Result := cur_item; end; end;
function TList.GetItemData(Pos: integer): Pointer; var item: PItem; begin Result := nil; if Pos >= ItemCount then exit; item := GetItem(Pos); if item <> nil then Result := GetItem(Pos)^.Data else Result := nil; end; |
Der Zugriff auf eine solche List geschieht folgendermaßen:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24:
| uses List; type TTest = record s1, s2: string; i1: integer; end;
var Test: TTest; List: TList; begin Test.s1 := 'Blaukraut bleibt Blaukraut und Brautkleid bleibt Brautkleid.' Test.s2 := 'Mööp'; Test.i1 := 1234;
List := TList.Create; try List.Add(@Test, SizeOf(Test)); ShowMessage(TTest(List.GetItemData(0)^).s1); finally List.Free; end; end; |
Um das ganze zu vereinfachen bietet sich jedoch an, eine Spezialklasse von TList abzuleiten:
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:
| unit TestList;
interface uses List;
type TTest = record s1, s2: string; i1: integer; end; TTestList = class(TList) public procedure Add(Test: TTest; pos: integer = -1); function GetItemData(Pos: integer): TTest; end;
implementation
procedure TTestList.Add(Test: TTest; pos: integer = -1); begin inherited Add(@Test, SizeOf(TTest), pos); end;
function TTestList.GetItemData(Pos: integer): TTest; begin Result := TTest((inherited GetItemData(Pos))^); end;
end. |
Benutzung:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18:
| uses TestList; var Test: TTest; TestList: TTestList; begin Test.s1 := 'Blaukraut bleibt Blaukraut und Brautkleid bleibt Brautkleid.' Test.s2 := 'Mööp'; Test.i1 := 1234;
TestList := TTestList.Create; try List.Add(Test); ShowMessage(TestList.GetItemData(0).s1); finally TestList.Free; end; end; |
Ist im Verlauf eines Projektes entstanden und vielleicht ganz nützlich, wenn man mehrere Listen unterschiedlichen Typs verwalten will.
greez
_________________ .oO'rallY
Linux is like a tipi: No gates, no windows and a gnu-eating apache inside...
Zuletzt bearbeitet von O'rallY am Sa 11.03.06 13:48, insgesamt 1-mal bearbeitet
|
|
FLoDeLuXe
Hält's aus hier
Beiträge: 3
XP
D6
|
Verfasst: Sa 18.02.06 21:27
Meiner Meinung nach funktioniert das Ganze mit Zeigern auf Variablen am Besten, oder?
|
|
beshig
Beiträge: 110
Erhaltene Danke: 1
WIN 2000, WIN XP, WIN 2003, Debian Linux
Delphi 7 Personal, Delphi 2005 Personal
|
Verfasst: Sa 25.02.06 14:50
FLoDeLuXe hat folgendes geschrieben: | Meiner Meinung nach funktioniert das Ganze mit Zeigern auf Variablen am Besten, oder? |
Das glaube ich wohl auch, sollte am besten Funktionieren, wenn man Zeiger auf diese Variablen benutzt.
_________________ Was ist ein Moderatorenteam in einem recht bekannten Programmierer-Forum ? Viele Meinungen, eine zählt - Mehr ist ja auch nicht notwendig...
|
|
|