[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]

    unit Tlink;
    { TLink unit: doubly linked lists 5/22/95}
    { by Jeff Atwood, JAtwood159@AOL.COM. }
    { }
    { This unit can be used for stacks, deques, and free lists too.  }
    { }
    { I couldn't find a doubly-linked list implemented as an object ANYWHERE }
    { so I wrote it myself, after much trial, error, and poring over         }
    { obscure programming reference books. Hey-- it's not brain surgery, but }
    { pointers can be so naughty. }
    { }
    { For simplicity's sake, and to keep this a one-day project, I am only    }
    { storing simple integers in the cells. You can easily, easily change     }
    { that to any data type supported by Delphi including records. I would    }
    { NOT recommend trying to store a whole object with methods in there...   }
    { I couldn't get that to work. But if you can, E-Mail me. I don't know if }
    { it's even possible. }
    { }
    { There is one main object, which uses the "CELL" record type for each    }
    { entry in the list. I don't know how to hide the CELL record type from   }
    { the user, but it should be internal to this unit. The main object is    }
    { the TLink, which keeps track of the size, first, last, and current      }
    { cell records. You can move around in the list by using the Move methods }
    { and find using the Seek method. It's all fairly straightforward, look   }
    { at the demo form for examples, there are also comments in the code.     }
    { }
    { If you're feeling ambitious, I recommend you modify the cell record to  }
    { store pointers instead of integers. Don't forget to make copies of the  }
    { data, because if you point to the actual location, you're screwed when  }
    { the user destroys that instance. You gotta copy it... How many times    }
    { did I get burned by THAT one?? Also, it would be cool to turn this into }
    { a VCL component, if anyone wants to do that. }
    { }
    { This code is freeware. Please E-Mail me any cool additions, bug fixes,  }
    { rants, raves, etc. at JAtwood159@AOL.COM! Thanks for trying my code, I  }
    { hope it helps someone... }
    interface
    type
      CellPtr = ^Cell;
      Cell = record
        data: Integer;
        next: CellPtr;
        prev: CellPtr;
      end;
      TList = class(TObject)
      private
        top: CellPtr;
        bottom: CellPtr;
        current: CellPtr;
        size: Longint;
      public
        constructor create;
        destructor destroy; override;
        function IsEmpty: Boolean;
        function GetSize: Longint;
        procedure InsertBottom(item: Integer);
        procedure InsertTop(item: Integer);
        function InsertCurrent(item: Integer): Boolean;
        function FindFirst(item: Integer; var absLoc: longint): Boolean;
        function Delete: Boolean;
        function MoveFirst: Boolean;
        function MoveLast: Boolean;
        function MoveNext: Boolean;
        function MovePrevious: Boolean;
        function Seek(absLoc: longint): Boolean;
        function GetData(var item: Integer): Boolean;
      end;
    implementation
    { set up the TList object with default values }
    constructor TList.create;
    begin
      inherited create;
      top := nil;
      bottom := nil;
      current := nil;
      size := 0;
    end;
    { destroy the entire list, cell by cell }
    destructor TList.destroy;
    var
      curCell: CellPtr;
      nextCell: CellPtr;
    begin
      curCell := top;
      while not (curCell = nil) do begin
        nextCell := curCell^.next;
        freemem(curCell, SizeOf(Cell));
        curCell := nextCell;
      end;
      top := nil;
      bottom := nil;
      current := nil;
      inherited destroy;
    end;
    { returns true if the list has no cells }
    function TList.isEmpty: Boolean;
    begin
      result := (size = 0);
    end;
    { returns number of cells in list }
    function TList.getSize: Longint;
    begin
      result := size;
    end;
    { insert cell at bottom of list }
    procedure TList.InsertBottom(item: Integer);
    var
      newCell: CellPtr;
    begin
      GetMem(newCell, Sizeof(Cell));
      newCell^.data := item;
      newCell^.prev := bottom;
      newCell^.next := nil;
      { special case: this is first cell added }
      if bottom = nil then
        top := newCell
      else
        bottom^.next := newCell;
      bottom := newCell;
      size := size + 1;
    end;
    { insert cell at top of list }
    procedure TList.InsertTop(item: Integer);
    var
      newCell: CellPtr;
    begin
      GetMem(newCell, Sizeof(Cell));
      newCell^.data := item;
      newCell^.prev := nil;
      newCell^.next := top;
      { special case: this is first cell added }
      if top = nil then
        bottom := newCell
      else
        top^.prev := newCell;
      top := newCell;
      size := size + 1;
    end;
    { insert cell after current item }
    function TList.InsertCurrent(item: Integer): Boolean;
    var
      newCell: CellPtr;
    begin
      if (current = nil) then
        result := False
      else begin
        GetMem(newCell, Sizeof(Cell));
        newCell^.data := item;
        newCell^.prev := current;
        newCell^.next := current^.next;
        { special case: current cell is last cell }
        if current^.next = nil then
          bottom := newCell
        else
          current^.next^.prev := newCell;
        current^.next := newCell;
        size := size + 1;
        result := True;
      end;
    end;
    { Look for item in data field. Starts at top of list }
    { and looks at every item until a match is found.    }
    { if found, makes matched cell current, and returns  }
    { absolute location of match where 1 = top.          }
    function TList.FindFirst(item: Integer; var absLoc: longint): Boolean;
    var
      curCell: CellPtr;
      cnt: longInt;
    begin
      result := False;
      curCell := top;
      cnt := 0;
      absLoc := 0;
      while not (curCell = nil) do begin
        cnt := cnt + 1;
        if curCell^.Data = item then begin
          absLoc := cnt;
          current := curCell;
          result := True;
          exit;
        end;
        curCell := curCell^.next;
      end;
    end;

    { delete the current cell }
    function TList.Delete: Boolean;
    label
      exitDelete;
    begin
      { we can only delete the current record }
      if current = nil then
        result := False
      else begin
        { see if list has one item }
        if size = 1 then begin
          top := nil;
          bottom := nil;
          goto exitDelete;
        end;
        { see if we're at the top of list }
        if current^.prev = nil then begin
          top := current^.next;
          top^.prev := nil;
          goto exitDelete;
        end;
        { see if we're at the bottom of list }
        if current^.next = nil then begin
          bottom := current^.prev;
          bottom^.next := nil;
          goto exitDelete;
        end;
        { we must be in middle of list of size > 1 }
        current^.prev^.next := current^.next;
        current^.next^.prev := current^.prev;
        goto exitDelete;
      end;
      { arrgh-- a goto! but this is a textbook goto! }
      exitDelete: begin
                    result := True;
                    freemem(current, SizeOf(Cell));
                    current := nil;
                    size := size - 1;
                    if size = 0 then begin
                      top := nil;
                      bottom := nil;
                    end;
                  end;
    end;
    { make first value in list current }
    function TList.MoveFirst: Boolean;
    begin
      if top = nil then
        result := False
      else begin
        current := top;
        result := True;
      end;
    end;
    { make last value in list current }
    function TList.MoveLast: Boolean;
    begin
      if bottom = nil then
        result := False
      else begin
        current := bottom;
        result := True;
      end;
    end;
    { make next value in list current }
    function TList.MoveNext: Boolean;
    begin
      if (current = nil) or (current^.next = nil) then
        result := False
      else begin
        current := current^.next;
        result := True;
      end
    end;
    { make previous value in list current }
    function TList.MovePrevious: Boolean;
    begin
      if (current = nil) or (current^.prev = nil) then
        result := False
      else begin
        current := current^.prev;
        result := True;
      end;
    end;
    { return data item from current list position }
    function TList.GetData(var item: Integer): Boolean;
    begin
      if (current = nil) then
        result := False
      else begin
        item := current^.data;
        result := True;
      end;
    end;
    { make current the absolute cell N in the list }
    { where top = 1 }
    function TList.Seek(absloc: longint): Boolean;
    var
      curCell: CellPtr;
      cnt: longint;
    begin
      result := False;
      if absloc <= 0 then
        exit;
      curCell := top;
      while not (curCell = nil) do begin
        cnt := cnt + 1;
        if cnt = absloc then begin
          current := curCell;
          result := True;
          exit;
        end;
        curCell := curCell^.next;
      end;
    end;
    end.

[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]