📄 galnklist.pas
字号:
begin
inherited InitDoubleList;
{ set the cursor to the head node and item count to the zero}
FCursor := FHead;
FCount := 0;
FNodeRevID := 0;
end;
procedure TgaDoubleList.InsertAfterCurrent(AItem: Pointer; MoveCursorToNewItem:
boolean);
{:
procedure InsertAfterCurrent - Inserts a item represented by the AItem after the
cursor. If MoveCursorToNewItem = True, then the cursor is moved to the item
inserted.
}
begin
if MoveCursorToNewItem then
FCursor := InternalInsert(AItem, Cursor)
else
InternalInsert(AItem, Cursor);
end;
function TgaDoubleList.IsCursorCorrect: Boolean;
{:
function IsCursorCorrect - Returns a boolean indicating whether the node
pointed by the cursor is inside the list or .
}
begin
Result := IsNodeInside(FCursor);
end;
procedure TgaDoubleList.Last;
{:
procedure Last - sets the cursor to point to the last item in the list.
If the list is empty, the item will be the Head item. After the call to the
last method, the EOF is always False (but Bof might be true, in the case of
empty list).
}
begin
FCursor := Tail^.dllnPrev;
end;
function TgaDoubleList.Locate(AItem: Pointer): Boolean;
{:
function Locate - postions cursor to the first node that contains AItem, if
one exists. If the node is found, it returns True. If not, it returns False.
}
var
tmpCursor: PdllNode;
begin
tmpCursor := NodeOf(AItem);
if Assigned(tmpCursor) then
begin
FCursor := tmpCursor;
Result := True;
end else
Result := False;
end;
procedure TgaDoubleList.Next;
{:
procedure Next moves the cursor to the next item on the list. If cursor is
already at the end of the list, it deos nothing.
}
begin
if not Eof then
FCursor := Cursor^.dllnNext;
end;
procedure TgaDoubleList.NotifyNodeChange(ANode: PdllNode; Action:
TgaNodeNotification);
{:
procedure NotifyNodeChange overrides inherited NotifyNodeChange calls inherited
NotifyNodeChange.
In addition, it corrects the item count of the list, changes cursor if required,
increments Node Revision ID and notifies Active mirroring lists about the
change.
}
var
tmpCursor: PdllNode;
tmpTail: PdllNode;
begin
inherited NotifyNodeChange(ANode, Action);
{ correct the list item count }
case Action of
nnAdded:
Inc(FCount);
nnDeleted:
Dec(FCount);
nnCleared:
FCount := 0;
end;
if Action in [nnAdded, nnDeleted] then
begin
{ if the Node, which is about to destroy, is current cursor then move cursor
to the next item }
if Assigned(FCursor) and (ANode = FCursor) then
FCursor := ANode^.dllnNext;
{ increment the Node Rev ID }
Inc(FNodeRevID);
{ Notify active mirror lists about the change... }
if Assigned(FActiveDataUserList) then
begin
tmpCursor := FActiveDataUserList.Head^.dllnNext;
tmpTail := FActiveDataUserList.Tail;
while tmpCursor <> tmpTail do
begin
TgaSharedDoubleList(tmpCursor^.dllnData).NotifyMasterChanged(ANode, Action);
tmpCursor := tmpCursor^.dllnNext;
end;
end;
end else begin
{ Reset Cursor }
FCursor := FHead;
{ Clear Node Rev ID }
FNodeRevID := 0;
{ Notify mirror lists about the clear }
if Assigned(FDataUserList) then
begin
tmpCursor := FDataUserList.Head^.dllnNext;
tmpTail := FDataUserList.Tail;
while tmpCursor <> tmpTail do
begin
TgaSharedDoubleList(tmpCursor^.dllnData).NotifyMasterChanged(ANode, Action);
tmpCursor := tmpCursor^.dllnNext;
end;
end;
end;
end;
procedure TgaDoubleList.Pack;
{:
procedure Pack - removes nil items from the list.
}
var
tmpCursor: PdllNode;
begin
tmpCursor := Head^.dllnNext;
while tmpCursor <> FTail do
begin
if tmpCursor^.dllnData = nil then
begin
tmpCursor := tmpCursor^.dllnNext;
InternalDelete(tmpCursor^.dllnPrev);
end else
tmpCursor := tmpCursor^.dllnNext;
end;
end;
procedure TgaDoubleList.Previous;
{:
procedure Previous moves the cursor to the previous item in the list.
If cursor is already at the beginning of the list, it deos nothing.
}
begin
if not Bof then
FCursor := FCursor^.dllnPrev;
end;
procedure TgaDoubleList.Remove(Item: Pointer);
{:
procedure Remove - removes the first copy of the Item from the list.
}
var
tmpNode: PdllNode;
begin
tmpNode := NodeOf(Item);
if Assigned(tmpNode) then
InternalDelete(tmpNode);
end;
procedure TgaDoubleList.RemoveActiveDataUser(ADataUser: TgaSharedDoubleList);
{:
procedure RemoveActiveDataUser - removes ADataUser from the NodeChangeNotify
list. This is called whet the ActiveDataShare := False in the mirror list.
If ADataUser is not foun from the list, this method deos nothing.
}
var
tmpNode: PdllNode;
begin
if Assigned(FActiveDataUserList) then
begin
tmpNode := FActiveDataUserList.NodeOf(ADataUser);
if Assigned(tmpNode) then
FActiveDataUserList.InternalDelete(tmpNode);
end;
end;
procedure TgaDoubleList.RemoveDataUser(ADataUser: TgaSharedDoubleList);
{:
procedure RemoveDataUser - removes ADataUser from destroy notify list.
Normally called when the mirror list is destroyed.
if ADataUser is not found in list, the method does nothing.
}
var
tmpNode: PdllNode;
begin
if Assigned(FDataUserList) then
begin
tmpNode := FDataUserList.NodeOf(ADataUser);
if Assigned(tmpNode) then
FDataUserList.InternalDelete(tmpNode);
end;
end;
procedure TgaDoubleList.SetCurrentItem(Value: Pointer);
{:
SetCurrentItem is the write access method of the CurrentItem property.
}
var
tmpItem: Pointer;
begin
if Eof or Bof then
raise EgaLinkListError.Create(SNoCurrentItemForTheOperation);
tmpItem := Cursor.dllnData;
if tmpItem <> Value then
begin
Cursor.dllnData := Value;
NotifyChange(tmpItem, Value);
end;
end;
procedure TgaDoubleList.SetFirstItem(Value: Pointer);
{:
SetFirstItem is the write access method of the FirstItem property.
It sets the first item (the one after the Head node) in the list.
If the list is empty, the exeception is raised.
}
var
tmpItem: Pointer;
begin
if IsEmpty then
raise EgaLinkListError.Create(SNoItemsInTheList);
tmpItem := Head^.dllnNext.dllnData;
if tmpItem <> Value then
begin
Head^.dllnNext.dllnData := Value;
NotifyChange(tmpItem, Value);
end;
end;
procedure TgaDoubleList.SetLastItem(Value: Pointer);
{:
SetLastItem is the write access method of the LastItem property.
It sets the last item (the one before the Tail node) in the list.
If the list is empty, the exeception is raised.
}
var
tmpItem: Pointer;
begin
if IsEmpty then
raise EgaLinkListError.Create(SNoItemsInTheList);
tmpItem := Tail^.dllnPrev.dllnData;
if tmpItem <> Value then
begin
Tail^.dllnPrev.dllnData := Value;
NotifyChange(tmpItem, Value);
end;
end;
{
***************************** TgaSharedDoubleList ******************************
}
constructor TgaSharedDoubleList.Create;
{:
Constructor Create overrides the inherited Create.
First the internal data structure is initialized to indicate that the list
itself is the owner of the data, then inherited Create is
called.
}
begin
FDataOwner := Self;
FIsDataOwner := True;
inherited Create;
end;
constructor TgaSharedDoubleList.CreateMirror(AMirroredList: TgaDoubleList);
{:
constructor CreateMirror - creates a "mirror" list for the AMirroredList. The
lists will have common dataowner (i.e. if Ythe AMirroredList is itself a mirror,
then the dataowner will be the dataowner of the AMirroredList). Note that the
DataIwner of TgaDoubleList is implicitly the list itself.
The contents of the list will be exactly the same as it is for AMirroredList -
if it has strict last or first item, a new mirror will have the same.
the starting/ening postions can be changed later trough the call to
SetStartPos/SetEndPos.
}
var
tmpActiveMirror: TgaSharedDoubleList;
begin
FHead := AMirroredList.Head;
FTail := AMirroredList.Tail;
if AMirroredList is TgaSharedDoubleList then
begin
tmpActiveMirror := TgaSharedDoubleList(AMirroredList);
FDataOwner := tmpActiveMirror.DataOwner;
FFirstNode := tmpActiveMirror.FFirstNode;
FLastNode := tmpActiveMirror.FLastNode;
end else
FDataOwner := AMirroredList;
DataOwner.AddDataUser(Self);
DataOwner.AddActiveDataUser(Self);
FActiveDataShare := True;
FIsDataOwner := False;
FNodeRevID := AMirroredList.NodeRevID;
FCursorNodeRev := DataOwner.NodeRevID;
inherited Create;
end;
destructor TgaSharedDoubleList.Destroy;
{:
Destructor Destroy overrides the inherited Destroy.
If the list is a mirroring list, then the list must be removed from the
(Active)DataUserList of the DataOwner. Also, the Head and Tail must be cleared
to avoid changing the master list.
Finally inherited Destroy is called.
}
begin
if not IsDataOwner then
begin
if Assigned(FDataOwner) then
begin
ActiveDataShare := False;
FDataOwner.RemoveDataUser(Self);
end;
FTail := nil;
FHead := nil;
FFirstNode := nil;
FLastNode := nil;
end;
inherited Destroy;
end;
procedure TgaSharedDoubleList.Add(Item: Pointer);
{:
procedure Add overrides inherited Add.
This method is overridden to allow the strict mirror list to grow, if the
Add method is called on this instance. To do that, the FirstNode and LastNode
are unbound, then inherited Add is called. After that, theese nodes are rebound,
if needed.
}
var
WasStrictLast: Boolean;
FirstNodeWasUnbound: Boolean;
begin
WasStrictLast := Assigned(FLastNode);
FLastNode := nil;
// Unbind the first node, if list is strictempty
FirstNodeWasUnbound := FFirstNode = FTail;
if FirstNodeWasUnbound then
FFirstNode := nil;
inherited Add(Item);
if WasStrictLast then
FLastNode := Tail^.dllnPrev;
if FirstNodeWasUnbound then
FFirstNode := Head^.dllnNext;
end;
procedure TgaSharedDoubleList.AddActiveDataUser(ADataUser: TgaSharedDoubleList);
{:
procedure AddActiveDataUser overrides inherited AddActiveDataUser.
If the list is not a Data Owner, then an exception is raised to indicate that
mirroring lists can't have data users.
}
begin
if not IsDataOwner then
raise EgaLinkListError.CreateFmt(SListIsNotDataOwner, [SCantAddActiveDataUser]);
inherited AddActiveDataUser(ADataUser);
end;
procedure TgaSharedDoubleList.AddDataUser(ADataUser: TgaSharedDoubleList);
{:
procedure AddDataUser overrides inherited AddDataUser calls
If the list is not a Data Owner, then an exception is raised to indicate that
mirroring lists can't have data users.
}
begin
if not IsDataOwner then
raise EgaLinkListError.CreateFmt(SListIsNotDataOwner, [SCantAddDataUser]);
inherited AddDataUser(ADataUser);
end;
procedure TgaSharedDoubleList.CheckListBorders;
{:
procedure CheckListBorders overrides inherited donothing
TgaSimpleDoubleList.CheckListBorders. For optimization, the call to inherited
CheckListBorders is omitted.
ValidateListBorders is called if required - the list is mirroring list and it
is not in the DataOwner's ActiveDataUser list (ActiveDataShare = False)
ValidateListBorders corrects Head and Tail nodes, if needed and possible.
If unrepairable error occures, an exception is raised.
}
begin
// call to inherited do-nothing method not required??
if not IsDataOwner then
if not ActiveDataShare then
ValidateListBorders;
end;
procedure TgaSharedDoubleList.CheckListCursor;
{:
procedure CheckListCursor overrides inherited donothing
TgaSimpleDoubleList.CheckListCursor. For optimization, the call to inherited
CheckListCursor is omitted.
If cursor is not inside the list, and exception is raised in ValidateCursor
method.
}
begin
// call to inherited do-nothing method not required??
if not IsDataOwner then
if (not ActiveDataShare) then
ValidateCursor(False);
end;
procedure TgaSharedDoubleList.Clear;
{:
procedure Clear overrides inherited Clear.
The inherited Clear is called only if the list is a owner of the data.
If not, the list is emptied item by item.
}
var
Temp: PdllNode;
tmpData: Pointer;
FFirstNodeWasBound, FLastNodeWasBound: Boolean;
begin
if IsDataOwner then
inherited Clear
else begin
if Assigned(FHead) then
begin
Temp := Head^.dllnNext;
FFirstNodeWasBound := Assigned(FFirstNode);
FFirstNode := nil;
FLastNodeWasBound := Assigned(FLastNode);
FLastNode := nil;
while (Temp <> FTail) do begin
FHead^.dllnNext := Temp^.dllnNext;
NotifyNodeChange(Temp, nnDeleted);
tmpData := Temp^.dllnData;
dnmFreeNode(Temp);
if Assigned(tmpData) then
Notify(tmpData, lnDeleted);
Temp := FHead^.dllnNext;
end;
FHead^.dllnNext := FTail;
FTail^.dllnPrev := FHead;
{ #Todo2 There will be conflict if the list has strict starting position
but floating end position - should it be kept empty or not }
if FFirstNodeWasBound then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -