table.~pas

《Kylix程序设计》一书中附带的例程源代码

unit Table;

interface

type
  PMyNode = ^TMyNode;
  TMyNode = record
    Data: Pointer;
    Next: PMyNode;
  end;

  TMyList = record
    Count: Integer;
    Node: PMyNode;
  end;
  PMyList = ^TMyList;

  TSearchFunc = function ( Data1, Data2: Pointer ): Boolean;
  TTouchFunc = function ( Data: Pointer ): string;

function Create(): PMyList;
procedure Add( List: PMyList; Data: Pointer );
procedure Insert( List: PMyList; Data: Pointer; Index: Integer );
procedure Delete( List: PMyList; Index: Integer );
function Search( List: PMyList; Data: Pointer ): Integer;
procedure Clear( List: PMyList );
procedure Destroy( List: PMyList );
procedure Touch( List: PMyList; TouchFunc: TTouchFunc );

implementation

uses
  Point;

function Create(): PMyList;
var
  p: PMyList;
begin
  New( p );
  p^.Count := 0;
  p^.Node := nil;
  Result := p;
end;

procedure Add( List: PMyList; Data: Pointer );
var
  NewNode: PMyNode;
  CurrNode: PMyNode;
begin
  // Create a new node
  New( NewNode );
  NewNode^.Next := nil;
  NewNode^.Data := Data;
  // Find the last node of the list
  if List^.Node = nil then
  begin
    // Add the new node
    List^.Node := NewNode;
    Inc( List^.Count );
  end
  else
  begin
    CurrNode := List^.Node;
    while CurrNode^.Next <> nil do
    begin
      CurrNode := CurrNode^.Next;
    end;
    // Add the new node
    CurrNode^.Next := NewNode;
    Inc( List^.Count );
  end;
end;

procedure Insert( List: PMyList; Data: Pointer; Index: Integer );
var
  NewNode: PMyNode;
  CurrNode: PMyNode;
  i: Integer;
begin
  if Index = -1 then  // Add it at the end of the list
  begin
    Add( List, Data );
  end
  else if Index = 0 then  // Insert it at the first position
  begin
    // Create a new node
    New( NewNode );
    NewNode^.Next := List^.Node;
    NewNode^.Data := Data;
    // Insert the new node
    List^.Node := NewNode;
    Inc( List^.Count );
  end
  else  // Insert it at the specific position
  begin
    if List^.Count <= Index then  // If the position doen not exist
    begin
      Add( List, Data );
      exit;
    end
    else  // Find the specific position given by Index
    begin
      CurrNode := List^.Node;
      for i := 0 to Index - 2 do
      begin
        CurrNode := CurrNode^.Next;
      end;
      // Create a new node
      New( NewNode );
      NewNode^.Next := CurrNode^.Next;
      NewNode^.Data := Data;
      // Insert the new node
      CurrNode^.Next := NewNode;
      Inc( List^.Count );
    end;
  end;
end;

procedure Delete( List: PMyList; Index: Integer );
var
  CurrNode, DeletedNode: PMyNode;
  i: Integer;
begin
  if Index = -1 then  // Delete all
  begin
    while List^.Node <> nil do
    begin
      DeletedNode := List^.Node;
      List^.Node := List^.Node^.Next;
      Dispose( DeletedNode );
      DeletedNode := nil;
    end;
    List^.Count := 0;
  end
  else if Index = 0 then  // Delete the first position
  begin
    if List^.Count > 0 then
    begin
      // Delete the first node
      DeletedNode := List^.Node;
      List^.Node := List^.Node^.Next;
      Dispose( DeletedNode );
      DeletedNode := nil;
      Dec( List^.Count );
    end;
  end
  else  // Delete it at the specific position
  begin
    if List^.Count <= Index then  // If the position doen not exist
    begin
      exit;
    end
    else  // Find the specific position given by Index and delete it
    begin
      CurrNode := List^.Node;
      for i := 0 to Index - 2 do
      begin
        CurrNode := CurrNode^.Next;
      end;
      // Delete it
      DeletedNode := CurrNode^.Next;
      CurrNode^.Next := DeletedNode^.Next;
      Dispose( DeletedNode );
      DeletedNode := nil;
      Dec( List^.Count );
    end;
  end;
end;

function Search( List: PMyList; Data: Pointer ): Integer;
var
  CurrNode: PMyNode;
  SearchFunc: TSearchFunc;
begin
  Result := 0;
  // Find the specific data
  CurrNode := List^.Node;
  while CurrNode <> nil do
  begin
    SearchFunc := Point.SearchFunc;
    if SearchFunc( CurrNode^.Data, Data ) then  // Success
    begin
      // break;
      exit;
    end
    else
    begin
      CurrNode := CurrNode^.Next;
      Inc( Result );
    end;
  end;
  Result := -1;
end;

procedure Clear( List: PMyList );
begin
  Delete( List, -1 );
end;

procedure Destroy( List: PMyList );
begin
  if Assigned( List ) then
  begin
    Clear( List );
    Dispose( List );
    List := nil;
  end;
end;

procedure Touch( List: PMyList; TouchFunc: TTouchFunc );
var
  CurrNode: PMyNode;
begin
  CurrNode := List^.Node;
  while CurrNode <> nil do
  begin
    TouchFunc( CurrNode^.Data );
    CurrNode := CurrNode^.Next;
  end;
end;

end.