⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 galnklist.pas

📁 一个sql语法分析程序
💻 PAS
📖 第 1 页 / 共 4 页
字号:
    while (Temp <> FTail) do begin
      FHead^.dllnNext := Temp^.dllnNext;
      tmpData := Temp^.dllnData;
      dnmFreeNode(Temp);
      if Assigned(tmpData) then
        Notify(tmpData, lnDeleted);
      Temp := FHead^.dllnNext;
    end;
    FTail^.dllnPrev := FHead;
  end;
end;

function TgaSimpleDoubleList.GetHead: PdllNode;
{:
GetHead is the read access method of the Head property.
It checks (and corrects if needed) the head and tail node of the list trhough
the call to CheckListBorders.
}
begin
  CheckListBorders;
  Result := FHead;
end;

function TgaSimpleDoubleList.GetTail: PdllNode;
{:
GetTail is the read access method of the Tail property.
It checks (and corrects if needed) the head and tail node of the list trhough
the call to CheckListBorders.
}
begin
  CheckListBorders;
  Result := FTail;
end;

procedure TgaSimpleDoubleList.InitDoubleList;
{:
procedure InitDoubleList.
Allocates Head and Tail node and initializes them to form a list
}
begin
  {allocate a head and a tail node}
  FHead := dnmAllocNode;
  FTail := dnmAllocNode;
  FHead^.dllnNext := FTail;
  FHead^.dllnPrev := nil;
  FHead^.dllnData := nil;
  FTail^.dllnNext := nil;
  FTail^.dllnPrev := FHead;
  FTail^.dllnData := nil;
end;

procedure TgaSimpleDoubleList.InternalDelete(ANode: PdllNode);
{:
procedure InternalDelete.
ANode - A node to be deleted.
First the node is removed from list.
Then the list is notified about the node change (call to NotifyNodeChange)
After the that node is disposed and Notify is called for Nodes Data (item)
pointer
All list deletions should be done trough this method (the Clear is exeception).
}
var
  tmpData: Pointer;
begin
  if (ANode = FHead) or (ANode = FTail) then
    raise EgaLinkListError.Create(SCannotDeleteHeadOrTailNode);
  tmpData := ANode^.dllnData;
  ANode^.dllnPrev^.dllnNext := ANode^.dllnNext;
  ANode^.dllnNext^.dllnPrev := ANode^.dllnPrev;
  NotifyNodeChange(ANode, nnDeleted);
  dnmFreeNode(ANode);
  if Assigned(tmpData) then
    Notify(tmpData, lnDeleted);
end;

function TgaSimpleDoubleList.InternalInsert(AItem : pointer; AInsertItem: 
        PdllNode): PdllNode;
{:
function InternalInsert.
AItem - A pointer to item to be inserted to the list,
AInsertItem - A item after which the new item is inserted.
Returns: A node which holds the e new item.
All list additions should be done trough this method.
}
begin
  if (AInsertItem = Tail) then
    AInsertItem := AInsertItem^.dllnPrev;
  {allocate a new node and insert after the AInsertItem}
  Result := dnmAllocNode;
  Result^.dllnData := aItem;
  Result^.dllnNext := AInsertItem^.dllnNext;
  Result^.dllnPrev := AInsertItem;
  AInsertItem^.dllnNext := Result;
  Result^.dllnNext^.dllnPrev := Result;
  NotifyNodeChange(Result, nnAdded);
  if Assigned(AItem) then
    Notify(AItem, lnAdded);
end;

class function TgaSimpleDoubleList.IsList(AHead, ATail: PdllNode): Boolean;
{:
class function IsList - checks whether two nodes are connected.
AHead, ATail - nodes to be tested for connectivity.
Returns: True, if it is possible to walk from the AHead node to the ATail node.
}
var
  tmpNode: PdllNode;
begin
  tmpNode := AHead;
  while Assigned(tmpNode) and (tmpNode <> ATail) do
    tmpNode := tmpNode^.dllnNext;
  Result := tmpNode = ATail;
end;

function TgaSimpleDoubleList.IsNodeInside(ANode: PdllNode): Boolean;
{:
function IsNodeInside - checks whether the node is inside the list.
ANode - a node to be tested.
Returns: True, if the Node is between the Head and Tail
nodes (inclusive). Head and Tail nodes are considered to be inside the list
}
var
  tmpCursor: PdllNode;
  tmpTail: PdllNode;
begin
  tmpCursor := Head;
  tmpTail := Tail;
  if Assigned(tmpCursor) and Assigned(ANode) then
  begin
    while (tmpCursor <> ANode) and (tmpCursor <> tmpTail) do
      tmpCursor := tmpCursor^.dllnNext;
    Result := tmpCursor = ANode;
  end else
    Result := False;
end;

function TgaSimpleDoubleList.NodeOf(AItem: pointer): PdllNode;
{:
function NodeOf - finds a first node that holds a item pointer.
AItem - pointer which is searched for.
Returns: pointer to the first node, that holds the AItem.
}
var
  tmpTail: PdllNode;
begin
  if Head = nil then
    raise EgaLinkListError.Create(SNoHeadNode);
  Result := Head.dllnNext;
  tmpTail := Tail;
  while (Result <> tmpTail) and (Result^.dllnData <> AItem) do
    Result := Result^.dllnNext;
  if Result = tmpTail then
    Result := nil;
end;

procedure TgaSimpleDoubleList.Notify(Ptr: Pointer; Action: TListNotification);
{:
procedure Notify. Notify is called each time the logical contest of list
changes. Logical Conetnts means the set of items the form the list. In example,
adding or removing nil item is not considered to be an change in logical
conents, but replacing a item with another one is.
Ptr - pointer to the item for which the Action is performed.
}
begin
  ;// Do nothing here
end;

procedure TgaSimpleDoubleList.NotifyChange(AOldItem, ANewItem: pointer);
{:
NotifySwap calls lnDeleted notify for AOldItem, if assigned, and lnAdded notify 
for ANewItem, if Assigned.
}
begin
  if AOldItem <> ANewItem then
  begin
    if Assigned(AOldItem) then
      Notify(AOldItem, lnDeleted);
    if Assigned(ANewItem) then
      Notify(ANewItem, lnAdded);
  end;
end;

procedure TgaSimpleDoubleList.NotifyNodeChange(ANode: PdllNode; Action: 
        TgaNodeNotification);
{:
procedure NotifyNodeChange - A method that is meant for checking internal data
dependencies, for example whtere the node being removed is cursor or not.
ANode - the node that is affected by the Action.
Tere is no dependecies to check in TgaSimpleDoubleList.
}
begin
  ;// Do nothing here
end;

{
******************************** TgaDoubleList *********************************
}
destructor TgaDoubleList.Destroy;
{:
Destructor Destroy overrides the inherited Destroy.
First the Cursor is cleared (to avoid problems in Clear), then the DataUserList
checked for and freed if present, finally inherited Destroy is called.
}
begin
  FCursor := nil;
  { FreeDataUserList will also free FActiveDataUserList. And if the DataUserList
    is unassigned, then the ActiveDataUserList should also be.. }
  if Assigned(FDataUserList) then
    FreeDataUserList;
  inherited Destroy;
end;

procedure TgaDoubleList.Add(Item: Pointer);
{:
procedure Add - Adds a item at the end of the list.
Item - item to be added.
}
begin
  InternalInsert(Item, Tail);
end;

procedure TgaDoubleList.AddActiveDataUser(ADataUser: TgaSharedDoubleList);
{:
procedure AddActiveDataUser - Adds a mirroring list (ADataUser) to the internal
list. This list is used to notify DataUsers about the Node changes inside the
master list.
}
begin
  if not Assigned(FActiveDataUserList) then
    FActiveDataUserList := TgaSimpleDoubleList.Create;
  FActiveDataUserList.InternalInsert(ADataUser, FActiveDataUserList.Tail);
end;

procedure TgaDoubleList.AddDataUser(ADataUser: TgaSharedDoubleList);
{:
procedure AddDataUser - Adds a list to the internal DataUsers list, so that it
can be notified if the DataOwner is destroyed. Called (normally) from the
TgaSharedDoubleLinkList.CreateMirror.
}
begin
  if not Assigned(FDataUserList) then
    FDataUserList := TgaSimpleDoubleList.Create;
  FDataUserList.InternalInsert(ADataUser, FDataUserList.FTail);
end;

procedure TgaDoubleList.CheckListCursor;
{:
procedure CheckListCursor - Checks the cursor of the list. Raises an Exception
if cursor is incorrect. For TgaDoubleList, the cursor is always correct.
This method should be normally called from property Cursor read access method.
Also, it might get called from other methods that deal with current record but
the cursor is refferred trough the FCursor field rather that Cursor property
}
begin
  ; // TgaSimpleDoubleList and TgaDoubleList are always in correct state
end;

procedure TgaDoubleList.CopyListContest(ACopyList: TgaDoubleList);
{:
procedure CopyListContest - Clears self and then adds all items from the
ACopyList to the self.
}
begin
  Clear;
  ACopyList.First;
  while not ACopyList.Eof do
  begin
    Add(ACopyList.CurrentItem);
    ACopyList.Next;
  end;
end;

procedure TgaDoubleList.DeleteCurrent;
{:
procedure DeleteCurrent - deletes the item represented by the cursor from the
list.
}
begin
  if Eof or Bof then
    raise EgaLinkListError.Create(SNoCurrentItemForTheOperation);
  InternalDelete(Cursor);
end;

function TgaDoubleList.Extract(Item: Pointer): Pointer;
{:
function Extract - removes the item from the list, but with lnExtracted
notification rather than lnDeleted notification.
Item - a item to be deleted.
Returns: Item, if the item was found from the list.
Nil, if the item was not found from the list.
}
var
  tmpNode: PdllNode;
begin
  Result := nil;
  tmpNode := NodeOf(Item);
  if Assigned(tmpNode) then
  begin
    Result := Item;
    tmpNode^.dllnData := nil;
    InternalDelete(tmpNode);
    Notify(Result, lnExtracted);
  end;
end;

procedure TgaDoubleList.First;
{:
procedure First - sets the cursor to point to the first item in the list.
If the list is empty, the item will be the Tail item. After the call to the
First method, the BOF is always False (but Eof might be true, in the case of
empty list).
}
begin
  FCursor := Head^.dllnNext;
end;

procedure TgaDoubleList.FreeDataUserList;
{:
procedure FreeDataUserList - Notifies all data users that the master list is
about to be destroyed. Clears and frees the FDataUserList and
FActiveDataUserList.
}
var
  tmpNode: PdllNode;
begin
  if Assigned(FDataUserList) then
  begin
    tmpNode := FDataUserList.FHead^.dllnNext;
    while tmpNode <> FDataUserList.FTail do
    begin
      TgaSharedDoubleList(tmpNode^.dllnData).DataOwnerDestroyed;
      tmpNode := tmpNode^.dllnNext;
    end;
    FreeAndNil(FDataUserList);
    FreeAndnIl(FActiveDataUserList);
  end;
end;

function TgaDoubleList.GetBof: Boolean;
{:
GetBof is the read access method of the Bof property.
Results true if the cursor is positioned at the head (before the first) node
of the list.
}
begin
  Result := Head = Cursor;
end;

function TgaDoubleList.GetBookmark: TgaListBookmark;
{:
function GetBookmark - generates the bookamark for the current item in the list.
Returns: Bookmark that was generated.
}
begin
  Result := TgaDoubleListBookmark.Create(Self);
end;

function TgaDoubleList.GetCurrentItem: Pointer;
{:
GetCurrentItem is the read access method of the CurrentItem property.
There are no current item if the list is either at the Head or Tail node.
}
begin
  if Eof or Bof then
    raise EgaLinkListError.Create(SNoCurrentItemForTheOperation);
  Result := Cursor.dllnData;
end;

function TgaDoubleList.GetCursor: PdllNode;
{:
GetCursor is the read access method of the Cursor property.
It calls the CheckListCursor method which raises an exception, if the cursor is
invalid at the given moment
}
begin
  CheckListCursor;
  Result := FCursor;
end;

function TgaDoubleList.GetEof: Boolean;
{:
GetEof is the read access method of the Eof property.
Results true if the cursor is positioned at the tail (after the last) node
of the list.
}
begin
  Result := Tail = Cursor;
end;

function TgaDoubleList.GetFirstItem: Pointer;
{:
GetFirstItem is the read access method of the FirstItem property.
It resturns the first item (the one after the Head node) in the list.
If the list is empty, the exeception is raised
}
begin
  if IsEmpty then
    raise EgaLinkListError.Create(SNoItemsInTheList);
  Result := Head^.dllnNext.dllnData;
end;

function TgaDoubleList.GetIsEmpty: Boolean;
{:
GetIsEmpty is the read access method of the IsEmpty property.
A list is empty, if the next node after the Head is the Tail node.
}
begin
  Result := Head^.dllnNext = Tail;
end;

function TgaDoubleList.GetLastItem: Pointer;
{:
GetLastItem is the read access method of the LastItem property.
It returns the last item (the one before the Tail node) in the list.
If the list is empty, the exeception is raised.
}
begin
  if IsEmpty then
    raise EgaLinkListError.Create(SNoItemsInTheList);
  Result := Tail^.dllnPrev.dllnData;
end;

procedure TgaDoubleList.GotoBookmark(ABookmark: TgaListBookmark);
{:
procedure GotoBookmark - postions the cuurent item of the list to the item
represented by the ABookmark. The ABookmark must be obtained from the same list
as GotoBookamrk is called, or the lists must share the data (they must have
common DataOwner).
The CheckListBorders is called to ensure that the list represents valid set of
data.
}
var
  tmpBookmark: TgaDoubleListBookmark;
begin
  CheckListBorders;
  if not (ABookmark is TgaDoubleListBookmark) then
    raise EgaLinkListError.Create(SBookmarkClassInvalid);
  tmpBookmark := ABookmark as TgaDoubleListBookmark;
  if not tmpBookmark.IsValidFor(Self) then
    raise EgaLinkListError.Create(SInvalidBookmark);
  FCursor := tmpBookMark.Cursor;
end;

procedure TgaDoubleList.InitDoubleList;
{:
procedure InitDoubleList overrides inherited InitDoubleList.
It first calls inherited InitDaoubleList, after that the Cursor, Count and
Node  Revision ID are initialised.
}

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -