mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-26 18:23:46 +02:00
4680 lines
126 KiB
PHP
4680 lines
126 KiB
PHP
{%MainUnit ../comctrls.pp}
|
|
|
|
{******************************************************************************
|
|
TTreeView
|
|
******************************************************************************
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the Lazarus Component Library (LCL) *
|
|
* *
|
|
* See the file COPYING.LCL, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
|
|
Abstract:
|
|
TTreeView for LCL
|
|
|
|
ToDo:
|
|
- Editing
|
|
- Columns
|
|
- create FTopLvlItems only on demand and update only if easy
|
|
}
|
|
|
|
|
|
{ $DEFINE TREEVIEW_DEBUG}
|
|
|
|
const
|
|
TTreeNodeStreamVersion : word = 1;
|
|
TVAutoHeightString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789|\()^';
|
|
MinNodeCapacity = 10;
|
|
|
|
// maximum scroll range
|
|
//MAX_SCROLL = 32767;
|
|
|
|
function CompareExpandedNodes(Data1, Data2: Pointer): integer;
|
|
var
|
|
Node1: TTreeNodeExpandedState;
|
|
Node2: TTreeNodeExpandedState;
|
|
begin
|
|
Node1:=TTreeNodeExpandedState(Data1);
|
|
Node2:=TTreeNodeExpandedState(Data2);
|
|
Result:=AnsiCompareText(Node1.NodeText,Node2.NodeText);
|
|
end;
|
|
|
|
function CompareTextWithExpandedNode(Key, Data: Pointer): integer;
|
|
var
|
|
NodeText: String;
|
|
Node: TTreeNodeExpandedState;
|
|
begin
|
|
NodeText:=String(Key);
|
|
Node:=TTreeNodeExpandedState(Data);
|
|
Result:=AnsiCompareText(NodeText,Node.NodeText);
|
|
end;
|
|
|
|
procedure TreeViewError(const Msg: string);
|
|
begin
|
|
raise ETreeViewError.Create(Msg);
|
|
end;
|
|
|
|
{procedure TreeViewErrorFmt(const Msg: string; Format: array of const);
|
|
begin
|
|
raise ETreeViewError.CreateFmt(Msg, Format);
|
|
end;}
|
|
|
|
procedure TreeNodeError(const Msg: string);
|
|
begin
|
|
raise ETreeNodeError.Create(Msg);
|
|
end;
|
|
|
|
procedure TreeNodeErrorFmt(const Msg: string; Format: array of const);
|
|
begin
|
|
raise ETreeNodeError.CreateFmt(Msg, Format);
|
|
end;
|
|
|
|
function IndexOfNodeAtTop(NodeArray: TTreeNodeArray; Count, y: integer): integer;
|
|
// NodeArray must be sorted via Top
|
|
// returns index of Node with Node.Top <= y < Node[+1].Top
|
|
var l, m, r: integer;
|
|
begin
|
|
if (Count=0) or (NodeArray=nil) then exit(-1);
|
|
l:=0;
|
|
r:=Count-1;
|
|
while (l<=r) do begin
|
|
m:=(l+r) shr 1;
|
|
//DebugLn(':0 [IndexOfNodeAtTop] m=',m,' y=',y,' ',NodeArray[m].Text,' NodeArray[m].Top=',NodeArray[m].Top,' NodeArray[m].BottomExpanded=',NodeArray[m].BottomExpanded);
|
|
if NodeArray[m].Top>y then
|
|
r:=m-1
|
|
else if NodeArray[m].BottomExpanded<=y then
|
|
l:=m+1
|
|
else
|
|
exit(m);
|
|
end;
|
|
Result:=-1;
|
|
end;
|
|
|
|
{ TTreeNodeExpandedState }
|
|
|
|
constructor TTreeNodeExpandedState.Create(FirstTreeNode: TTreeNode);
|
|
begin
|
|
CreateChildNodes(FirstTreeNode);
|
|
end;
|
|
|
|
constructor TTreeNodeExpandedState.Create(TreeView: TCustomTreeView);
|
|
begin
|
|
CreateChildNodes(TreeView.Items.GetFirstNode);
|
|
end;
|
|
|
|
destructor TTreeNodeExpandedState.Destroy;
|
|
begin
|
|
Clear;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TTreeNodeExpandedState.Clear;
|
|
begin
|
|
if Childs<>nil then begin
|
|
Childs.FreeAndClear;
|
|
FreeThenNil(Childs);
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNodeExpandedState.CreateChildNodes(FirstTreeNode: TTreeNode);
|
|
var
|
|
ChildNode: TTreeNode;
|
|
NewExpandedNode: TTreeNodeExpandedState;
|
|
begin
|
|
if (FirstTreeNode<>nil) and (FirstTreeNode.Parent<>nil) then
|
|
NodeText:=FirstTreeNode.Parent.Text
|
|
else
|
|
NodeText:='';
|
|
Clear;
|
|
ChildNode:=FirstTreeNode;
|
|
while ChildNode<>nil do begin
|
|
if ChildNode.Expanded then begin
|
|
if Childs=nil then Childs:=TAvgLvlTree.Create(@CompareExpandedNodes);
|
|
NewExpandedNode:=TTreeNodeExpandedState.Create(ChildNode.GetFirstChild);
|
|
Childs.Add(NewExpandedNode);
|
|
end;
|
|
ChildNode:=ChildNode.GetNextSibling;
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNodeExpandedState.Apply(FirstTreeNode: TTreeNode);
|
|
var
|
|
ChildNode: TTreeNode;
|
|
ANode: TAvgLvlTreeNode;
|
|
ChildNodeText: String;
|
|
begin
|
|
if Childs=nil then exit;
|
|
ChildNode:=FirstTreeNode;
|
|
while ChildNode<>nil do begin
|
|
ChildNodeText:=ChildNode.Text;
|
|
ANode:=Childs.FindKey(PChar(ChildNodeText),@CompareTextWithExpandedNode);
|
|
ChildNode.Expanded:=ANode<>nil;
|
|
if ANode<>nil then
|
|
TTreeNodeExpandedState(ANode.Data).Apply(ChildNode.GetFirstChild);
|
|
ChildNode:=ChildNode.GetNextSibling;
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNodeExpandedState.Apply(TreeView: TCustomTreeView);
|
|
begin
|
|
Apply(TreeView.Items.GetFirstNode);
|
|
end;
|
|
|
|
{ TTreeNode }
|
|
|
|
function TTreeNode.DefaultTreeViewSort(Node1, Node2: TTreeNode): Integer;
|
|
begin
|
|
if (Node1.TreeView<>nil) and Assigned(Node1.TreeView.OnCompare) then begin
|
|
Result:=0;
|
|
Node1.TreeView.OnCompare(Node1.TreeView,Node1, Node2, Result);
|
|
end else
|
|
Result := AnsiCompareStr(Node1.Text,Node2.Text);
|
|
end;
|
|
|
|
constructor TTreeNode.Create(AnOwner: TTreeNodes);
|
|
begin
|
|
inherited Create;
|
|
FOverlayIndex := -1;
|
|
FStateIndex := -1;
|
|
FStates := [];
|
|
FOwner := AnOwner;
|
|
FSubTreeCount:=1;
|
|
if Owner<>nil then inc(Owner.FCount);
|
|
end;
|
|
|
|
destructor TTreeNode.Destroy;
|
|
begin
|
|
{$IFDEF TREEVIEW_DEBUG}
|
|
DebugLn('[TTreeNode.Destroy] Self=',DbgS(Self),' Self.Text=',Text);
|
|
{$ENDIF}
|
|
FDeleting := True;
|
|
// delete childs
|
|
HasChildren := false;
|
|
// unbind all references
|
|
Unbind;
|
|
if Owner<>nil then begin
|
|
if Owner.Owner<>nil then
|
|
Owner.Owner.Delete(self);
|
|
dec(Owner.FCount);
|
|
end;
|
|
Data := nil;
|
|
// free data
|
|
if FItems<>nil then begin
|
|
FreeMem(FItems);
|
|
FItems:=nil;
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TTreeNode.GetHandle: THandle;
|
|
begin
|
|
if TreeView<>nil then
|
|
Result := TreeView.Handle
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TTreeNode.GetParentNodeOfAbsoluteLevel(
|
|
TheAbsoluteLevel: integer): TTreeNode;
|
|
var
|
|
i: integer;
|
|
l: LongInt;
|
|
begin
|
|
l:=Level;
|
|
if (TheAbsoluteLevel > l) or (TheAbsoluteLevel < 0) then
|
|
Result := nil
|
|
else
|
|
begin
|
|
Result := Self;
|
|
for i := TheAbsoluteLevel to l-1 do
|
|
Result := Result.Parent;
|
|
end;
|
|
end;
|
|
|
|
function TTreeNode.GetTreeNodes: TTreeNodes;
|
|
begin
|
|
if (Owner<>nil) and (Owner is TTreeNodes) then
|
|
Result:=TTreeNodes(Owner)
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TTreeNode.GetTreeView: TCustomTreeView;
|
|
begin
|
|
if Owner<>nil then
|
|
Result := Owner.Owner
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TTreeNode.GetTop: integer;
|
|
begin
|
|
if TreeView<>nil then
|
|
TreeView.UpdateAllTops;
|
|
Result:=FTop;
|
|
end;
|
|
|
|
function TTreeNode.HasAsParent(AValue: TTreeNode): Boolean;
|
|
begin
|
|
if AValue<>nil then begin
|
|
if Parent=nil then Result := False
|
|
else if Parent=AValue then Result := True
|
|
else Result := Parent.HasAsParent(AValue);
|
|
end
|
|
else Result := True;
|
|
end;
|
|
|
|
procedure TTreeNode.SetText(const S: string);
|
|
begin
|
|
if S=FText then exit;
|
|
FText := S;
|
|
if TreeView=nil then exit;
|
|
Include(TreeView.FStates,tvsMaxRightNeedsUpdate);
|
|
if (TreeView.SortType in [stText, stBoth]) and FInTree then begin
|
|
if (Parent <> nil) then Parent.AlphaSort
|
|
else TreeView.AlphaSort;
|
|
end;
|
|
Update;
|
|
end;
|
|
|
|
procedure TTreeNode.SetData(AValue: Pointer);
|
|
begin
|
|
if FData=AValue then exit;
|
|
FData := AValue;
|
|
if (TreeView<>nil)
|
|
and (TreeView.SortType in [stData, stBoth]) and Assigned(TreeView.OnCompare)
|
|
and (not Deleting) and FInTree then
|
|
begin
|
|
if Parent <> nil then
|
|
Parent.AlphaSort
|
|
else
|
|
TreeView.AlphaSort;
|
|
end;
|
|
end;
|
|
|
|
function TTreeNode.GetState(NodeState: TNodeState): Boolean;
|
|
begin
|
|
Result:=NodeState in FStates;
|
|
end;
|
|
|
|
procedure TTreeNode.SetHeight(AValue: integer);
|
|
begin
|
|
if AValue<0 then AValue:=0;
|
|
if AValue=FHeight then exit;
|
|
FHeight:=AValue;
|
|
if TreeView<>nil then
|
|
TreeView.FStates:=TreeView.FStates+[tvsScrollbarChanged,tvsTopsNeedsUpdate];
|
|
Update;
|
|
end;
|
|
|
|
procedure TTreeNode.SetImageIndex(AValue: integer);
|
|
begin
|
|
if FImageIndex=AValue then exit;
|
|
FImageIndex := AValue;
|
|
Update;
|
|
end;
|
|
|
|
procedure TTreeNode.SetSelectedIndex(AValue: Integer);
|
|
begin
|
|
if FSelectedIndex = AValue then exit;
|
|
FSelectedIndex := AValue;
|
|
Update;
|
|
end;
|
|
|
|
procedure TTreeNode.SetOverlayIndex(AValue: Integer);
|
|
begin
|
|
if FOverlayIndex = AValue then exit;
|
|
FOverlayIndex := AValue;
|
|
Update;
|
|
end;
|
|
|
|
procedure TTreeNode.SetStateIndex(AValue: Integer);
|
|
begin
|
|
if FStateIndex = AValue then exit;
|
|
FStateIndex := AValue;
|
|
Update;
|
|
end;
|
|
|
|
function TTreeNode.AreParentsExpanded: Boolean;
|
|
var ANode: TTreeNode;
|
|
begin
|
|
Result:=false;
|
|
ANode:=Parent;
|
|
while ANode<>nil do begin
|
|
if not ANode.Expanded then exit;
|
|
ANode:=ANode.Parent;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
procedure TTreeNode.BindToMultiSelected;
|
|
var
|
|
TheTreeNodes: TTreeNodes;
|
|
begin
|
|
TheTreeNodes:=TreeNodes;
|
|
if TheTreeNodes=nil then exit;
|
|
FNextMultiSelected:=TheTreeNodes.FFirstMultiSelected;
|
|
FPrevMultiSelected:=nil;
|
|
if FNextMultiSelected<>nil then
|
|
FNextMultiSelected.FPrevMultiSelected:=Self;
|
|
TheTreeNodes.FFirstMultiSelected:=Self;
|
|
end;
|
|
|
|
function TTreeNode.CompareCount(CompareMe: Integer): Boolean;
|
|
{var
|
|
ACount: integer;
|
|
Node: TTreeNode;}
|
|
Begin
|
|
Result:=(CompareMe=Count);
|
|
{
|
|
ACount := 0;
|
|
Result := False;
|
|
Node := GetFirstChild;
|
|
while Node <> nil do begin
|
|
Inc(ACount);
|
|
Node := Node.GetNextChild(Node);
|
|
if ACount > CompareMe then Exit;
|
|
end;
|
|
if ACount = CompareMe then Result := True;}
|
|
end;
|
|
|
|
function TTreeNode.DoCanExpand(ExpandIt: Boolean): Boolean;
|
|
begin
|
|
Result := False;
|
|
if (TreeView<>nil) and HasChildren then begin
|
|
if ExpandIt then
|
|
Result := TreeView.CanExpand(Self)
|
|
else
|
|
Result := TreeView.CanCollapse(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNode.DoExpand(ExpandIt: Boolean);
|
|
begin
|
|
//DebugLn('[TTreeNode.DoExpand] Self=',DbgS(Self),' Text=',Text,
|
|
//' HasChildren=',HasChildren,' ExpandIt=',ExpandIt,' Expanded=',Expanded);
|
|
if HasChildren and (Expanded<>ExpandIt) then begin
|
|
if (TreeView<>nil) then begin
|
|
if ExpandIt then
|
|
TreeView.Expand(Self)
|
|
else
|
|
TreeView.Collapse(Self);
|
|
end;
|
|
if ExpandIt then
|
|
Include(FStates,nsExpanded)
|
|
else begin
|
|
Exclude(FStates,nsExpanded);
|
|
if (not Owner.KeepCollapsedNodes) then begin
|
|
while GetLastChild<>nil do
|
|
GetLastChild.Free;
|
|
end;
|
|
end;
|
|
if TreeView<>nil then begin
|
|
TreeView.FStates:=(TreeView.FStates+[tvsTopsNeedsUpdate,
|
|
tvsTopItemNeedsUpdate,tvsBottomItemNeedsUpdate,
|
|
tvsScrollbarChanged,tvsMaxRightNeedsUpdate]);
|
|
TreeView.Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNode.ExpandItem(ExpandIt: Boolean; Recurse: Boolean);
|
|
var
|
|
//Flag: Integer;
|
|
ANode: TTreeNode;
|
|
begin
|
|
if Recurse then begin
|
|
ExpandItem(ExpandIt, False);
|
|
ANode := GetFirstChild;
|
|
while ANode<>nil do begin
|
|
ANode.ExpandItem(ExpandIt, true);
|
|
ANode := ANode.FNextBrother;
|
|
end;
|
|
end
|
|
else begin
|
|
if TreeView<>nil then
|
|
Include(TreeView.FStates,tvsManualNotify);
|
|
try
|
|
if DoCanExpand(ExpandIt) then
|
|
DoExpand(ExpandIt);
|
|
//if Flag <> 0 then TreeView_Expand(Handle, ItemId, Flag);
|
|
finally
|
|
if TreeView<>nil then
|
|
Exclude(TreeView.FStates,tvsManualNotify);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNode.Expand(Recurse: Boolean);
|
|
begin
|
|
ExpandItem(True, Recurse);
|
|
end;
|
|
|
|
procedure TTreeNode.ExpandParents;
|
|
var ANode: TTreeNode;
|
|
begin
|
|
ANode:=Parent;
|
|
while ANode<>nil do begin
|
|
ANode.Expanded:=true;
|
|
ANode:=ANode.Parent;
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNode.Collapse(Recurse: Boolean);
|
|
begin
|
|
ExpandItem(False, Recurse);
|
|
end;
|
|
|
|
function TTreeNode.GetExpanded: Boolean;
|
|
begin
|
|
Result := GetState(nsExpanded);
|
|
end;
|
|
|
|
procedure TTreeNode.SetExpanded(AValue: Boolean);
|
|
begin
|
|
if AValue=Expanded then exit;
|
|
if AValue then
|
|
Expand(False)
|
|
else
|
|
Collapse(False);
|
|
end;
|
|
|
|
function TTreeNode.GetSelected: Boolean;
|
|
begin
|
|
Result := GetState(nsSelected);
|
|
end;
|
|
|
|
procedure TTreeNode.SetSelected(AValue: Boolean);
|
|
begin
|
|
if AValue=GetSelected then exit;
|
|
if AValue then begin
|
|
Include(FStates,nsSelected);
|
|
if (TreeView<>nil) and (TreeView.Selected=nil) then begin
|
|
TreeView.Selected:=Self;
|
|
if TreeView.Selected<>Self then
|
|
Exclude(FStates,nsSelected);
|
|
end;
|
|
end else begin
|
|
Exclude(FStates,nsSelected);
|
|
if (TreeView<>nil) and (TreeView.Selected=Self) then begin
|
|
TreeView.Selected:=nil;
|
|
if TreeView.Selected=Self then
|
|
Include(FStates,nsSelected);
|
|
end;
|
|
end;
|
|
Update;
|
|
end;
|
|
|
|
function TTreeNode.GetCut: Boolean;
|
|
begin
|
|
Result := GetState(nsCut);
|
|
end;
|
|
|
|
procedure TTreeNode.SetCut(AValue: Boolean);
|
|
begin
|
|
if AValue=Cut then exit;
|
|
// ToDo
|
|
if AValue then
|
|
Include(FStates,nsCut)
|
|
else
|
|
Exclude(FStates,nsCut);
|
|
end;
|
|
|
|
function TTreeNode.GetDropTarget: Boolean;
|
|
begin
|
|
Result := GetState(nsDropHilited);
|
|
end;
|
|
|
|
procedure TTreeNode.SetDropTarget(AValue: Boolean);
|
|
begin
|
|
if AValue=GetDropTarget then exit;
|
|
if AValue then begin
|
|
Include(FStates,nsDropHilited);
|
|
if TreeView<>nil then
|
|
TreeView.FLastDropTarget:=Self;
|
|
end else begin
|
|
Exclude(FStates,nsDropHilited);
|
|
if TreeView<>nil then
|
|
TreeView.FLastDropTarget:=nil;
|
|
end;
|
|
{if Value then TreeView_SelectDropTarget(Handle, ItemId)
|
|
else if DropTarget then TreeView_SelectDropTarget(Handle, nil);}
|
|
end;
|
|
|
|
function TTreeNode.GetHasChildren: Boolean;
|
|
begin
|
|
Result := GetState(nsHasChildren);
|
|
end;
|
|
|
|
procedure TTreeNode.SetFocused(AValue: Boolean);
|
|
{var
|
|
Item: TTVItem;
|
|
Template: DWORD;}
|
|
begin
|
|
if AValue=GetFocused then exit;
|
|
// ToDo
|
|
if AValue then
|
|
Include(FStates,nsFocused)
|
|
else
|
|
Exclude(FStates,nsFocused);
|
|
{if Value then Template := DWORD(-1)
|
|
else Template := 0;
|
|
with Item do
|
|
begin
|
|
mask := TVIF_STATE;
|
|
hItem := ItemId;
|
|
stateMask := TVIS_FOCUSED;
|
|
state := stateMask and Template;
|
|
end;
|
|
TreeView_SetItem(Handle, Item);}
|
|
Update;
|
|
end;
|
|
|
|
function TTreeNode.Bottom: integer;
|
|
begin
|
|
Result:=Top+Height;
|
|
end;
|
|
|
|
function TTreeNode.BottomExpanded: integer;
|
|
begin
|
|
if GetNextSibling<>nil then
|
|
Result:=GetNextSibling.Top
|
|
else if GetLastChild<>nil then
|
|
Result:=GetLastChild.BottomExpanded
|
|
else
|
|
Result:=Bottom;
|
|
end;
|
|
|
|
function TTreeNode.GetFocused: Boolean;
|
|
begin
|
|
Result := GetState(nsFocused);
|
|
end;
|
|
|
|
procedure TTreeNode.SetHasChildren(AValue: Boolean);
|
|
//var Item: TTVItem;
|
|
begin
|
|
if AValue=HasChildren then exit;
|
|
//DebugLn('[TTreeNode.SetHasChildren] Self=',DbgS(Self),' Self.Text=',Text,' AValue=',AValue);
|
|
if AValue then
|
|
Include(FStates,nsHasChildren)
|
|
else begin
|
|
while GetLastChild<>nil do
|
|
GetLastChild.Free;
|
|
Exclude(FStates,nsHasChildren)
|
|
end;
|
|
{ Delphi:
|
|
with Item do
|
|
begin
|
|
mask := TVIF_CHILDREN;
|
|
hItem := ItemId;
|
|
cChildren := Ord(Value);
|
|
end;
|
|
TreeView_SetItem(Handle, Item);
|
|
}
|
|
Update;
|
|
end;
|
|
|
|
function TTreeNode.GetNextSibling: TTreeNode;
|
|
begin
|
|
Result:=FNextBrother;
|
|
end;
|
|
|
|
function TTreeNode.GetPrevSibling: TTreeNode;
|
|
begin
|
|
Result:=FPrevBrother;
|
|
end;
|
|
|
|
function TTreeNode.GetNextVisible: TTreeNode;
|
|
begin
|
|
if Expanded and (GetFirstChild<>nil) then
|
|
Result:=GetFirstChild
|
|
else begin
|
|
Result:=Self;
|
|
while (Result<>nil) and (Result.GetNextSibling=nil) do
|
|
Result:=Result.Parent;
|
|
if Result<>nil then Result:=Result.GetNextSibling;
|
|
end;
|
|
if (Result<>nil) and (not Result.IsVisible) then
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TTreeNode.GetPrevVisible: TTreeNode;
|
|
var
|
|
ANode: TTreeNode;
|
|
begin
|
|
Result:=GetPrevSibling;
|
|
if Result <> nil then begin
|
|
while Result.Expanded do begin
|
|
ANode:=Result.GetLastChild;
|
|
if ANode=nil then break;
|
|
Result:=ANode;
|
|
end;
|
|
end else
|
|
Result := Parent;
|
|
if (Result<>nil) and (TreeView<>nil) and (not TreeView.IsNodeVisible(Result))
|
|
then
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TTreeNode.GetPrevExpanded: TTreeNode;
|
|
var
|
|
ANode: TTreeNode;
|
|
begin
|
|
Result:=GetPrevSibling;
|
|
if Result <> nil then begin
|
|
while Result.Expanded do begin
|
|
ANode:=Result.GetLastChild;
|
|
if ANode=nil then break;
|
|
Result:=ANode;
|
|
end;
|
|
end else
|
|
Result := Parent;
|
|
end;
|
|
|
|
function TTreeNode.GetNextChild(AValue: TTreeNode): TTreeNode;
|
|
begin
|
|
if AValue <> nil then
|
|
Result := AValue.GetNextSibling
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TTreeNode.GetNextExpanded: TTreeNode;
|
|
begin
|
|
if Expanded and (GetFirstChild<>nil) then
|
|
Result:=GetFirstChild
|
|
else begin
|
|
Result:=Self;
|
|
while (Result<>nil) and (Result.GetNextSibling=nil) do
|
|
Result:=Result.Parent;
|
|
if Result<>nil then Result:=Result.GetNextSibling;
|
|
end;
|
|
end;
|
|
|
|
function TTreeNode.GetNextMultiSelected: TTreeNode;
|
|
begin
|
|
Result:=FNextMultiSelected;
|
|
end;
|
|
|
|
function TTreeNode.GetPrevChild(AValue: TTreeNode): TTreeNode;
|
|
begin
|
|
if AValue <> nil then
|
|
Result := AValue.GetPrevSibling
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TTreeNode.GetPrevMultiSelected: TTreeNode;
|
|
begin
|
|
Result:=FPrevMultiSelected;
|
|
end;
|
|
|
|
function TTreeNode.GetFirstChild: TTreeNode;
|
|
begin
|
|
if Count>0 then
|
|
Result:=FItems[0]
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TTreeNode.GetLastSibling: TTreeNode;
|
|
begin
|
|
if Parent<>nil then
|
|
Result:=Parent.GetLastChild
|
|
else begin
|
|
Result:=Self;
|
|
while Result.FNextBrother<>nil do
|
|
Result:=Result.FNextBrother;
|
|
end;
|
|
end;
|
|
|
|
function TTreeNode.GetLastChild: TTreeNode;
|
|
begin
|
|
if Count>0 then
|
|
Result:=FItems[Count-1]
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TTreeNode.GetLastSubChild: TTreeNode;
|
|
var Node: TTreeNode;
|
|
begin
|
|
Result:=GetLastChild;
|
|
if Result<>nil then begin
|
|
Node:=Result.GetLastSubChild;
|
|
if Node<>nil then
|
|
Result:=Node;
|
|
end;
|
|
end;
|
|
|
|
function TTreeNode.GetNext: TTreeNode;
|
|
{var
|
|
NodeID, ParentID: HTreeItem;
|
|
Handle: HWND;}
|
|
begin
|
|
Result:=GetFirstChild;
|
|
if Result=nil then begin
|
|
// no childs, search next
|
|
Result:=Self;
|
|
while (Result<>nil) and (Result.FNextBrother=nil) do
|
|
Result:=Result.Parent;
|
|
if Result<>nil then Result:=Result.FNextBrother;
|
|
end;
|
|
{Handle := FOwner.Handle;
|
|
NodeID := TreeView_GetChild(Handle, ItemId);
|
|
if NodeID = nil then NodeID := TreeView_GetNextSibling(Handle, ItemId);
|
|
ParentID := ItemId;
|
|
while (NodeID = nil) and (ParentID <> nil) do
|
|
begin
|
|
ParentID := TreeView_GetParent(Handle, ParentID);
|
|
NodeID := TreeView_GetNextSibling(Handle, ParentID);
|
|
end;
|
|
Result := FOwner.GetNode(NodeID);}
|
|
end;
|
|
|
|
function TTreeNode.GetPrev: TTreeNode;
|
|
var
|
|
ANode: TTreeNode;
|
|
begin
|
|
Result := GetPrevSibling;
|
|
if Result <> nil then begin
|
|
ANode := Result;
|
|
repeat
|
|
Result := ANode;
|
|
ANode := Result.GetLastChild;
|
|
until ANode = nil;
|
|
end else
|
|
Result := Parent;
|
|
end;
|
|
|
|
function TTreeNode.GetAbsoluteIndex: Integer;
|
|
// - first node has index 0
|
|
// - the first child of a node has an index one bigger than its parent
|
|
// - a node without childs has an index one bigger than its previous brother
|
|
var
|
|
ANode: TTreeNode;
|
|
begin
|
|
Result:=-1;
|
|
ANode:=Self;
|
|
repeat
|
|
inc(Result);
|
|
while ANode.FPrevBrother<>nil do begin
|
|
ANode:=ANode.FPrevBrother;
|
|
inc(Result,ANode.FSubTreeCount);
|
|
end;
|
|
ANode:=ANode.Parent;
|
|
until ANode=nil;
|
|
end;
|
|
|
|
function TTreeNode.GetHeight: integer;
|
|
begin
|
|
if FHeight<=0 then begin
|
|
if TreeView<>nil then
|
|
Result:=TreeView.FDefItemHeight
|
|
else
|
|
Result:=20;
|
|
end else
|
|
Result:=FHeight;
|
|
end;
|
|
|
|
function TTreeNode.GetIndex: Integer;
|
|
// returns number of previous siblings (nodes on same lvl with same parent)
|
|
var
|
|
ANode: TTreeNode;
|
|
begin
|
|
// many algorithms uses the last sibling, so we check that first for speed
|
|
if (Parent<>nil) and (Parent[Parent.Count-1]=Self) then begin
|
|
Result:=Parent.Count-1;
|
|
exit;
|
|
end;
|
|
// count previous siblings
|
|
Result := -1;
|
|
ANode := Self;
|
|
while ANode <> nil do begin
|
|
Inc(Result);
|
|
ANode := ANode.GetPrevSibling;
|
|
end;
|
|
end;
|
|
|
|
function TTreeNode.GetItems(AnIndex: Integer): TTreeNode;
|
|
begin
|
|
if (AnIndex<0) or (AnIndex>=Count) then
|
|
TreeNodeErrorFmt(rsIndexOutOfBounds,[ClassName, AnIndex, Count]);
|
|
Result:=FItems[AnIndex];
|
|
{Result := GetFirstChild;
|
|
while (Result <> nil) and (Index > 0) do
|
|
begin
|
|
Result := GetNextChild(Result);
|
|
Dec(Index);
|
|
end;
|
|
if Result = nil then TreeViewError(SListIndexError);}
|
|
end;
|
|
|
|
procedure TTreeNode.SetItems(AnIndex: Integer; AValue: TTreeNode);
|
|
begin
|
|
if (AnIndex<0) or (AnIndex>=Count) then
|
|
TreeNodeErrorFmt(rsIndexOutOfBounds, [ClassName, AnIndex, Count]);
|
|
Items[AnIndex].Assign(AValue);
|
|
end;
|
|
|
|
procedure TTreeNode.SetMultiSelected(const AValue: Boolean);
|
|
begin
|
|
if AValue=GetMultiSelected then exit;
|
|
if AValue then begin
|
|
if (Treeview<>nil) and (not (tvoAllowMultiselect in TreeView.Options)) then
|
|
exit;
|
|
Include(FStates,nsMultiSelected);
|
|
if TreeNodes<>nil then BindToMultiSelected;
|
|
end else begin
|
|
Exclude(FStates,nsMultiSelected);
|
|
if TreeNodes<>nil then UnbindFromMultiSelected;
|
|
end;
|
|
if TreeView<>nil then TreeView.InternalSelectionChanged;
|
|
Update;
|
|
end;
|
|
|
|
function TTreeNode.IndexOf(AValue: TTreeNode): Integer;
|
|
begin
|
|
if AValue=nil then begin
|
|
Result:=-1;
|
|
exit;
|
|
end;
|
|
Result:=Count-1;
|
|
while Result>=0 do begin
|
|
if FItems[Result]=AValue then exit;
|
|
dec(Result);
|
|
end;
|
|
end;
|
|
|
|
function TTreeNode.IndexOfText(const NodeText: string): Integer;
|
|
begin
|
|
Result:=Count-1;
|
|
while Result>=0 do begin
|
|
if FItems[Result].Text=NodeText then exit;
|
|
dec(Result);
|
|
end;
|
|
end;
|
|
|
|
function TTreeNode.FindNode(const NodeText: string): TTreeNode;
|
|
begin
|
|
Result:=GetFirstChild;
|
|
while (Result<>nil) and (Result.Text<>NodeText) do
|
|
Result:=Result.GetNextSibling;
|
|
end;
|
|
|
|
function TTreeNode.GetCount: Integer;
|
|
begin
|
|
Result:=FCount;
|
|
end;
|
|
|
|
procedure TTreeNode.EndEdit(Cancel: Boolean);
|
|
begin
|
|
// ToDo:
|
|
//TreeView_EndEditLabelNow(Handle, Cancel);
|
|
if Cancel then begin
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNode.Unbind;
|
|
// unbind from parent and neighbor siblings, but not from owner
|
|
var OldIndex, i: integer;
|
|
HigherNode: TTreeNode;
|
|
TheTreeView: TCustomTreeView;
|
|
begin
|
|
{$IFDEF TREEVIEW_DEBUG}
|
|
DebugLn('[TTreeNode.Unbind] Self=',DbgS(Self),' Self.Text=',Text);
|
|
{$ENDIF}
|
|
// remove single select
|
|
Selected:=false;
|
|
// invalidate caches of TreeView and if root item, remove from TreeView.Items
|
|
if Owner<>nil then begin
|
|
Owner.ClearCache;
|
|
if FParent=nil then
|
|
Owner.MoveTopLvlNode(Owner.IndexOfTopLvlItem(Self),-1,Self);
|
|
TheTreeView:=Owner.Owner;
|
|
if TheTreeView<>nil then begin
|
|
TheTreeView.FStates:=TheTreeView.FStates+[tvsMaxRightNeedsUpdate,
|
|
tvsTopsNeedsUpdate,tvsTopItemNeedsUpdate,tvsBottomItemNeedsUpdate];
|
|
if TheTreeView.FLastDropTarget=Self then
|
|
TheTreeView.FLastDropTarget:=nil;
|
|
if TheTreeView.FInsertMarkNode=Self then
|
|
TheTreeView.FInsertMarkNode:=nil;
|
|
end;
|
|
end;
|
|
// unselect (multi)
|
|
UnbindFromMultiSelected;
|
|
// remove from sibling list
|
|
if FPrevBrother<>nil then FPrevBrother.FNextBrother:=FNextBrother;
|
|
if FNextBrother<>nil then FNextBrother.FPrevBrother:=FPrevBrother;
|
|
FPrevBrother:=nil;
|
|
FNextBrother:=nil;
|
|
// remove from parent
|
|
if FParent<>nil then begin
|
|
// update all FSubTreeCount
|
|
HigherNode:=FParent;
|
|
while HigherNode<>nil do begin
|
|
dec(HigherNode.FSubTreeCount,FSubTreeCount);
|
|
HigherNode:=HigherNode.Parent;
|
|
end;
|
|
//if TreeNodes<>nil then Dec(TreeNodes.FCount,FSubTreeCount);
|
|
// remove from parents list
|
|
OldIndex:=FParent.FCount-1;
|
|
while (OldIndex>=0) and (FParent.FItems[OldIndex]<>Self) do
|
|
dec(OldIndex);
|
|
if OldIndex<0 then
|
|
RaiseGDBException('');
|
|
for i:=OldIndex to FParent.FCount-2 do
|
|
FParent.FItems[i]:=FParent.FItems[i+1];
|
|
dec(FParent.FCount);
|
|
if (FParent.FCapacity>15) and (FParent.FCount<(FParent.FCapacity shr 2))
|
|
then begin
|
|
// shrink FParent.FItems
|
|
FParent.FCapacity:=FParent.FCapacity shr 1;
|
|
ReAllocMem(FParent.FItems,SizeOf(Pointer)*FParent.FCapacity);
|
|
end;
|
|
if FParent.Count=0 then begin
|
|
FParent.Expanded:=false;
|
|
FParent.HasChildren:=false;
|
|
end;
|
|
FParent:=nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNode.UnbindFromMultiSelected;
|
|
var
|
|
TheTreeNodes: TTreeNodes;
|
|
begin
|
|
TheTreeNodes:=TreeNodes;
|
|
if TheTreeNodes=nil then exit;
|
|
if TheTreeNodes.FFirstMultiSelected=Self then
|
|
TheTreeNodes.FFirstMultiSelected:=FNextMultiSelected;
|
|
if FNextMultiSelected<>nil then
|
|
FNextMultiSelected.FPrevMultiSelected:=FPrevMultiSelected;
|
|
if FPrevMultiSelected<>nil then
|
|
FPrevMultiSelected.FNextMultiSelected:=FNextMultiSelected;
|
|
FNextMultiSelected:=nil;
|
|
FPrevMultiSelected:=nil;
|
|
end;
|
|
|
|
procedure TTreeNode.InternalMove(ANode: TTreeNode;
|
|
AddMode: TAddMode);
|
|
{
|
|
TAddMode = (taAddFirst, taAdd, taInsert);
|
|
|
|
taAdd: add Self as last child of ANode
|
|
taAddFirst: add Self as first child of ANode
|
|
taInsert: add Self in front of ANode
|
|
}
|
|
var HigherNode: TTreeNode;
|
|
NewIndex, NewParentItemSize, i: integer;
|
|
begin
|
|
{$IFDEF TREEVIEW_DEBUG}
|
|
DbgOut('[TTreeNode.InternalMove] Self=',DbgS(Self),' Self.Text=',Text
|
|
,' ANode=',ANode<>nil,' AddMode=',AddModeNames[AddMode]);
|
|
if ANode<>nil then DbgOut(' ANode.Text=',ANode.Text);
|
|
DebugLn('');
|
|
{$ENDIF}
|
|
Unbind;
|
|
// set parent
|
|
if AddMode in [taAdd, taAddFirst] then
|
|
FParent:=ANode
|
|
else begin // taInsert
|
|
if (ANode=nil) then
|
|
TreeNodeError('TTreeNode.InternalMove AddMode=taInsert but ANode=nil');
|
|
FParent:=ANode.Parent;
|
|
FPrevBrother:=ANode.FPrevBrother;
|
|
FNextBrother:=ANode;
|
|
end;
|
|
if FParent<>nil then begin
|
|
FParent.HasChildren:=true;
|
|
if (FParent.FCount=FParent.FCapacity) then begin
|
|
// grow FParent.FItems
|
|
if FParent.FCapacity=0 then
|
|
FParent.FCapacity:=5
|
|
else
|
|
FParent.FCapacity:=FParent.FCapacity shl 1;
|
|
NewParentItemSize:=SizeOf(Pointer)*FParent.FCapacity;
|
|
if FParent.FItems=nil then
|
|
GetMem(FParent.FItems,NewParentItemSize)
|
|
else
|
|
ReAllocMem(FParent.FItems,NewParentItemSize);
|
|
end;
|
|
inc(FParent.FCount);
|
|
// calculate new Index
|
|
case AddMode of
|
|
taAdd: NewIndex:=FParent.Count-1;
|
|
taAddFirst: NewIndex:=0;
|
|
else
|
|
// taInsert
|
|
NewIndex:=ANode.Index;
|
|
end;
|
|
// move next siblings
|
|
for i:=FParent.FCount-1 downto NewIndex+1 do
|
|
FParent.FItems[i]:=FParent.FItems[i-1];
|
|
// insert this node to parent's items
|
|
FParent.FItems[NewIndex]:=Self;
|
|
// set Next and Prev sibling
|
|
if NewIndex>0 then
|
|
FPrevBrother:=FParent.FItems[NewIndex-1]
|
|
else
|
|
FPrevBrother:=nil;
|
|
if NewIndex<FParent.Count-1 then
|
|
FNextBrother:=FParent.FItems[NewIndex+1]
|
|
else
|
|
FNextBrother:=nil;
|
|
// update total node count of all parents
|
|
HigherNode:=FParent;
|
|
while HigherNode<>nil do begin
|
|
inc(HigherNode.FSubTreeCount,FSubTreeCount);
|
|
HigherNode:=HigherNode.Parent;
|
|
end;
|
|
//if TreeNodes<>nil then inc(TreeNodes.FCount,FSubTreeCount);
|
|
end else begin
|
|
// add as top level node
|
|
case AddMode of
|
|
taAdd:
|
|
begin
|
|
// add as last top level node
|
|
if Owner<>nil then begin
|
|
FPrevBrother:=Owner.GetLastNode;
|
|
Owner.MoveTopLvlNode(-1,Owner.FTopLvlCount,Self);
|
|
end;
|
|
end;
|
|
taAddFirst:
|
|
begin
|
|
// add as first top level node = root node
|
|
if Owner<>nil then begin
|
|
FNextBrother:=Owner.GetFirstNode;
|
|
Owner.MoveTopLvlNode(-1,0,Self);
|
|
end;
|
|
end;
|
|
taInsert:
|
|
begin
|
|
// insert node in front of ANode
|
|
//DebugLn('[TTreeNode.InternalMove] ANode.Index=',ANode.Index,' ANode=',DbgS(ANode));
|
|
FNextBrother:=ANode;
|
|
FPrevBrother:=ANode.GetPrevSibling;
|
|
if Owner<>nil then begin
|
|
Owner.MoveTopLvlNode(-1,ANode.Index,Self);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
// connect Next and Prev sibling
|
|
if FPrevBrother<>nil then FPrevBrother.FNextBrother:=Self;
|
|
if FNextBrother<>nil then FNextBrother.FPrevBrother:=Self;
|
|
if Owner.Owner<>nil then
|
|
Owner.Owner.FStates:=Owner.Owner.FStates+[tvsMaxRightNeedsUpdate,
|
|
tvsTopsNeedsUpdate,tvsTopItemNeedsUpdate,tvsBottomItemNeedsUpdate];
|
|
|
|
{$IFDEF TREEVIEW_DEBUG}
|
|
DbgOut('[TTreeNode.InternalMove] END Self=',DbgS(Self),' Self.Text=',Text
|
|
,' ANode=',DbgS(ANode<>nil),' AddMode=',AddModeNames[AddMode]);
|
|
if ANode<>nil then DbgOut(' ANode.Text=',ANode.Text);
|
|
DebugLn('');
|
|
{$ENDIF}
|
|
|
|
{var
|
|
I: Integer;
|
|
NodeId: HTreeItem;
|
|
TreeViewItem: TTVItem;
|
|
Children: Boolean;
|
|
IsSelected: Boolean;
|
|
begin
|
|
Owner.ClearCache;
|
|
if (AddMode = taInsert) and (Node <> nil) then
|
|
NodeId := Node.ItemId else
|
|
NodeId := nil;
|
|
Children := HasChildren;
|
|
IsSelected := Selected;
|
|
if (Parent <> nil) and (Parent.CompareCount(1)) then
|
|
begin
|
|
Parent.Expanded := False;
|
|
Parent.HasChildren := False;
|
|
end;
|
|
with TreeViewItem do
|
|
begin
|
|
mask := TVIF_PARAM;
|
|
hItem := ItemId;
|
|
lParam := 0;
|
|
end;
|
|
TreeView_SetItem(Handle, TreeViewItem);
|
|
with Owner do
|
|
HItem := AddItem(HItem, NodeId, CreateItem(Self), AddMode);
|
|
if HItem = nil then
|
|
raise EOutOfResources.Create(sInsertError);
|
|
for I := Count - 1 downto 0 do
|
|
Item[I].InternalMove(Self, nil, HItem, taAddFirst);
|
|
TreeView_DeleteItem(Handle, ItemId);
|
|
FItemId := HItem;
|
|
Assign(Self);
|
|
HasChildren := Children;
|
|
Selected := IsSelected;}
|
|
end;
|
|
|
|
procedure TTreeNode.MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode);
|
|
{
|
|
TNodeAttachMode = (naAdd, naAddFirst, naAddChild, naAddChildFirst, naInsert);
|
|
|
|
naAdd: add as last sibling of Destination
|
|
naAddFirst: add as first sibling of Destnation
|
|
naAddChild: add as last child of Destination
|
|
naAddChildFirst: add as first child of Destination
|
|
naInsert: insert in front of Destination
|
|
naInsertBehind: insert behind Destination
|
|
}
|
|
var
|
|
AddMode: TAddMode;
|
|
//ANode: TTreeNode;
|
|
//HItem: HTreeItem;
|
|
OldOnChanging: TTVChangingEvent;
|
|
OldOnChange: TTVChangedEvent;
|
|
begin
|
|
if (Destination=nil)
|
|
and (Mode in [naAddChild,naAddChildFirst,naInsert,naInsertBehind]) then
|
|
TreeNodeError('TTreeNode.MoveTo Destination=nil');
|
|
if Mode=naInsertBehind then begin
|
|
// convert naInsertBehind
|
|
if Destination.GetNextSibling=nil then begin
|
|
Mode:=naAdd;
|
|
end else begin
|
|
Mode:=naInsert;
|
|
Destination:=Destination.GetNextSibling;
|
|
end;
|
|
end;
|
|
if (Destination = nil) or not Destination.HasAsParent(Self) then begin
|
|
OldOnChanging := TreeView.OnChanging;
|
|
OldOnChange := TreeView.OnChange;
|
|
TreeView.OnChanging := nil;
|
|
TreeView.OnChange := nil;
|
|
try
|
|
if (Destination <> nil) and (Mode in [naAdd, naAddFirst]) then
|
|
Destination := Destination.Parent;
|
|
case Mode of
|
|
naAdd,
|
|
naAddChild: AddMode := taAdd;
|
|
naAddFirst,
|
|
naAddChildFirst: AddMode := taAddFirst;
|
|
naInsert: AddMode := taInsert;
|
|
else
|
|
AddMode:=taAdd;
|
|
end;
|
|
{if ANode <> nil then
|
|
HItem := ANode.ItemId else
|
|
HItem := nil;}
|
|
if (Destination <> Self) then
|
|
InternalMove(Destination, AddMode);
|
|
if Parent <> nil then
|
|
Parent.Expanded := True;
|
|
finally
|
|
TreeView.OnChanging := OldOnChanging;
|
|
TreeView.OnChange := OldOnChange;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNode.MultiSelectGroup;
|
|
var
|
|
FirstNode, LastNode, ANode: TTreeNode;
|
|
begin
|
|
if (TreeView<>nil) and (not (tvoAllowMultiselect in TreeView.Options)) then
|
|
exit;
|
|
if (TreeView<>nil) then TreeView.LockSelectionChangeEvent;
|
|
FirstNode:=GetPrevSibling;
|
|
while (FirstNode<>nil) and (not FirstNode.MultiSelected) do
|
|
FirstNode:=FirstNode.GetPrevSibling;
|
|
if FirstNode=nil then FirstNode:=Self;
|
|
LastNode:=GetNextSibling;
|
|
while (LastNode<>nil) and (not LastNode.MultiSelected) do
|
|
LastNode:=LastNode.GetNextSibling;
|
|
if LastNode=nil then LastNode:=Self;
|
|
ANode:=FirstNode;
|
|
while ANode<>nil do begin
|
|
ANode.MultiSelected:=true;
|
|
if ANode=LastNode then break;
|
|
ANode:=ANode.GetNextSibling;
|
|
end;
|
|
if (TreeView<>nil) then TreeView.UnlockSelectionChangeEvent;
|
|
end;
|
|
|
|
procedure TTreeNode.MakeVisible;
|
|
begin
|
|
if TreeView<>nil then
|
|
TreeView.EnsureNodeIsVisible(Self)
|
|
else
|
|
ExpandParents;
|
|
end;
|
|
|
|
function TTreeNode.GetLevel: Integer;
|
|
// root is on level 0
|
|
var
|
|
ANode: TTreeNode;
|
|
begin
|
|
Result := 0;
|
|
ANode := Parent;
|
|
while ANode <> nil do begin
|
|
Inc(Result);
|
|
ANode := ANode.Parent;
|
|
end;
|
|
end;
|
|
|
|
function TTreeNode.GetMultiSelected: Boolean;
|
|
begin
|
|
Result := GetState(nsMultiSelected);
|
|
end;
|
|
|
|
function TTreeNode.IsNodeVisible: Boolean;
|
|
begin
|
|
if TreeView<>nil then
|
|
Result:=TreeView.IsNodeVisible(Self)
|
|
else
|
|
Result:=AreParentsExpanded;
|
|
end;
|
|
|
|
function TTreeNode.IsNodeHeightFullVisible: Boolean;
|
|
begin
|
|
if TreeView<>nil then
|
|
Result:=TreeView.IsNodeHeightFullVisible(Self)
|
|
else
|
|
Result:=AreParentsExpanded;
|
|
end;
|
|
|
|
procedure TTreeNode.Update;
|
|
begin
|
|
if (TreeView<>nil) and (not (csLoading in TreeView.ComponentState)) then
|
|
TreeView.Invalidate;
|
|
end;
|
|
|
|
function TTreeNode.EditText: Boolean;
|
|
begin
|
|
// ToDo:
|
|
Result:=false;
|
|
//Result := TreeView_EditLabel(Handle, ItemId) <> 0;
|
|
end;
|
|
|
|
function TTreeNode.DisplayRect(TextOnly: Boolean): TRect;
|
|
begin
|
|
FillChar(Result, SizeOf(Result), 0);
|
|
if TreeView<>nil then begin
|
|
Result.Left:=TreeView.BorderWidth;
|
|
Result.Top:=Top-TreeView.ScrolledTop+TreeView.BorderWidth;
|
|
Result.Right:=TreeView.ClientWidth-TreeView.BorderWidth;
|
|
Result.Bottom:=Result.Top+Height;
|
|
if TextOnly then begin
|
|
Result.Left:=DisplayTextLeft;
|
|
if Result.Left>Result.Right then
|
|
Result.Left:=Result.Right;
|
|
Result.Right:=DisplayTextRight;
|
|
end;
|
|
//TreeView_GetItemRect(Handle, ItemId, Result, TextOnly);
|
|
end;
|
|
end;
|
|
|
|
function TTreeNode.DisplayExpandSignLeft: integer;
|
|
begin
|
|
Result:=0;
|
|
if TreeView<>nil then begin
|
|
inc(Result,TreeView.Indent*Level+TreeView.BorderWidth);
|
|
end;
|
|
end;
|
|
|
|
function TTreeNode.DisplayExpandSignRect: TRect;
|
|
begin
|
|
FillChar(Result, SizeOf(Result), 0);
|
|
if TreeView<>nil then begin
|
|
Result.Left:=DisplayExpandSignLeft;
|
|
Result.Top:=Top;
|
|
Result.Right:=Result.Left+TreeView.Indent;
|
|
Result.Bottom:=Top+Height;
|
|
end;
|
|
end;
|
|
|
|
function TTreeNode.DisplayExpandSignRight: integer;
|
|
begin
|
|
Result:=DisplayExpandSignLeft;
|
|
if TreeView<>nil then begin
|
|
inc(Result,TreeView.Indent);
|
|
end;
|
|
end;
|
|
|
|
function TTreeNode.DisplayIconLeft: integer;
|
|
begin
|
|
Result:=DisplayExpandSignLeft;
|
|
if (TreeView<>nil) then
|
|
inc(Result,TreeView.Indent);
|
|
end;
|
|
|
|
function TTreeNode.DisplayStateIconLeft: integer;
|
|
begin
|
|
Result:=DisplayIconLeft;
|
|
if (TreeView<>nil) and (TreeView.Images<>nil) then
|
|
inc(Result,TreeView.Images.Width+2);
|
|
end;
|
|
|
|
function TTreeNode.DisplayTextLeft: integer;
|
|
begin
|
|
Result:=DisplayStateIconLeft;
|
|
if (TreeView<>nil) and (TreeView.StateImages<>nil) then
|
|
inc(Result,TreeView.StateImages.Width+2);
|
|
end;
|
|
|
|
function TTreeNode.DisplayTextRight: integer;
|
|
begin
|
|
Result:=DisplayTextLeft;
|
|
if TreeView<>nil then
|
|
Inc(Result,TreeView.Canvas.TextWidth(Text));
|
|
end;
|
|
|
|
function TTreeNode.AlphaSort: Boolean;
|
|
begin
|
|
Result := CustomSort(nil);
|
|
end;
|
|
|
|
function TTreeNode.CustomSort(SortProc: TTreeNodeCompare): Boolean;
|
|
//var SortCB: TTVSortCB;
|
|
|
|
procedure Merge(Src,Buffer: TTreeNodeArray; Pos1, Pos2, Pos3: integer);
|
|
// merge two sorted arrays (result is in Src)
|
|
// the first array ranges Pos1..Pos2-1, the second ranges Pos2..Pos3
|
|
var Src1Pos,Src2Pos,DestPos,cmp,a:integer;
|
|
begin
|
|
if (Pos1>=Pos2) or (Pos2>Pos3) then exit;
|
|
Src1Pos:=Pos2-1;
|
|
Src2Pos:=Pos3;
|
|
DestPos:=Pos3;
|
|
while (Src2Pos>=Pos2) and (Src1Pos>=Pos1) do begin
|
|
cmp:=SortProc(Src[Src1Pos],Src[Src2Pos]);
|
|
if cmp>0 then begin
|
|
Buffer[DestPos]:=Src[Src1Pos];
|
|
dec(Src1Pos);
|
|
end else begin
|
|
Buffer[DestPos]:=Src[Src2Pos];
|
|
dec(Src2Pos);
|
|
end;
|
|
dec(DestPos);
|
|
end;
|
|
while Src2Pos>=Pos2 do begin
|
|
Buffer[DestPos]:=Src[Src2Pos];
|
|
dec(Src2Pos);
|
|
dec(DestPos);
|
|
end;
|
|
for a:=DestPos+1 to Pos3 do
|
|
Src[a]:=Buffer[a];
|
|
end;
|
|
|
|
procedure MergeSort(Src,Buffer: TTreeNodeArray; StartPos, EndPos: integer);
|
|
// sort Src from Position StartPos to EndPos (both included)
|
|
var cmp,mid:integer;
|
|
begin
|
|
if StartPos>=EndPos then begin
|
|
// sort one element -> very easy :)
|
|
end else if StartPos+1=EndPos then begin
|
|
// sort two elements -> quite easy :)
|
|
cmp:=SortProc(Src[StartPos],Src[EndPos]);
|
|
if cmp>0 then begin
|
|
Buffer[StartPos]:=Src[StartPos];
|
|
Src[StartPos]:=Src[EndPos];
|
|
Src[EndPos]:=Buffer[StartPos];
|
|
end;
|
|
end else begin
|
|
// sort more than two elements -> Mergesort
|
|
mid:=(StartPos+EndPos) shr 1;
|
|
MergeSort(Src,Buffer,StartPos,mid);
|
|
MergeSort(Src,Buffer,mid+1,EndPos);
|
|
Merge(Src,Buffer,StartPos,mid+1,EndPos);
|
|
end;
|
|
end;
|
|
|
|
var FMergedItems: TTreeNodeArray;
|
|
begin
|
|
if FCount>0 then begin
|
|
if Owner<>nil then Owner.ClearCache;
|
|
if not Assigned(SortProc) then SortProc:=@DefaultTreeViewSort;
|
|
GetMem(FMergedItems,SizeOf(Pointer)*FCount);
|
|
MergeSort(FItems,FMergedItems,0,FCount-1);
|
|
{
|
|
with SortCB do begin
|
|
if not Assigned(SortProc) then lpfnCompare := @DefaultTreeViewSort
|
|
else lpfnCompare := SortProc;
|
|
hParent := ItemId;
|
|
lParam := Data;
|
|
end;
|
|
Result := TreeView_SortChildrenCB(Handle, SortCB, 0);
|
|
}
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
procedure TTreeNode.Delete;
|
|
begin
|
|
if not Deleting then Free;
|
|
end;
|
|
|
|
procedure TTreeNode.DeleteChildren;
|
|
begin
|
|
if Owner<>nil then Owner.ClearCache;
|
|
Collapse(true);
|
|
HasChildren := False;
|
|
end;
|
|
|
|
procedure TTreeNode.Assign(Source: TPersistent);
|
|
var
|
|
ANode: TTreeNode;
|
|
begin
|
|
if Owner<>nil then Owner.ClearCache;
|
|
if Source is TTreeNode then
|
|
begin
|
|
ANode := TTreeNode(Source);
|
|
Text := ANode.Text;
|
|
Data := ANode.Data;
|
|
ImageIndex := ANode.ImageIndex;
|
|
SelectedIndex := ANode.SelectedIndex;
|
|
StateIndex := ANode.StateIndex;
|
|
OverlayIndex := ANode.OverlayIndex;
|
|
Height := ANode.Height;
|
|
Focused := ANode.Focused;
|
|
//DropTarget := ANode.DropTarget;
|
|
Cut := ANode.Cut;
|
|
HasChildren := ANode.HasChildren;
|
|
end
|
|
else inherited Assign(Source);
|
|
end;
|
|
|
|
function TTreeNode.IsEqual(Node: TTreeNode): Boolean;
|
|
begin
|
|
Result := (Text = Node.Text) and (Data = Node.Data);
|
|
end;
|
|
|
|
procedure TTreeNode.ReadData(Stream: TStream; StreamVersion: integer;
|
|
Info: PTreeNodeInfo);
|
|
var
|
|
I, ItemCount: Integer;
|
|
NewExpanded: boolean;
|
|
begin
|
|
if Owner<>nil then Owner.ClearCache;
|
|
Stream.ReadBuffer(Info^, SizeOf(TTreeNodeInfo));
|
|
ImageIndex := Info^.ImageIndex;
|
|
SelectedIndex := Info^.SelectedIndex;
|
|
StateIndex := Info^.StateIndex;
|
|
OverlayIndex := Info^.OverlayIndex;
|
|
Data := Info^.Data;
|
|
Height := Info^.Height;
|
|
NewExpanded := Info^.Expanded;
|
|
SetLength(FText,Info^.TextLen);
|
|
if FText<>'' then
|
|
Stream.Read(FText[1],length(FText));
|
|
if Owner<>nil then begin
|
|
ItemCount := Info^.Count;
|
|
for I := 0 to ItemCount - 1 do
|
|
Owner.AddChild(Self, '').ReadData(Stream, StreamVersion, Info);
|
|
end;
|
|
Expanded := NewExpanded;
|
|
end;
|
|
|
|
procedure TTreeNode.ReadDelphiData(Stream: TStream; Info: PDelphiNodeInfo);
|
|
var
|
|
I, Size, ItemCount: Integer;
|
|
begin
|
|
if Owner<>nil then Owner.ClearCache;
|
|
Stream.ReadBuffer(Size, SizeOf(Size));
|
|
Stream.ReadBuffer(Info^, Size);
|
|
Text := Info^.Text;
|
|
ImageIndex := Info^.ImageIndex;
|
|
SelectedIndex := Info^.SelectedIndex;
|
|
StateIndex := Info^.StateIndex;
|
|
OverlayIndex := Info^.OverlayIndex;
|
|
Data := Info^.Data;
|
|
if Owner<>nil then begin
|
|
ItemCount := Info^.Count;
|
|
for I := 0 to ItemCount - 1 do
|
|
Owner.AddChild(Self, '').ReadDelphiData(Stream, Info);
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNode.WriteData(Stream: TStream; Info: PTreeNodeInfo);
|
|
var i: integer;
|
|
begin
|
|
Info^.ImageIndex := ImageIndex;
|
|
Info^.SelectedIndex := SelectedIndex;
|
|
Info^.OverlayIndex := OverlayIndex;
|
|
Info^.StateIndex := StateIndex;
|
|
Info^.Data := Data;
|
|
Info^.Height := FHeight;
|
|
Info^.Count := Count;
|
|
Info^.Expanded := Expanded;
|
|
Info^.TextLen := Length(Text);
|
|
Stream.WriteBuffer(Info^, SizeOf(TTreeNodeInfo));
|
|
if Text<>'' then
|
|
Stream.Write(FText[1],length(Text));
|
|
for i := 0 to Count - 1 do
|
|
Items[i].WriteData(Stream, Info);
|
|
end;
|
|
|
|
procedure TTreeNode.WriteDelphiData(Stream: TStream; Info: PDelphiNodeInfo);
|
|
var
|
|
I, Size, L, ItemCount: Integer;
|
|
begin
|
|
L := Length(Text);
|
|
if L > 255 then L := 255;
|
|
Size := SizeOf(TDelphiNodeInfo) + L - 255;
|
|
Info^.Text := Text;
|
|
Info^.ImageIndex := ImageIndex;
|
|
Info^.SelectedIndex := SelectedIndex;
|
|
Info^.OverlayIndex := OverlayIndex;
|
|
Info^.StateIndex := StateIndex;
|
|
Info^.Data := Data;
|
|
ItemCount := Count;
|
|
Info^.Count := ItemCount;
|
|
Stream.WriteBuffer(Size, SizeOf(Size));
|
|
Stream.WriteBuffer(Info^, Size);
|
|
for I := 0 to ItemCount - 1 do
|
|
Items[I].WriteDelphiData(Stream, Info);
|
|
end;
|
|
|
|
procedure TTreeNode.ConsistencyCheck;
|
|
var RealSubTreeCount: integer;
|
|
i: integer;
|
|
Node1: TTreeNode;
|
|
begin
|
|
if FOwner<>nil then begin
|
|
end;
|
|
if FCapacity<0 then RaiseGDBException('');
|
|
if FCapacity<FCount then RaiseGDBException('');
|
|
if FCount<0 then RaiseGDBException('');
|
|
if FHeight<0 then RaiseGDBException('');
|
|
if (FItems<>nil) and (FCapacity<=0) then RaiseGDBException('');
|
|
if (FCapacity>0) and (FItems=nil) then RaiseGDBException('');
|
|
if (FNextBrother<>nil) and (FNextBrother.FPrevBrother<>Self) then
|
|
RaiseGDBException('');
|
|
if (FPrevBrother<>nil) and (FPrevBrother.FNextBrother<>Self) then
|
|
RaiseGDBException('');
|
|
// check childs
|
|
RealSubTreeCount:=1;
|
|
for i:=0 to FCount-1 do begin
|
|
if (Items[i]=nil) then RaiseGDBException('');
|
|
if (i=0) and (Items[i].FPrevBrother<>nil) then RaiseGDBException('');
|
|
if (i>0) and (Items[i].FPrevBrother=nil) then RaiseGDBException('');
|
|
if (i>0) and (Items[i].FPrevBrother<>Items[i-1]) then RaiseGDBException('');
|
|
if (i<FCount-1) and (Items[i].FNextBrother=nil) then
|
|
RaiseGDBException('');
|
|
if (i<FCount-1) and (Items[i].FNextBrother<>Items[i+1]) then
|
|
RaiseGDBException('');
|
|
if (i=FCount-1) and (Items[i].FNextBrother<>nil) then
|
|
RaiseGDBException('');
|
|
if Items[i].FParent<>Self then RaiseGDBException('');
|
|
Items[i].ConsistencyCheck;
|
|
inc(RealSubTreeCount,Items[i].SubTreeCount);
|
|
end;
|
|
if FParent<>nil then begin
|
|
if FParent.IndexOf(Self)<0 then RaiseGDBException('');
|
|
end;
|
|
if RealSubTreeCount<>SubTreeCount then RaiseGDBException('');
|
|
if FTop<0 then RaiseGDBException('');
|
|
// check for circles
|
|
if FNextBrother=Self then RaiseGDBException('');
|
|
if FPrevBrother=Self then RaiseGDBException('');
|
|
if FParent=Self then RaiseGDBException('');
|
|
Node1:=FParent;
|
|
while Node1<>nil do begin
|
|
if (Node1=Self) then RaiseGDBException('');
|
|
Node1:=Node1.FParent;
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNode.WriteDebugReport(const Prefix: string; Recurse: boolean);
|
|
var i: integer;
|
|
begin
|
|
DbgOut('%s%s.WriteDebugReport Self=%p',[Prefix, ClassName, Pointer(Self)]);
|
|
ConsistencyCheck;
|
|
DebugLn(' Text=',Text);
|
|
if Recurse then begin
|
|
for i:=0 to FCount-1 do
|
|
Items[i].WriteDebugReport(Prefix+' ',true);
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TTreeNodes }
|
|
|
|
constructor TTreeNodes.Create(AnOwner: TCustomTreeView);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AnOwner;
|
|
end;
|
|
|
|
destructor TTreeNodes.Destroy;
|
|
begin
|
|
Clear;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TTreeNodes.GetCount: Integer;
|
|
begin
|
|
Result:=FCount;
|
|
//if Owner.HandleAllocated then Result := TreeView_GetCount(Handle)
|
|
//else Result := 0;
|
|
end;
|
|
|
|
function TTreeNodes.GetHandle: THandle;
|
|
begin
|
|
if Owner<>nil then
|
|
Result:=Owner.Handle
|
|
else
|
|
Result:=0;
|
|
end;
|
|
|
|
procedure TTreeNodes.Delete(Node: TTreeNode);
|
|
begin
|
|
//Calling Owner.Delete is done in by TTreeNode.Destroy
|
|
//if Owner<>nil then
|
|
////if (Node.ItemId = nil) then
|
|
// Owner.Delete(Node);
|
|
Node.Delete;
|
|
end;
|
|
|
|
procedure TTreeNodes.Clear;
|
|
begin
|
|
ClearCache;
|
|
while GetLastNode<>nil do
|
|
GetLastNode.Delete;
|
|
end;
|
|
|
|
procedure TTreeNodes.ClearMultiSelection;
|
|
var
|
|
ANode, OldNode: TTreeNode;
|
|
begin
|
|
if Owner<>nil then Owner.LockSelectionChangeEvent;
|
|
ANode:=FFirstMultiSelected;
|
|
while ANode<>nil do begin
|
|
OldNode:=ANode;
|
|
ANode:=ANode.GetNextMultiSelected;
|
|
OldNode.MultiSelected:=false;
|
|
end;
|
|
if Owner<>nil then Owner.UnlockSelectionChangeEvent;
|
|
end;
|
|
|
|
function TTreeNodes.IsMultiSelection: boolean;
|
|
begin
|
|
Result:=(FFirstMultiSelected<>nil)
|
|
and (FFirstMultiSelected.GetNextMultiSelected<>nil);
|
|
end;
|
|
|
|
function TTreeNodes.AddChildFirst(ParentNode: TTreeNode; const S: string): TTreeNode;
|
|
begin
|
|
Result := AddChildObjectFirst(ParentNode, S, nil);
|
|
end;
|
|
|
|
function TTreeNodes.AddChildObjectFirst(ParentNode: TTreeNode; const S: string;
|
|
Data: Pointer): TTreeNode;
|
|
begin
|
|
Result := InternalAddObject(ParentNode, S, Data, taAddFirst);
|
|
end;
|
|
|
|
function TTreeNodes.AddChild(ParentNode: TTreeNode; const S: string): TTreeNode;
|
|
begin
|
|
Result := AddChildObject(ParentNode, S, nil);
|
|
end;
|
|
|
|
function TTreeNodes.AddChildObject(ParentNode: TTreeNode; const S: string;
|
|
Data: Pointer): TTreeNode;
|
|
begin
|
|
Result := InternalAddObject(ParentNode, S, Data, taAdd);
|
|
end;
|
|
|
|
function TTreeNodes.AddFirst(SiblingNode: TTreeNode; const S: string): TTreeNode;
|
|
begin
|
|
Result := AddObjectFirst(SiblingNode, S, nil);
|
|
end;
|
|
|
|
function TTreeNodes.AddObjectFirst(SiblingNode: TTreeNode; const S: string;
|
|
Data: Pointer): TTreeNode;
|
|
var ParentNode: TTreeNode;
|
|
begin
|
|
if SiblingNode <> nil then
|
|
ParentNode := SiblingNode.Parent
|
|
else
|
|
ParentNode := nil;
|
|
Result := InternalAddObject(ParentNode, S, Data, taAddFirst);
|
|
end;
|
|
|
|
function TTreeNodes.Add(SiblingNode: TTreeNode; const S: string): TTreeNode;
|
|
begin
|
|
Result := AddObject(SiblingNode, S, nil);
|
|
end;
|
|
|
|
procedure TTreeNodes.Repaint(ANode: TTreeNode);
|
|
var
|
|
R: TRect;
|
|
begin
|
|
if (FUpdateCount < 1) and (Owner<>nil) then begin
|
|
while (ANode <> nil) and not ANode.IsVisible do ANode := ANode.Parent;
|
|
if ANode <> nil then begin
|
|
R := ANode.DisplayRect(False);
|
|
InvalidateRect(Owner.Handle, @R, True);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TTreeNodes.AddObject(SiblingNode: TTreeNode; const S: string;
|
|
Data: Pointer): TTreeNode;
|
|
var ParentNode: TTreeNode;
|
|
begin
|
|
if SiblingNode <> nil then
|
|
ParentNode := SiblingNode.Parent
|
|
else
|
|
ParentNode := nil;
|
|
Result := InternalAddObject(ParentNode, S, Data, taAdd);
|
|
end;
|
|
|
|
procedure TTreeNodes.AddedNode(AValue: TTreeNode);
|
|
begin
|
|
if AValue <> nil then begin
|
|
AValue.HasChildren := True;
|
|
Repaint(AValue);
|
|
end;
|
|
end;
|
|
|
|
function TTreeNodes.Insert(NextNode: TTreeNode; const S: string): TTreeNode;
|
|
begin
|
|
Result := InsertObject(NextNode, S, nil);
|
|
end;
|
|
|
|
function TTreeNodes.InsertObject(NextNode: TTreeNode; const S: string;
|
|
Data: Pointer): TTreeNode;
|
|
// create a new node with Text=S and Data=Data and insert in front of
|
|
// NextNode (as sibling with same parent).
|
|
begin
|
|
Result:=InternalAddObject(NextNode,S,Data,taInsert);
|
|
end;
|
|
|
|
function TTreeNodes.InsertBehind(PrevNode: TTreeNode; const S: string
|
|
): TTreeNode;
|
|
begin
|
|
Result := InsertObjectBehind(PrevNode, S, nil);
|
|
end;
|
|
|
|
function TTreeNodes.InsertObjectBehind(PrevNode: TTreeNode; const S: string;
|
|
Data: Pointer): TTreeNode;
|
|
// create a new node with Text=S and Data=Data and insert in front of
|
|
// NextNode (as sibling with same parent).
|
|
begin
|
|
if (PrevNode<>nil) and (PrevNode.GetNextSibling<>nil) then
|
|
Result:=InternalAddObject(PrevNode.GetNextSibling,S,Data,taInsert)
|
|
else
|
|
Result:=AddObject(PrevNode,S,Data);
|
|
end;
|
|
|
|
function TTreeNodes.InternalAddObject(Node: TTreeNode; const S: string;
|
|
Data: Pointer; AddMode: TAddMode): TTreeNode;
|
|
{
|
|
TAddMode = (taAddFirst, taAdd, taInsert);
|
|
|
|
taAdd: add Result as last child of Node
|
|
taAddFirst: add Result as first child of Node
|
|
taInsert: add Result in front of Node
|
|
}
|
|
//var Item: HTreeItem;
|
|
var ok: boolean;
|
|
begin
|
|
if Owner=nil then
|
|
TreeNodeError('TTreeNodes.InternalAddObject Owner=nil');
|
|
{$IFDEF TREEVIEW_DEBUG}
|
|
write('[TTreeNodes.InternalAddObject] Node=',Node<>nil,' S=',S,
|
|
' AddMode=',AddModeNames[AddMode]);
|
|
if Node<>nil then DbgOut(' Node.Text=',Node.Text);
|
|
DebugLn('');
|
|
{$ENDIF}
|
|
Result := Owner.CreateNode;
|
|
ok:=false;
|
|
try
|
|
Result.Data := Data;
|
|
Result.Text := S;
|
|
// move node in tree (tree of TTreeNode)
|
|
Result.InternalMove(Node,AddMode);
|
|
if (Owner<>nil) and Owner.AutoExpand and (Result.Parent<>nil) then
|
|
Result.Parent.Expanded:=true;
|
|
if (FUpdateCount=0) and (Owner<>nil) then
|
|
Owner.Invalidate;
|
|
ok:=true;
|
|
finally
|
|
// this construction creates nicer exception output
|
|
if not ok then
|
|
Result.Free;
|
|
end;
|
|
end;
|
|
|
|
function TTreeNodes.GetFirstNode: TTreeNode;
|
|
begin
|
|
if FTopLvlItems<>nil then
|
|
Result := FTopLvlItems[0]
|
|
else
|
|
Result := nil;
|
|
//Result := GetNode(TreeView_GetRoot(Handle));
|
|
end;
|
|
|
|
function TTreeNodes.GetLastNode: TTreeNode;
|
|
begin
|
|
if FTopLvlItems<>nil then
|
|
Result := FTopLvlItems[FTopLvlCount-1]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TTreeNodes.GetLastSubNode: TTreeNode;
|
|
// absolute last node
|
|
var Node: TTreeNode;
|
|
begin
|
|
Result:=GetLastNode;
|
|
if Result<>nil then begin
|
|
Node:=Result.GetLastSubChild;
|
|
if Node<>nil then Result:=Node;
|
|
end;
|
|
end;
|
|
|
|
function TTreeNodes.GetLastExpandedSubNode: TTreeNode;
|
|
// absolute last expanded node
|
|
var Node: TTreeNode;
|
|
begin
|
|
Result:=GetLastNode;
|
|
while (Result<>nil) and (Result.Expanded) do begin
|
|
Node:=Result.GetLastChild;
|
|
if Node<>nil then
|
|
Result:=Node
|
|
else
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
function TTreeNodes.FindTopLvlNode(const NodeText: string): TTreeNode;
|
|
begin
|
|
Result:=GetFirstNode;
|
|
while (Result<>nil) and (Result.Text<>NodeText) do
|
|
Result:=Result.GetNextSibling;
|
|
end;
|
|
|
|
function TTreeNodes.GetNodeFromIndex(Index: Integer): TTreeNode;
|
|
// find node with absolute index in ALL nodes (even collapsed)
|
|
var
|
|
I, J: Integer;
|
|
begin
|
|
if (Index < 0) or (Index >= FCount) then
|
|
TreeNodeError('TTreeNodes.GetNodeFromIndex Index '+IntToStr(Index)
|
|
+' out of bounds (Count='+IntToStr(FCount)+')');
|
|
if (FNodeCache.CacheNode <> nil) and (Abs(FNodeCache.CacheIndex - Index) <= 1)
|
|
then begin
|
|
with FNodeCache do
|
|
begin
|
|
if Index = CacheIndex then Result := CacheNode
|
|
else if Index < CacheIndex then Result := CacheNode.GetPrev
|
|
else Result := CacheNode.GetNext;
|
|
end;
|
|
end
|
|
else begin
|
|
Result := GetFirstNode;
|
|
I:=0;
|
|
while (Result<>nil) and (Index>I) do begin
|
|
Repeat
|
|
// calculate the absolute index of the next sibling
|
|
J:=I+Result.FSubTreeCount;
|
|
if J=I then
|
|
TreeNodeError(
|
|
'TTreeNodes.GetNodeFromIndex: Consistency error - SubTreeCount=0');
|
|
if J<=Index then begin
|
|
// Index > absolute index of next sibling -> search in next sibling
|
|
Result:=Result.GetNextSibling;
|
|
I:=J;
|
|
end else
|
|
break;
|
|
until false;
|
|
if (Result<>nil) and (Index>I) then begin
|
|
// Index is somewhere in subtree of Result
|
|
Result:=Result.GetFirstChild;
|
|
if Result=nil then
|
|
TreeNodeError(
|
|
'TTreeNodes.GetNodeFromIndex: Consistency error'
|
|
+' - invalid SubTreeCount');
|
|
inc(I);
|
|
end;
|
|
end;
|
|
end;
|
|
if Result = nil then
|
|
TreeNodeError(
|
|
'TTreeNodes.GetNodeFromIndex: Consistency Error - Count too big');
|
|
FNodeCache.CacheNode := Result;
|
|
FNodeCache.CacheIndex := Index;
|
|
end;
|
|
|
|
{function TTreeNodes.GetNode(ItemId: HTreeItem): TTreeNode;
|
|
var
|
|
Item: TTVItem;
|
|
begin
|
|
with Item do
|
|
begin
|
|
hItem := ItemId;
|
|
mask := TVIF_PARAM;
|
|
end;
|
|
if TreeView_GetItem(Handle, Item) then Result := TTreeNode(Item.lParam)
|
|
else Result := nil;
|
|
end;}
|
|
|
|
procedure TTreeNodes.SetItem(Index: Integer; AValue: TTreeNode);
|
|
begin
|
|
GetNodeFromIndex(Index).Assign(AValue);
|
|
end;
|
|
|
|
procedure TTreeNodes.SetTopLvlItems(Index: integer; AValue: TTreeNode);
|
|
begin
|
|
GetTopLvlItems(Index).Assign(AValue);
|
|
end;
|
|
|
|
procedure TTreeNodes.BeginUpdate;
|
|
begin
|
|
if FUpdateCount = 0 then SetUpdateState(True);
|
|
Inc(FUpdateCount);
|
|
end;
|
|
|
|
procedure TTreeNodes.SetUpdateState(Updating: Boolean);
|
|
begin
|
|
//SendMessage(Handle, WM_SETREDRAW, Ord(not Updating), 0);
|
|
if Updating then
|
|
Include(Owner.FStates,tvsUpdating)
|
|
else
|
|
Exclude(Owner.FStates,tvsUpdating);
|
|
if not Updating then Owner.Refresh;
|
|
end;
|
|
|
|
procedure TTreeNodes.EndUpdate;
|
|
begin
|
|
Dec(FUpdateCount);
|
|
if FUpdateCount = 0 then SetUpdateState(False);
|
|
end;
|
|
|
|
procedure TTreeNodes.GrowTopLvlItems;
|
|
begin
|
|
if FTopLvlItems<>nil then begin
|
|
FTopLvlCapacity:=FTopLvlCapacity shl 1;
|
|
ReAllocMem(FTopLvlItems,SizeOf(Pointer)*FTopLvlCapacity);
|
|
end else begin
|
|
FTopLvlCapacity:=MinNodeCapacity;
|
|
GetMem(FTopLvlItems,SizeOf(Pointer)*FTopLvlCapacity);
|
|
end;
|
|
//debugln('TTreeNodes.GrowTopLvlItems END FTopLvlCapacity=',FTopLvlCapacity,' FTopLvlCount=',FTopLvlCount,' ',FTopLvlItems<>nil);
|
|
end;
|
|
|
|
function TTreeNodes.GetTopLvlItems(Index: integer): TTreeNode;
|
|
begin
|
|
Result:=FTopLvlItems[Index];
|
|
end;
|
|
|
|
procedure TTreeNodes.ShrinkTopLvlItems;
|
|
var
|
|
OldCapacity: LongInt;
|
|
begin
|
|
if FTopLvlItems<>nil then begin
|
|
OldCapacity:=FTopLvlCapacity;
|
|
FTopLvlCapacity:=FTopLvlCapacity shr 1;
|
|
if FTopLvlCapacity<FTopLvlCount then FTopLvlCapacity:=FTopLvlCount;
|
|
if (FTopLvlCapacity<MinNodeCapacity) then begin
|
|
if (FTopLvlCount>0) then
|
|
FTopLvlCapacity:=MinNodeCapacity
|
|
else
|
|
FTopLvlCapacity:=0;
|
|
end;
|
|
if OldCapacity=FTopLvlCapacity then exit;
|
|
//debugln('TTreeNodes.ShrinkTopLvlItems A FTopLvlCapacity=',FTopLvlCapacity,' FTopLvlCount=',FTopLvlCount,' ',FTopLvlItems<>nil);
|
|
ReAllocMem(FTopLvlItems,SizeOf(Pointer)*FTopLvlCapacity);
|
|
//debugln('TTreeNodes.ShrinkTopLvlItems B FTopLvlCapacity=',FTopLvlCapacity,' FTopLvlCount=',FTopLvlCount,' ',FTopLvlItems<>nil);
|
|
end else begin
|
|
if (FTopLvlCapacity>0) then
|
|
TreeNodeError('TTreeNodes.ShrinkTopLvlItems FTopLvlCapacity>0');
|
|
end;
|
|
end;
|
|
|
|
function TTreeNodes.IndexOfTopLvlItem(Node: TTreeNode): integer;
|
|
begin
|
|
if (FTopLvlItems<>nil) and (FTopLvlItems[0]=Node) then exit(0);
|
|
Result:=FTopLvlCount-1;
|
|
while (Result>=0) and (FTopLvlItems[Result]<>Node) do dec(Result);
|
|
end;
|
|
|
|
procedure TTreeNodes.MoveTopLvlNode(TopLvlFromIndex, TopLvlToIndex: integer;
|
|
Node: TTreeNode);
|
|
// TopLvlFromIndex = -1 and is insert
|
|
// TopLvlToIndex = -1 is remove
|
|
var i: integer;
|
|
begin
|
|
{$IFDEF TREEVIEW_DEBUG}
|
|
DebugLn('[TTreeNodes.MoveTopLvlNode] TopLvlFromIndex=',TopLvlFromIndex,
|
|
' TopLvlToIndex=',TopLvlToIndex,' Node.Text=',Node.Text);
|
|
{$ENDIF}
|
|
if TopLvlFromIndex=TopLvlToIndex then exit;
|
|
if (TopLvlFromIndex>=FTopLvlCount) then
|
|
TreeNodeError('TTreeNodes.MoveTopLvlNode TopLvlFromIndex>FTopLvlCount');
|
|
if (TopLvlToIndex>FTopLvlCount) then
|
|
TreeNodeError('TTreeNodes.MoveTopLvlNode TopLvlFromIndex>FTopLvlCount');
|
|
if (TopLvlFromIndex>=0) then begin
|
|
Node:=FTopLvlItems[TopLvlFromIndex];
|
|
if (TopLvlToIndex>=0) then begin
|
|
// move node
|
|
if TopLvlFromIndex<TopLvlToIndex then begin
|
|
// move forward
|
|
for i:=TopLvlFromIndex to TopLvlToIndex-1 do
|
|
FTopLvlItems[i]:=FTopLvlItems[i+1];
|
|
end else begin
|
|
// move backward
|
|
for i:=TopLvlToIndex downto TopLvlFromIndex+1 do
|
|
FTopLvlItems[i]:=FTopLvlItems[i-1];
|
|
end;
|
|
FTopLvlItems[TopLvlToIndex]:=Node;
|
|
end else begin
|
|
// remove node
|
|
if FTopLvlItems<>nil then begin
|
|
for i:=TopLvlFromIndex to FTopLvlCount-2 do
|
|
FTopLvlItems[i]:=FTopLvlItems[i+1];
|
|
end;
|
|
Dec(FTopLvlCount);
|
|
if FTopLvlCount<0 then
|
|
TreeNodeError('TTreeNodes.MoveTopLvlNode FTopLvlCount<0');
|
|
if FTopLvlCount<(FTopLvlCapacity shr 2) then ShrinkTopLvlItems;
|
|
end;
|
|
end else begin
|
|
if (TopLvlToIndex>=0) then begin
|
|
if Node=nil then
|
|
TreeNodeError('TTreeNodes.MoveTopLvlNode inserting nil');
|
|
// insert node
|
|
if (FTopLvlCount=FTopLvlCapacity) then GrowTopLvlItems;
|
|
inc(FTopLvlCount);
|
|
if FTopLvlItems<>nil then begin
|
|
for i:=FTopLvlCount-1 downto TopLvlToIndex+1 do
|
|
FTopLvlItems[i]:=FTopLvlItems[i-1];
|
|
FTopLvlItems[TopLvlToIndex]:=Node;
|
|
end;
|
|
end else begin
|
|
// nothing to do
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNodes.Assign(Source: TPersistent);
|
|
var
|
|
TreeNodes: TTreeNodes;
|
|
MemStream: TMemoryStream;
|
|
begin
|
|
ClearCache;
|
|
if Source is TTreeNodes then begin
|
|
TreeNodes := TTreeNodes(Source);
|
|
Clear;
|
|
MemStream := TMemoryStream.Create;
|
|
try
|
|
TreeNodes.WriteData(MemStream);
|
|
MemStream.Position := 0;
|
|
ReadData(MemStream);
|
|
finally
|
|
MemStream.Free;
|
|
end;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TTreeNodes.DefineProperties(Filer: TFiler);
|
|
|
|
function WriteNodes: Boolean;
|
|
var
|
|
I: Integer;
|
|
Nodes: TTreeNodes;
|
|
begin
|
|
Nodes := TTreeNodes(Filer.Ancestor);
|
|
if Nodes = nil then
|
|
Result := Count > 0
|
|
else if Nodes.Count <> Count then
|
|
Result := True
|
|
else
|
|
begin
|
|
Result := False;
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
Result := not Items[I].IsEqual(Nodes[I]);
|
|
if Result then Break;
|
|
end
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
inherited DefineProperties(Filer);
|
|
Filer.DefineBinaryProperty('Data', @ReadData, @WriteData, WriteNodes);
|
|
end;
|
|
|
|
procedure TTreeNodes.ReadData(Stream: TStream);
|
|
var
|
|
I, NewCount, MagicNumber: Integer;
|
|
NodeInfo: TDelphiNodeInfo;
|
|
StreamVersion: word;
|
|
begin
|
|
Clear;
|
|
// -7 for lcl stream
|
|
Stream.ReadBuffer(MagicNumber,SizeOf(Integer));
|
|
if MagicNumber=LCLStreamID then begin
|
|
// read stream version
|
|
Stream.ReadBuffer(StreamVersion,SizeOf(StreamVersion));
|
|
// read top level node count
|
|
Stream.ReadBuffer(NewCount, SizeOf(NewCount));
|
|
for I := 0 to NewCount - 1 do
|
|
Add(nil, '').ReadData(Stream, StreamVersion, @NodeInfo);
|
|
end else begin
|
|
// delphi stream
|
|
NewCount:=MagicNumber;
|
|
for I := 0 to NewCount - 1 do
|
|
Add(nil, '').ReadDelphiData(Stream, @NodeInfo);
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNodes.WriteData(Stream: TStream);
|
|
var
|
|
ANode: TTreeNode;
|
|
NodeInfo: TDelphiNodeInfo;
|
|
MagicNumber: integer;
|
|
begin
|
|
// -7 for lcl stream
|
|
MagicNumber:=LCLStreamID;
|
|
Stream.WriteBuffer(MagicNumber,SizeOf(MagicNumber));
|
|
// write stream version
|
|
Stream.WriteBuffer(TTreeNodeStreamVersion,SizeOf(Word));
|
|
// write top level node count
|
|
Stream.WriteBuffer(FTopLvlCount, SizeOf(Integer));
|
|
// write all nodes recursively
|
|
ANode := GetFirstNode;
|
|
while ANode <> nil do begin
|
|
ANode.WriteData(Stream, @NodeInfo);
|
|
ANode := ANode.GetNextSibling;
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNodes.ReadExpandedState(Stream: TStream);
|
|
var
|
|
ItemCount,
|
|
Index: Integer;
|
|
Node: TTreeNode;
|
|
NodeExpanded: Boolean;
|
|
begin
|
|
// ToDo: read different stream formats
|
|
if Stream.Position < Stream.Size then
|
|
Stream.ReadBuffer(ItemCount, SizeOf(ItemCount))
|
|
else Exit;
|
|
Index := 0;
|
|
Node := GetFirstNode;
|
|
while (Index < ItemCount) and (Node <> nil) do begin
|
|
Stream.ReadBuffer(NodeExpanded, SizeOf(NodeExpanded));
|
|
Node.Expanded := NodeExpanded;
|
|
Inc(Index);
|
|
Node := Node.GetNext;
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNodes.WriteExpandedState(Stream: TStream);
|
|
var
|
|
Size: Integer;
|
|
ANode: TTreeNode;
|
|
NodeExpanded: Boolean;
|
|
begin
|
|
// ToDo: read different stream formats
|
|
Size := SizeOf(Boolean) * Count;
|
|
Stream.WriteBuffer(Size, SizeOf(Size));
|
|
ANode := GetFirstNode;
|
|
while (ANode <> nil) do begin
|
|
NodeExpanded := ANode.Expanded;
|
|
Stream.WriteBuffer(NodeExpanded, SizeOf(Boolean));
|
|
ANode := ANode.GetNext;
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNodes.ClearCache;
|
|
begin
|
|
FNodeCache.CacheNode := nil;
|
|
end;
|
|
|
|
procedure TTreeNodes.ConsistencyCheck;
|
|
var Node: TTreeNode;
|
|
RealCount, i: integer;
|
|
OldCache: TNodeCache;
|
|
begin
|
|
if FUpdateCount<0 then
|
|
RaiseGDBException('FUpdateCount<0');
|
|
RealCount:=0;
|
|
Node:=GetFirstNode;
|
|
while Node<>nil do begin
|
|
Node.ConsistencyCheck;
|
|
inc(RealCount,Node.SubTreeCount);
|
|
//DebugLn(' ConsistencyCheck: B ',RealCount,',',Node.SubTreeCount);
|
|
Node:=Node.FNextBrother;
|
|
end;
|
|
//DebugLn(' ConsistencyCheck: B ',RealCount,',',FCount);
|
|
if RealCount<>FCount then
|
|
RaiseGDBException('RealCount<>FCount');
|
|
if (FTopLvlCapacity<=0) and (FTopLvlItems<>nil) then
|
|
RaiseGDBException('');
|
|
if (FTopLvlCapacity>0) and (FTopLvlItems=nil) then
|
|
RaiseGDBException('');
|
|
if FTopLvlCapacity<FTopLvlCount then
|
|
RaiseGDBException('');
|
|
if (FTopLvlCount<0) then
|
|
RaiseGDBException('');
|
|
for i:=0 to FTopLvlCount-1 do begin
|
|
if (i=0) and (FTopLvlItems[i].FPrevBrother<>nil) then
|
|
RaiseGDBException('');
|
|
if (i>0) and (FTopLvlItems[i].FPrevBrother<>FTopLvlItems[i-1]) then
|
|
RaiseGDBException('');
|
|
if (i<FTopLvlCount-1) and (FTopLvlItems[i].FNextBrother<>FTopLvlItems[i+1])
|
|
then begin
|
|
DebugLn(' CONSISTENCY i=%d FTopLvlCount=%d FTopLvlItems[i]=%p FTopLvlItems[i].FNextBrother=%p FTopLvlItems[i+1]=%p',
|
|
[i, FTopLvlCount, Pointer(FTopLvlItems[i]), Pointer(FTopLvlItems[i].FNextBrother), Pointer(FTopLvlItems[i+1])]);
|
|
RaiseGDBException('');
|
|
end;
|
|
if (i=FTopLvlCount-1) and (FTopLvlItems[i].FNextBrother<>nil) then
|
|
RaiseGDBException('');
|
|
end;
|
|
if FNodeCache.CacheNode<>nil then begin
|
|
OldCache:=FNodeCache;
|
|
ClearCache;
|
|
if GetNodeFromIndex(OldCache.CacheIndex)<>OldCache.CacheNode then
|
|
RaiseGDBException('');
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeNodes.WriteDebugReport(const Prefix: string; AllNodes: boolean);
|
|
var Node: TTreeNode;
|
|
begin
|
|
DbgOut('%s%s.WriteDebugReport Self=%p', [Prefix, ClassName, Pointer(Self)]);
|
|
ConsistencyCheck;
|
|
DebugLn('');
|
|
if AllNodes then begin
|
|
Node:=GetFirstNode;
|
|
while Node<>nil do begin
|
|
Node.WriteDebugReport(Prefix+' ',true);
|
|
Node:=Node.GetNextSibling;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
type
|
|
TTreeStrings = class(TStrings)
|
|
private
|
|
FOwner: TTreeNodes;
|
|
protected
|
|
function Get(Index: Integer): string; override;
|
|
function GetBufStart(Buffer: PChar; var Level: Integer): PChar;
|
|
function GetCount: Integer; override;
|
|
function GetObject(Index: Integer): TObject; override;
|
|
procedure PutObject(Index: Integer; AObject: TObject); override;
|
|
procedure SetUpdateState(Updating: Boolean); override;
|
|
public
|
|
constructor Create(AnOwner: TTreeNodes);
|
|
function Add(const S: string): Integer; override;
|
|
procedure Clear; override;
|
|
procedure Delete(Index: Integer); override;
|
|
procedure Insert(Index: Integer; const S: string); override;
|
|
procedure LoadTreeFromStream(Stream: TStream);
|
|
procedure SaveTreeToStream(Stream: TStream);
|
|
function ConsistencyCheck: integer;
|
|
procedure WriteDebugReport(const Prefix: string);
|
|
property Owner: TTreeNodes read FOwner;
|
|
end;
|
|
|
|
constructor TTreeStrings.Create(AnOwner: TTreeNodes);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AnOwner;
|
|
end;
|
|
|
|
function TTreeStrings.Get(Index: Integer): string;
|
|
const
|
|
TabChar = #9;
|
|
var
|
|
Level, I: Integer;
|
|
Node: TTreeNode;
|
|
begin
|
|
Result := '';
|
|
Node := Owner.GetNodeFromIndex(Index);
|
|
Level := Node.Level;
|
|
for I := 0 to Level - 1 do Result := Result + TabChar;
|
|
Result := Result + Node.Text;
|
|
end;
|
|
|
|
function TTreeStrings.GetBufStart(Buffer: PChar; var Level: Integer): PChar;
|
|
begin
|
|
Level := 0;
|
|
while Buffer^ in [' ', #9] do
|
|
begin
|
|
Inc(Buffer);
|
|
Inc(Level);
|
|
end;
|
|
Result := Buffer;
|
|
end;
|
|
|
|
function TTreeStrings.GetObject(Index: Integer): TObject;
|
|
begin
|
|
Result := TObject(Owner.GetNodeFromIndex(Index).Data);
|
|
end;
|
|
|
|
procedure TTreeStrings.PutObject(Index: Integer; AObject: TObject);
|
|
begin
|
|
Owner.GetNodeFromIndex(Index).Data := AObject;
|
|
end;
|
|
|
|
function TTreeStrings.GetCount: Integer;
|
|
begin
|
|
Result := Owner.Count;
|
|
end;
|
|
|
|
procedure TTreeStrings.Clear;
|
|
begin
|
|
Owner.Clear;
|
|
end;
|
|
|
|
procedure TTreeStrings.Delete(Index: Integer);
|
|
begin
|
|
Owner.GetNodeFromIndex(Index).Delete;
|
|
end;
|
|
|
|
procedure TTreeStrings.SetUpdateState(Updating: Boolean);
|
|
begin
|
|
//SendMessage(Owner.Handle, WM_SETREDRAW, Ord(not Updating), 0);
|
|
if not Updating then Owner.Owner.Refresh;
|
|
end;
|
|
|
|
function TTreeStrings.Add(const S: string): Integer;
|
|
var
|
|
Level, OldLevel, I: Integer;
|
|
NewStr: string;
|
|
Node: TTreeNode;
|
|
begin
|
|
Result := GetCount;
|
|
if (Length(S) = 1) and (S[1] = Chr($1A)) then Exit;
|
|
Node := nil;
|
|
OldLevel := 0;
|
|
NewStr := GetBufStart(PChar(S), Level);
|
|
if Result > 0 then
|
|
begin
|
|
Node := Owner.GetNodeFromIndex(Result - 1);
|
|
OldLevel := Node.Level;
|
|
end;
|
|
if (Level > OldLevel) or (Node = nil) then
|
|
begin
|
|
if Level - OldLevel > 1 then
|
|
TreeViewError('TTreeStrings.Add: Invalid level, Level='+IntToStr(Level)
|
|
+' OldLevel='+IntToStr(OldLevel));
|
|
end
|
|
else begin
|
|
for I := OldLevel downto Level do
|
|
begin
|
|
Node := Node.Parent;
|
|
if (Node = nil) and (I - Level > 0) then
|
|
TreeViewError('TTreeStrings.Add: Invalid level, Node=nil I='+IntToStr(I)
|
|
+' Level='+IntToStr(Level));
|
|
end;
|
|
end;
|
|
Owner.AddChild(Node, NewStr);
|
|
end;
|
|
|
|
procedure TTreeStrings.Insert(Index: Integer; const S: string);
|
|
begin
|
|
with Owner do
|
|
Insert(GetNodeFromIndex(Index), S);
|
|
end;
|
|
|
|
procedure TTreeStrings.LoadTreeFromStream(Stream: TStream);
|
|
var
|
|
List: TStringList;
|
|
ANode, NextNode: TTreeNode;
|
|
ALevel, i: Integer;
|
|
CurrStr: string;
|
|
ok: boolean;
|
|
begin
|
|
List := TStringList.Create;
|
|
Owner.BeginUpdate;
|
|
ok:=false;
|
|
try
|
|
Clear;
|
|
List.LoadFromStream(Stream);
|
|
ANode := nil;
|
|
for i := 0 to List.Count - 1 do
|
|
begin
|
|
CurrStr := GetBufStart(PChar(List[i]), ALevel);
|
|
if ANode = nil then
|
|
ANode := Owner.AddChild(nil, CurrStr)
|
|
else if ANode.Level = ALevel then
|
|
ANode := Owner.AddChild(ANode.Parent, CurrStr)
|
|
else if ANode.Level = (ALevel - 1) then
|
|
ANode := Owner.AddChild(ANode, CurrStr)
|
|
else if ANode.Level > ALevel then
|
|
begin
|
|
NextNode := ANode.Parent;
|
|
while NextNode.Level > ALevel do
|
|
NextNode := NextNode.Parent;
|
|
ANode := Owner.AddChild(NextNode.Parent, CurrStr);
|
|
end
|
|
else TreeViewError('TTreeStrings.LoadTreeFromStream: Level='
|
|
+IntToStr(ALevel)+' CuurStr="'+CurrStr+'"');
|
|
end;
|
|
ok:=true;
|
|
finally
|
|
Owner.EndUpdate;
|
|
List.Free;
|
|
if not ok then
|
|
Owner.Owner.Invalidate; // force repaint on exception
|
|
end;
|
|
end;
|
|
|
|
procedure TTreeStrings.SaveTreeToStream(Stream: TStream);
|
|
const
|
|
TabChar = #9;
|
|
EndOfLine = #13#10;
|
|
var
|
|
i: Integer;
|
|
ANode: TTreeNode;
|
|
NodeStr: string;
|
|
begin
|
|
if Count > 0 then
|
|
begin
|
|
ANode := Owner[0];
|
|
while ANode <> nil do
|
|
begin
|
|
NodeStr := '';
|
|
for i := 0 to ANode.Level - 1 do NodeStr := NodeStr + TabChar;
|
|
NodeStr := NodeStr + ANode.Text + EndOfLine;
|
|
Stream.Write(Pointer(NodeStr)^, Length(NodeStr));
|
|
ANode := ANode.GetNext;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TTreeStrings.ConsistencyCheck: integer;
|
|
begin
|
|
Result:=0;
|
|
end;
|
|
|
|
procedure TTreeStrings.WriteDebugReport(const Prefix: string);
|
|
begin
|
|
DebugLn('%sTTreeStrings.WriteDebugReport Self=%p Consistency=%d', [Prefix, Pointer(Self), ConsistencyCheck]);
|
|
end;
|
|
|
|
|
|
{ TCustomTreeView }
|
|
|
|
constructor TCustomTreeView.Create(AnOwner: TComponent);
|
|
begin
|
|
inherited Create(AnOwner);
|
|
ControlStyle := ControlStyle - [csCaptureMouse]
|
|
+ [csDisplayDragImage, csReflector];
|
|
Width := 121;
|
|
Height := 97;
|
|
TabStop := True;
|
|
ParentColor := False;
|
|
FBackgroundColor := clWhite;
|
|
FDefItemHeight:=20;
|
|
FExpandSignType:=tvestPlusMinus;
|
|
FExpandSignSize:=9;
|
|
FTreeNodes := TTreeNodes.Create(Self);
|
|
BorderStyle := bsSingle;
|
|
BorderWidth := 0;
|
|
FOptions := DefaultTreeViewOptions;
|
|
Items.KeepCollapsedNodes:=KeepCollapsedNodes;
|
|
FScrollBars:=ssBoth;
|
|
FDragImage := TDragImageList.CreateSize(32, 32);
|
|
FIndent:=15;
|
|
FChangeTimer := TTimer.Create(Self);
|
|
FChangeTimer.Enabled := False;
|
|
FChangeTimer.Interval := 1;
|
|
FChangeTimer.OnTimer := @OnChangeTimer;
|
|
FImageChangeLink := TChangeLink.Create;
|
|
FImageChangeLink.OnChange := @ImageListChange;
|
|
FSelectedColor:=clHighlight;
|
|
fSeparatorColor:=clGray;
|
|
FStateChangeLink := TChangeLink.Create;
|
|
FStateChangeLink.OnChange := @ImageListChange;
|
|
FStates:=[tvsMaxLvlNeedsUpdate,tvsMaxRightNeedsUpdate,tvsScrollbarChanged];
|
|
FTreeLineColor := cl3DLight;
|
|
FExpandSignColor := clWindowFrame;
|
|
|
|
end;
|
|
|
|
destructor TCustomTreeView.Destroy;
|
|
begin
|
|
Images:=nil;
|
|
FreeThenNil(FTreeNodes);
|
|
FreeThenNil(FSaveItems);
|
|
FreeThenNil(FDragImage);
|
|
FreeThenNil(FImageChangeLink);
|
|
FreeThenNil(FStateChangeLink);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TCustomTreeView.CreateParams(var Params: TCreateParams);
|
|
const
|
|
ScrollBar: array[TScrollStyle] of DWORD = (0, WS_HSCROLL, WS_VSCROLL,
|
|
WS_HSCROLL or WS_VSCROLL, WS_HSCROLL, WS_VSCROLL, WS_HSCROLL or WS_VSCROLL);
|
|
BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
|
|
ClassStylesOff = CS_VREDRAW or CS_HREDRAW;
|
|
begin
|
|
inherited CreateParams(Params);
|
|
with Params do begin
|
|
{$IFOPT R+}{$DEFINE RangeCheckOn}{$R-}{$ENDIF}
|
|
WindowClass.Style := WindowClass.Style and not Cardinal(ClassStylesOff);
|
|
Style := Style or ScrollBar[FScrollBars] or BorderStyles[BorderStyle]
|
|
or WS_CLIPCHILDREN;
|
|
{$IFDEF RangeCheckOn}{$R+}{$ENDIF}
|
|
if NewStyleControls and Ctl3D and (BorderStyle = bsSingle) then begin
|
|
Style := Style and not Cardinal(WS_BORDER);
|
|
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.CreateWnd;
|
|
begin
|
|
Exclude(FStates,tvsStateChanging);
|
|
inherited CreateWnd;
|
|
end;
|
|
|
|
procedure TCustomTreeView.InitializeWnd;
|
|
begin
|
|
inherited InitializeWnd;
|
|
UpdateDefaultItemHeight;
|
|
end;
|
|
|
|
procedure TCustomTreeView.Invalidate;
|
|
begin
|
|
if tvsPainting in FStates then exit;
|
|
inherited Invalidate;
|
|
end;
|
|
|
|
procedure TCustomTreeView.EraseBackground(DC: HDC);
|
|
begin
|
|
// everything is painted, so erasing the background is not needed
|
|
end;
|
|
|
|
procedure TCustomTreeView.DestroyWnd;
|
|
begin
|
|
Include(FStates,tvsStateChanging);
|
|
inherited DestroyWnd;
|
|
if Canvas<>nil then
|
|
TControlCanvas(Canvas).FreeHandle;
|
|
end;
|
|
|
|
procedure TCustomTreeView.BeginUpdate;
|
|
begin
|
|
inc(FUpdateCount);
|
|
LockSelectionChangeEvent;
|
|
end;
|
|
|
|
procedure TCustomTreeView.EndUpdate;
|
|
begin
|
|
UnlockSelectionChangeEvent;
|
|
if FUpdateCount<=0 then RaiseGDBException('TCustomTreeView.EndUpdate');
|
|
dec(FUpdateCount);
|
|
if FUpdateCount=0 then begin
|
|
// ToDo: only refresh if something changed
|
|
UpdateScrollBars;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
function TCustomTreeView.AlphaSort: Boolean;
|
|
var
|
|
Node: TTreeNode;
|
|
begin
|
|
if HandleAllocated then begin
|
|
BeginUpdate;
|
|
Result := CustomSort(nil);
|
|
Node := FTreeNodes.GetFirstNode;
|
|
while Node <> nil do begin
|
|
if Node.HasChildren then Node.AlphaSort;
|
|
Node := Node.GetNext;
|
|
end;
|
|
EndUpdate;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function TCustomTreeView.CustomSort(SortProc: TTreeNodeCompare): Boolean;
|
|
var Node: TTreeNode;
|
|
begin
|
|
Result := False;
|
|
if HandleAllocated then begin
|
|
// ToDo: sort root nodes
|
|
|
|
Node := FTreeNodes.GetFirstNode;
|
|
while Node <> nil do begin
|
|
if Node.HasChildren then Node.CustomSort(SortProc);
|
|
Node := Node.GetNext;
|
|
end;
|
|
Items.ClearCache;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetAutoExpand(Value: Boolean);
|
|
begin
|
|
if AutoExpand <> Value then begin
|
|
if Value then
|
|
Include(FOptions,tvoAutoExpand)
|
|
else
|
|
Exclude(FOptions,tvoAutoExpand);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetHotTrack(Value: Boolean);
|
|
begin
|
|
if HotTrack <> Value then begin
|
|
if Value then
|
|
Include(FOptions,tvoHotTrack)
|
|
else
|
|
Exclude(FOptions,tvoHotTrack);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetRowSelect(Value: Boolean);
|
|
begin
|
|
if RowSelect <> Value then begin
|
|
if Value then
|
|
Include(FOptions,tvoRowSelect)
|
|
else
|
|
Exclude(FOptions,tvoRowSelect);
|
|
if FSelectedNode<>nil then
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetScrollBars(const Value: TScrollStyle);
|
|
begin
|
|
if (FScrollBars <> Value) then begin
|
|
FScrollBars := Value;
|
|
Include(FStates,tvsScrollbarChanged);
|
|
// TODO: Remove RecreateWnd
|
|
RecreateWnd(Self);
|
|
UpdateScrollBars;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetScrolledLeft(AValue: integer);
|
|
begin
|
|
if AValue<0 then AValue:=0;
|
|
if AValue=FScrolledLeft then exit;
|
|
if AValue>GetMaxScrollLeft then AValue:=GetMaxScrollLeft;
|
|
if AValue=FScrolledLeft then exit;
|
|
FScrolledLeft:=AValue;
|
|
Include(FStates,tvsScrollbarChanged);
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetScrolledTop(AValue: integer);
|
|
begin
|
|
if FScrolledTop=AValue then exit;
|
|
if AValue<0 then AValue:=0;
|
|
if AValue>GetMaxScrollTop then AValue:=GetMaxScrollTop;
|
|
if AValue=FScrolledTop then exit;
|
|
FScrolledTop:=AValue;
|
|
FStates:=FStates+[tvsTopItemNeedsUpdate,tvsBottomItemNeedsUpdate,
|
|
tvsScrollbarChanged];
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetToolTips(Value: Boolean);
|
|
begin
|
|
if ToolTips <> Value then begin
|
|
if Value then
|
|
Include(FOptions,tvoToolTips)
|
|
else
|
|
Exclude(FOptions,tvoToolTips);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetSortType(Value: TSortType);
|
|
begin
|
|
if SortType <> Value then begin
|
|
FSortType := Value;
|
|
if ((SortType in [stData, stBoth]) and Assigned(OnCompare)) or
|
|
(SortType in [stText, stBoth]) then
|
|
AlphaSort;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetBackgroundColor(Value: TColor);
|
|
begin
|
|
if FBackgroundColor<>Value then begin
|
|
FBackgroundColor:=Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetSelectedColor(Value: TColor);
|
|
begin
|
|
if FSelectedColor<>Value then begin
|
|
FSelectedColor:=Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.Paint;
|
|
begin
|
|
DoPaint;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetDragMode(Value: TDragMode);
|
|
begin
|
|
inherited SetDragMode(Value);
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetOptions(NewOptions: TTreeViewOptions);
|
|
var ChangedOptions: TTreeViewOptions;
|
|
begin
|
|
if FOptions=NewOptions then exit;
|
|
ChangedOptions:=(FOptions-NewOptions)+(NewOptions-FOptions);
|
|
FOptions:=NewOptions;
|
|
if tvoKeepCollapsedNodes in ChangedOptions then
|
|
Items.KeepCollapsedNodes:=(tvoKeepCollapsedNodes in FOptions);
|
|
if (tvoReadOnly in ChangedOptions) and (not (tvoReadOnly in FOptions)) then
|
|
EndEditing;
|
|
if (tvoAllowMultiselect in ChangedOptions) then begin
|
|
if (tvoAllowMultiselect in FOptions) then begin
|
|
if Selected<>nil then Selected.MultiSelected:=true;
|
|
end else begin
|
|
Items.ClearMultiSelection;
|
|
end;
|
|
end;
|
|
if tvoAutoItemHeight in ChangedOptions then
|
|
UpdateDefaultItemHeight;
|
|
if ([tvoHideSelection,tvoReadOnly,tvoShowButtons,tvoShowRoot,tvoShowLines]
|
|
* ChangedOptions)<>[]
|
|
then
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomTreeView.UpdateDefaultItemHeight;
|
|
var
|
|
NewDefItemHeight: Integer;
|
|
begin
|
|
if (tvoAutoItemHeight in FOptions)
|
|
and HandleAllocated and Canvas.HandleAllocated then begin
|
|
NewDefItemHeight:=Canvas.TextHeight(TVAutoHeightString)+2; // +2 for border
|
|
if NewDefItemHeight<2 then NewDefItemHeight:=2;
|
|
if (Images<>nil) and (Images.Height>NewDefItemHeight) then
|
|
NewDefItemHeight:=Images.Height;
|
|
if (StateImages<>nil) and (StateImages.Height>NewDefItemHeight) then
|
|
NewDefItemHeight:=StateImages.Height;
|
|
if NewDefItemHeight<>FDefItemHeight then begin
|
|
FDefItemHeight:=NewDefItemHeight;
|
|
FStates:=FStates+[tvsTopsNeedsUpdate,tvsTopItemNeedsUpdate,
|
|
tvsBottomItemNeedsUpdate];
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.UpdateAllTops;
|
|
|
|
procedure CalculateTops(FirstSibling: TTreeNode; var CurTop: integer;
|
|
Expanded: boolean);
|
|
begin
|
|
while FirstSibling<>nil do begin
|
|
FirstSibling.fTop:=CurTop;
|
|
if Expanded then
|
|
inc(CurTop,FirstSibling.Height);
|
|
CalculateTops(FirstSibling.GetFirstChild,CurTop,
|
|
Expanded and FirstSibling.Expanded);
|
|
FirstSibling:=FirstSibling.GetNextSibling;
|
|
end;
|
|
end;
|
|
|
|
var i: integer;
|
|
begin
|
|
if not (tvsTopsNeedsUpdate in FStates) then exit;
|
|
i:=0;
|
|
CalculateTops(Items.GetFirstNode,i,true);
|
|
Exclude(FStates,tvsTopsNeedsUpdate);
|
|
Include(FStates,tvsScrollbarChanged);
|
|
end;
|
|
|
|
procedure TCustomTreeView.UpdateMaxLvl;
|
|
|
|
procedure LookInChildsAndBrothers(Node: TTreeNode; CurLvl: integer);
|
|
begin
|
|
if Node=nil then exit;
|
|
if CurLvl>FMaxLvl then FMaxLvl:=CurLvl;
|
|
LookInChildsAndBrothers(Node.GetFirstChild,CurLvl+1);
|
|
LookInChildsAndBrothers(Node.GetNextSibling,CurLvl);
|
|
end;
|
|
|
|
begin
|
|
if not (tvsMaxLvlNeedsUpdate in FStates) then exit;
|
|
FMaxLvl:=0;
|
|
LookInChildsAndBrothers(Items.GetFirstNode,1);
|
|
Exclude(FStates,tvsMaxRightNeedsUpdate);
|
|
end;
|
|
|
|
procedure TCustomTreeView.UpdateMaxRight;
|
|
var Node: TTreeNode;
|
|
i: integer;
|
|
begin
|
|
if not (tvsMaxRightNeedsUpdate in FStates) then exit;
|
|
FMaxRight:=0;
|
|
Node:=Items.GetFirstNode;
|
|
while Node<>nil do begin
|
|
i:=Node.DisplayTextRight;
|
|
if FMaxRight<i then FMaxRight:=i;
|
|
Node:=Node.GetNext;
|
|
end;
|
|
Exclude(FStates,tvsMaxRightNeedsUpdate);
|
|
Include(FStates,tvsScrollbarChanged);
|
|
end;
|
|
|
|
procedure TCustomTreeView.UpdateTopItem;
|
|
begin
|
|
//DebugLn('TCustomTreeView.UpdateTopItem tvsTopItemNeedsUpdate in FStates=',tvsTopItemNeedsUpdate in FStates);
|
|
if (FStates*[tvsTopItemNeedsUpdate,tvsTopsNeedsUpdate]=[]) then exit;
|
|
FTopItem:=GetNodeAtY(BorderWidth);
|
|
Exclude(FStates,tvsTopItemNeedsUpdate);
|
|
end;
|
|
|
|
procedure TCustomTreeView.UpdateBottomItem;
|
|
begin
|
|
if (FStates*[tvsTopItemNeedsUpdate,tvsTopsNeedsUpdate,
|
|
tvsBottomItemNeedsUpdate]=[])
|
|
then exit;
|
|
if not (tvsBottomItemNeedsUpdate in FStates) then exit;
|
|
FBottomItem:=TopItem;
|
|
while (FBottomItem<>nil) and (FBottomItem.GetNextVisible<>nil) do
|
|
FBottomItem:=FBottomItem.GetNextVisible;
|
|
Exclude(FStates,tvsBottomItemNeedsUpdate);
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetBottomItem(Value: TTreeNode);
|
|
begin
|
|
if HandleAllocated and (Value <> nil) then begin
|
|
Value.MakeVisible;
|
|
ScrolledTop:=Value.Top+Value.Height-(ClientHeight-ScrollBarWidth);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetShowButton(Value: Boolean);
|
|
begin
|
|
if ShowButtons <> Value then begin
|
|
if Value then
|
|
Include(FOptions,tvoShowButtons)
|
|
else
|
|
Exclude(FOptions,tvoShowButtons);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetShowLines(Value: Boolean);
|
|
begin
|
|
if ShowLines <> Value then begin
|
|
if Value then
|
|
Include(FOptions,tvoShowLines)
|
|
else
|
|
Exclude(FOptions,tvoShowLines);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetShowRoot(Value: Boolean);
|
|
begin
|
|
if ShowRoot <> Value then begin
|
|
if Value then
|
|
Include(FOptions,tvoShowRoot)
|
|
else
|
|
Exclude(FOptions,tvoShowRoot);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetShowSeparators(Value: Boolean);
|
|
begin
|
|
if ShowSeparators <> Value then begin
|
|
if Value then
|
|
Include(FOptions,tvoShowSeparators)
|
|
else
|
|
Exclude(FOptions,tvoShowSeparators);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetKeepCollapsedNodes(Value: Boolean);
|
|
begin
|
|
if KeepCollapsedNodes=Value then exit;
|
|
if Value then
|
|
Include(FOptions,tvoKeepCollapsedNodes)
|
|
else
|
|
Exclude(FOptions,tvoKeepCollapsedNodes);
|
|
Items.KeepCollapsedNodes:=Value;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetReadOnly(Value: Boolean);
|
|
begin
|
|
if ReadOnly <> Value then begin
|
|
if Value then
|
|
Include(FOptions,tvoRightClickSelect)
|
|
else
|
|
Exclude(FOptions,tvoRightClickSelect);
|
|
if not Value then EndEditing;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetRightClickSelect(Value: Boolean);
|
|
begin
|
|
if Value then
|
|
Include(FOptions,tvoRightClickSelect)
|
|
else
|
|
Exclude(FOptions,tvoRightClickSelect);
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetHideSelection(Value: Boolean);
|
|
begin
|
|
if HideSelection <> Value then begin
|
|
if Value then
|
|
Include(FOptions,tvoHideSelection)
|
|
else
|
|
Exclude(FOptions,tvoHideSelection);
|
|
if FSelectedNode<>nil then Invalidate;
|
|
end;
|
|
end;
|
|
|
|
function TCustomTreeView.GetMaxLvl: integer;
|
|
begin
|
|
UpdateMaxRight;
|
|
Result:=FMaxRight;
|
|
end;
|
|
|
|
function TCustomTreeView.GetMaxScrollLeft: integer;
|
|
begin
|
|
UpdateMaxRight;
|
|
Result:=FMaxRight-(ClientWidth-ScrollBarWidth-2*BorderWidth);
|
|
if Result<0 then Result:=0;
|
|
end;
|
|
|
|
function TCustomTreeView.GetMaxScrollTop: integer;
|
|
var LastVisibleNode: TTreeNode;
|
|
begin
|
|
LastVisibleNode:=Items.GetLastExpandedSubNode;
|
|
if LastVisibleNode=nil then
|
|
Result:=0
|
|
else begin
|
|
Result:=LastVisibleNode.Top+LastVisibleNode.Height
|
|
-(ClientHeight-ScrollBarWidth)+2*BorderWidth;
|
|
//DebugLn('>>> ',LastVisibleNode.Text,' ',Result);
|
|
if Result<0 then Result:=0;
|
|
end;
|
|
end;
|
|
|
|
function TCustomTreeView.GetNodeAtInternalY(Y: Integer): TTreeNode;
|
|
// search in all expanded nodes for the node at the absolute coordinate Y
|
|
var i: integer;
|
|
begin
|
|
i:=IndexOfNodeAtTop(Items.FTopLvlItems,Items.FTopLvlCount,Y);
|
|
if i>=0 then begin
|
|
Result:=Items.FTopLvlItems[i];
|
|
while Result.Expanded do begin
|
|
i:=IndexOfNodeAtTop(Result.FItems,Result.FCount,Y);
|
|
if i>=0 then
|
|
Result:=Result.Items[i]
|
|
else
|
|
break;
|
|
end;
|
|
end else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TCustomTreeView.GetNodeAtY(Y: Integer): TTreeNode;
|
|
// search in all expanded nodes for the node at the screen coordinate Y
|
|
begin
|
|
Result:=nil;
|
|
if (Y>=BorderWidth) and (Y<(ClientHeight-ScrollBarWidth)-BorderWidth) then
|
|
begin
|
|
inc(Y,FScrolledTop-BorderWidth);
|
|
Result:=GetNodeAtInternalY(Y);
|
|
end;
|
|
end;
|
|
|
|
function TCustomTreeView.GetNodeDrawAreaWidth: integer;
|
|
begin
|
|
Result:=ClientWidth-ScrollBarWidth-BorderWidth*2;
|
|
end;
|
|
|
|
function TCustomTreeView.GetNodeDrawAreaHeight: integer;
|
|
begin
|
|
Result:=ClientHeight-ScrollBarWidth-BorderWidth*2;
|
|
end;
|
|
|
|
function TCustomTreeView.GetNodeAt(X, Y: Integer): TTreeNode;
|
|
begin
|
|
Result:=nil;
|
|
if (X>=BorderWidth) and (X<ClientWidth-BorderWidth) then begin
|
|
Result:=GetNodeAtY(Y);
|
|
if Result<>nil then begin
|
|
inc(X,FScrolledLeft-BorderWidth);
|
|
if (X<Result.DisplayExpandSignLeft) then
|
|
Result:=nil;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.GetInsertMarkAt(X, Y: Integer;
|
|
var AnInsertMarkNode: TTreeNode; var AnInsertMarkType: TTreeViewInsertMarkType
|
|
);
|
|
var
|
|
ANode: TTreeNode;
|
|
NodeRect: TRect;
|
|
NodeMidY: integer;
|
|
begin
|
|
if Y<0 then Y:=0;
|
|
if Y>=ClientHeight then Y:=ClientHeight-1;
|
|
ANode:=GetNodeAtY(Y);
|
|
if ANode<>nil then begin
|
|
AnInsertMarkNode:=ANode;
|
|
if (X>AnInsertMarkNode.DisplayExpandSignRight) then
|
|
// insert as first child of pointed node
|
|
AnInsertMarkType:=tvimAsFirstChild
|
|
else begin
|
|
NodeRect:=ANode.DisplayRect(false);
|
|
NodeMidY:=(NodeRect.Top+NodeRect.Bottom) div 2;
|
|
if Y>=NodeMidY then begin
|
|
if ANode.Expanded and ANode.HasChildren then begin
|
|
// insert as first child of pointed node
|
|
AnInsertMarkType:=tvimAsFirstChild;
|
|
end else begin
|
|
// insert as next sibling of pointed node
|
|
AnInsertMarkType:=tvimAsNextSibling;
|
|
end;
|
|
end else begin
|
|
AnInsertMarkType:=tvimAsPrevSibling;
|
|
end;
|
|
end;
|
|
end else begin
|
|
// insert behind all nodes
|
|
ANode:=Items.GetLastExpandedSubNode;
|
|
if ANode<>nil then begin
|
|
AnInsertMarkNode:=ANode;
|
|
if X>AnInsertMarkNode.DisplayExpandSignRight then
|
|
// insert as first child of last visible node
|
|
AnInsertMarkType:=tvimAsFirstChild
|
|
else
|
|
// insert as next sibling of last visible node
|
|
AnInsertMarkType:=tvimAsNextSibling;
|
|
end else begin
|
|
// insert as new root
|
|
AnInsertMarkNode:=nil;
|
|
AnInsertMarkType:=tvimAsFirstChild;
|
|
end;
|
|
end;
|
|
|
|
// normalize (try to replace tvimAsPrevSibling)
|
|
if (AnInsertMarkType=tvimAsPrevSibling) and (AnInsertMarkNode<>nil) then begin
|
|
if (AnInsertMarkNode.GetPrevSibling<>nil) then begin
|
|
if (AnInsertMarkNode.GetPrevSibling.Expanded=false)
|
|
and (AnInsertMarkNode.GetPrevSibling.IsVisible) then begin
|
|
AnInsertMarkNode:=AnInsertMarkNode.GetPrevSibling;
|
|
AnInsertMarkType:=tvimAsNextSibling;
|
|
end;
|
|
end else if (AnInsertMarkNode.Parent<>nil)
|
|
and (AnInsertMarkNode.IsVisible) then begin
|
|
AnInsertMarkNode:=AnInsertMarkNode.Parent;
|
|
AnInsertMarkType:=tvimAsFirstChild;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetInsertMark(AnInsertMarkNode: TTreeNode;
|
|
AnInsertMarkType: TTreeViewInsertMarkType);
|
|
begin
|
|
InsertMarkNode:=AnInsertMarkNode;
|
|
InsertMarkType:=AnInsertMarkType;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetInsertMarkAt(X, Y: integer);
|
|
var
|
|
AnInsertMarkNode: TTreeNode;
|
|
AnInsertMarkType: TTreeViewInsertMarkType;
|
|
begin
|
|
GetInsertMarkAt(X,Y,AnInsertMarkNode,AnInsertMarkType);
|
|
SetInsertMark(AnInsertMarkNode,AnInsertMarkType);
|
|
end;
|
|
|
|
function TCustomTreeView.GetHitTestInfoAt(X, Y: Integer): THitTests;
|
|
var Node: TTreeNode;
|
|
begin
|
|
Result := [];
|
|
if (X>=0) and (X<ClientWidth) and (Y>=0) and (Y<(ClientHeight-ScrollBarWidth))
|
|
then begin
|
|
inc(Y,FScrolledTop);
|
|
Node:=GetNodeAtY(Y);
|
|
if Node<>nil then begin
|
|
inc(X,FScrolledLeft);
|
|
if X<Node.DisplayExpandSignLeft then
|
|
Include(Result,htOnIndent)
|
|
else if X<Node.DisplayIconLeft then
|
|
Include(Result,htOnButton)
|
|
else if X<Node.DisplayStateIconLeft then
|
|
Include(Result,htOnItem)
|
|
else if X<Node.DisplayTextLeft then
|
|
Include(Result,htOnStateIcon)
|
|
else if X<Node.DisplayTextRight then
|
|
Include(Result,htOnLabel);
|
|
end else
|
|
Include(Result,htNowhere);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetTreeLineColor(Value: TColor);
|
|
begin
|
|
if FTreeLineColor<>Value then begin
|
|
FTreeLineColor:=Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetTreeNodes(Value: TTreeNodes);
|
|
begin
|
|
Items.Assign(Value);
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetIndent(Value: Integer);
|
|
begin
|
|
if Value <> Indent then begin
|
|
FIndent := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.FullExpand;
|
|
var
|
|
Node: TTreeNode;
|
|
begin
|
|
Node := Items.GetFirstNode;
|
|
while Node <> nil do begin
|
|
Node.Expand(True);
|
|
Node := Node.GetNextSibling;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.FullCollapse;
|
|
var
|
|
Node: TTreeNode;
|
|
begin
|
|
Node := Items.GetFirstNode;
|
|
while Node <> nil do begin
|
|
Node.Collapse(True);
|
|
Node := Node.GetNextSibling;
|
|
end;
|
|
end;
|
|
|
|
function TCustomTreeView.IsNodeVisible(ANode: TTreeNode): Boolean;
|
|
begin
|
|
Result:=(ANode<>nil) and (ANode.AreParentsExpanded);
|
|
//DebugLn('[TCustomTreeView.IsNodeVisible] A Node=',DbgS(ANode),
|
|
//' ANode.AreParentsExpanded=',ANode.AreParentsExpanded);
|
|
if Result then begin
|
|
//DebugLn('[TCustomTreeView.IsNodeVisible] B Node=',DbgS(ANode),
|
|
// ' ',dbgs(FScrolledTop)+'>=',dbgs(ANode.Top+ANode.Height)+' or =',dbgs(FScrolledTop),'+'+dbgs(ClientHeight)+'<',dbgs(ANode.Top));
|
|
if (FScrolledTop>=ANode.Top+ANode.Height)
|
|
or (FScrolledTop+(ClientHeight-ScrollBarWidth)-2*BorderWidth<ANode.Top)
|
|
then
|
|
Result:=false;
|
|
end;
|
|
//DebugLn('[TCustomTreeView.IsNodeVisible] END Node=',DbgS(ANode),
|
|
//' Node.Text=',ANode.Text,' Visible=',Result);
|
|
end;
|
|
|
|
function TCustomTreeView.IsNodeHeightFullVisible(ANode: TTreeNode): Boolean;
|
|
begin
|
|
Result:=(ANode<>nil) and (ANode.AreParentsExpanded);
|
|
//DebugLn('[TCustomTreeView.IsNodeVisible] A Node=',DbgS(ANode),
|
|
//' ANode.AreParentsExpanded=',ANode.AreParentsExpanded);
|
|
if Result then begin
|
|
//DebugLn('[TCustomTreeView.IsNodeVisible] B Node=',DbgS(ANode),
|
|
//' ',FScrolledTop,'>=',ANode.Top,'+',ANode.Height,' or ',FScrolledTop,'+',ClientHeight,'<',ANode.Top);
|
|
if (FScrolledTop>ANode.Top)
|
|
or (FScrolledTop+(ClientHeight-ScrollBarWidth)-2*BorderWidth
|
|
<ANode.Top+ANode.Height)
|
|
then
|
|
Result:=false;
|
|
end;
|
|
//DebugLn('[TCustomTreeView.IsNodeVisible] END Node=',DbgS(ANode),
|
|
//' Node.Text=',ANode.Text,' Visible=',Result);
|
|
end;
|
|
|
|
procedure TCustomTreeView.KeyDown(var Key: Word; Shift: TShiftState);
|
|
var
|
|
I: Integer;
|
|
Node: TTreeNode;
|
|
begin
|
|
inherited KeyDown(Key, Shift);
|
|
|
|
case Key of
|
|
|
|
VK_Down:
|
|
if (Selected<>nil) and (Selected.GetNextExpanded<>nil) then begin
|
|
Selected:=Selected.GetNextExpanded;
|
|
Key:=VK_UNKNOWN;
|
|
end;
|
|
|
|
VK_Up:
|
|
if (Selected<>nil) and (Selected.GetPrevExpanded<>nil) then begin
|
|
Selected:=Selected.GetPrevExpanded;
|
|
Key:=VK_UNKNOWN;
|
|
end;
|
|
|
|
VK_LEFT:
|
|
if (Selected<>nil) then
|
|
begin
|
|
if Selected.Expanded then
|
|
Selected.Expanded := False
|
|
else
|
|
if (Selected.GetPrevExpanded = Selected.Parent) and
|
|
(Selected.Parent <> nil) then Selected := Selected.Parent;
|
|
end;
|
|
|
|
VK_RIGHT:
|
|
if (Selected<>nil) then
|
|
begin
|
|
if Selected.Expanded then
|
|
Selected := Selected.GetNextExpanded
|
|
else
|
|
Selected.Expanded := True;
|
|
end;
|
|
|
|
VK_ADD:
|
|
if (Selected<>nil) then Selected.Expanded := True;
|
|
|
|
VK_SUBTRACT:
|
|
if (Selected<>nil) then Selected.Expanded := False;
|
|
|
|
VK_HOME:
|
|
if Items.Count > 0 then
|
|
Selected := Items[0];
|
|
|
|
VK_END:
|
|
if Items.Count > 0 then
|
|
Selected := Items.GetLastExpandedSubNode;
|
|
|
|
VK_PRIOR: // Page Up
|
|
if (Selected <> nil) then
|
|
begin
|
|
I := Pred(ClientHeight div DefaultItemHeight);
|
|
Node := Selected;
|
|
|
|
while (I > 0) do
|
|
if Node.GetPrevExpanded <> nil then
|
|
begin
|
|
Node := Node.GetPrevExpanded;
|
|
Dec(I);
|
|
end
|
|
else Break;
|
|
|
|
Selected := Node;
|
|
end;
|
|
|
|
VK_NEXT: // Page Down
|
|
if (Selected <> nil) then
|
|
begin
|
|
I := Pred(ClientHeight div DefaultItemHeight);
|
|
Node := Selected;
|
|
|
|
while (I > 0) do
|
|
if Node.GetNextExpanded <> nil then
|
|
begin
|
|
Node := Node.GetNextExpanded;
|
|
Dec(I);
|
|
end
|
|
else Break;
|
|
|
|
Selected := Node;
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
if csDesigning in ComponentState then FullExpand;
|
|
UpdateDefaultItemHeight;
|
|
end;
|
|
|
|
function TCustomTreeView.GetTopItem: TTreeNode;
|
|
begin
|
|
if HandleAllocated then begin
|
|
UpdateTopItem;
|
|
Result := FTopItem;
|
|
end else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetTopItem(Value: TTreeNode);
|
|
begin
|
|
if HandleAllocated and (Value <> nil) then begin
|
|
Value.MakeVisible;
|
|
ScrolledTop:=Value.Top;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.OnChangeTimer(Sender: TObject);
|
|
begin
|
|
FChangeTimer.Enabled := False;
|
|
//debugln('TCustomTreeView.OnChangeTimer');
|
|
Change(FSelectedNode);
|
|
end;
|
|
|
|
procedure TCustomTreeView.UpdateScrollbars;
|
|
|
|
function Max(i1, i2: integer): integer;
|
|
begin
|
|
if i1>i2 then
|
|
Result:=i1
|
|
else
|
|
Result:=i2;
|
|
end;
|
|
|
|
var
|
|
ScrollInfo: TScrollInfo;
|
|
begin
|
|
if not (tvsScrollbarChanged in FStates) then exit;
|
|
|
|
if not HandleAllocated or (FUpdateCount>0) then
|
|
exit;
|
|
|
|
if ScrolledLeft>GetMaxScrollLeft then ScrolledLeft:=GetMaxScrollLeft;
|
|
if ScrolledTop>GetMaxScrollTop then ScrolledTop:=GetMaxScrollTop;
|
|
Exclude(FStates,tvsScrollbarChanged);
|
|
|
|
if fScrollBars in [ssBoth, ssHorizontal, ssAutoBoth, ssAutoHorizontal] then
|
|
begin
|
|
// horizontal scrollbar
|
|
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
|
ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL;
|
|
ScrollInfo.nTrackPos := 0;
|
|
ScrollInfo.nMin := 0;
|
|
ScrollInfo.nPage := Max(1,(ClientWidth-ScrollBarWidth)-2*BorderWidth);
|
|
ScrollInfo.nMax := Max(1,GetMaxScrollLeft+integer(ScrollInfo.nPage)-1);
|
|
ScrollInfo.nPos := Max(FScrolledLeft,0);
|
|
if not CompareMem(@ScrollInfo,@FLastHorzScrollInfo,SizeOf(TScrollInfo))
|
|
then begin
|
|
if (fScrollBars in [ssAutoBoth, ssAutoHorizontal])
|
|
and (ScrollInfo.nPage>=cardinal(ScrollInfo.nMax)) then begin
|
|
FLastHorzScrollInfo.cbSize:=0;
|
|
ShowScrollBar(Handle, SB_HORZ, false);
|
|
end else begin
|
|
FLastHorzScrollInfo:=ScrollInfo;
|
|
ShowScrollBar(Handle, SB_HORZ, true);
|
|
SetScrollInfo(Handle, SB_HORZ, ScrollInfo, true);
|
|
end;
|
|
end;
|
|
//DebugLn('>>>>>>>>>> [TCustomTreeView.UpdateScrollbars] nMin=',ScrollInfo.nMin,
|
|
//' nMax=',ScrollInfo.nMax,' nPage=',ScrollInfo.nPage,
|
|
//' nPos=',ScrollInfo.nPos,' GetMaxScrollLeft=',GetMaxScrollLeft,
|
|
//' ClientW=',ClientWidth,
|
|
//' MaxRight=',FMaxRight
|
|
//);
|
|
end else begin
|
|
FLastHorzScrollInfo.cbSize:=0;
|
|
ShowScrollBar(Handle,SB_HORZ,false);
|
|
end;
|
|
|
|
if fScrollBars in [ssBoth, ssVertical, ssAutoBoth, ssAutoVertical] then begin
|
|
// vertical scrollbar
|
|
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
|
ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL;
|
|
ScrollInfo.nTrackPos := 0;
|
|
ScrollInfo.nMin := 0;
|
|
ScrollInfo.nPage := Max(1,(ClientHeight-ScrollBarWidth)-FDefItemHeight);
|
|
ScrollInfo.nMax := Max(1,GetMaxScrollTop+integer(ScrollInfo.nPage)-1);
|
|
ScrollInfo.nTrackPos := 0;
|
|
ScrollInfo.nPos := Max(0,FScrolledTop);
|
|
if not CompareMem(@ScrollInfo,@FLastVertScrollInfo,SizeOf(TScrollInfo))
|
|
then begin
|
|
if (fScrollBars in [ssAutoBoth, ssAutoVertical])
|
|
and (ScrollInfo.nPage>=cardinal(ScrollInfo.nMax)) then begin
|
|
FLastVertScrollInfo.cbSize:=0;
|
|
ShowScrollBar(Handle, SB_VERT, false);
|
|
end else begin
|
|
FLastVertScrollInfo:=ScrollInfo;
|
|
ShowScrollBar(Handle, SB_VERT, true);
|
|
SetScrollInfo(Handle, SB_VERT, ScrollInfo, true);
|
|
end;
|
|
end;
|
|
//DebugLn('>>>>>>>>>> [TCustomTreeView.UpdateScrollbars] Vert On nMin=',dbgs(ScrollInfo.nMin),
|
|
//' nMax=',dbgs(ScrollInfo.nMax),' nPage=',dbgs(ScrollInfo.nPage),
|
|
//' nPos=',dbgs(ScrollInfo.nPos),' GetMaxScrollTop=',dbgs(GetMaxScrollTop));
|
|
end else begin
|
|
//DebugLn('>>>>>>>>>> [TCustomTreeView.UpdateScrollbars] Vert Off ');
|
|
FLastVertScrollInfo.cbSize:=0;
|
|
ShowScrollBar(Handle,SB_VERT,false);
|
|
end;
|
|
end;
|
|
|
|
function TCustomTreeView.GetSelection: TTreeNode;
|
|
begin
|
|
if HandleAllocated then
|
|
begin
|
|
if RightClickSelect and Assigned(FRClickNode) then
|
|
Result := FRClickNode
|
|
else
|
|
Result := FSelectedNode;
|
|
end
|
|
else Result := nil;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetSelection(Value: TTreeNode);
|
|
var OldNode: TTreeNode;
|
|
begin
|
|
if FSelectedNode=Value then exit;
|
|
if not CanChange(FSelectedNode) then
|
|
exit;
|
|
OldNode:=FSelectedNode;
|
|
FSelectedNode:=Value;
|
|
if OldNode<>nil then begin
|
|
OldNode.Selected:=false;
|
|
end;
|
|
if Value <> nil then begin
|
|
Value.Selected := True;
|
|
Value.MakeVisible;
|
|
end;
|
|
InternalSelectionChanged;
|
|
end;
|
|
|
|
function TCustomTreeView.GetShowButtons: boolean;
|
|
begin
|
|
Result:=(tvoShowButtons in FOptions);
|
|
end;
|
|
|
|
function TCustomTreeView.GetShowLines: boolean;
|
|
begin
|
|
Result:=(tvoShowLines in FOptions);
|
|
end;
|
|
|
|
function TCustomTreeView.GetShowRoot: boolean;
|
|
begin
|
|
Result:=(tvoShowRoot in FOptions);
|
|
end;
|
|
|
|
function TCustomTreeView.GetShowSeparators: boolean;
|
|
begin
|
|
Result:=(tvoShowSeparators in FOptions);
|
|
end;
|
|
|
|
function TCustomTreeView.GetToolTips: boolean;
|
|
begin
|
|
Result:=(tvoToolTips in FOptions);
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetExpandSignType(Value: TTreeViewExpandSignType);
|
|
begin
|
|
if Value=FExpandSignType then exit;
|
|
FExpandSignType:=Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetDefaultItemHeight(Value: integer);
|
|
begin
|
|
if (tvoAutoItemHeight in FOptions) and (not (csLoading in ComponentState))
|
|
then exit;
|
|
if Value<=0 then Value:=20;
|
|
if Value=FDefItemHeight then exit;
|
|
FDefItemHeight:=Value;
|
|
Include(FStates,tvsTopsNeedsUpdate);
|
|
Invalidate;
|
|
end;
|
|
|
|
function TCustomTreeView.GetAutoExpand: boolean;
|
|
begin
|
|
Result:=(tvoAutoExpand in FOptions);
|
|
end;
|
|
|
|
function TCustomTreeView.GetBottomItem: TTreeNode;
|
|
begin
|
|
if HandleAllocated then begin
|
|
UpdateBottomItem;
|
|
Result := FBottomItem;
|
|
end else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TCustomTreeView.GetDropTarget: TTreeNode;
|
|
begin
|
|
if HandleAllocated then
|
|
begin
|
|
Result := FLastDropTarget;
|
|
end
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TCustomTreeView.GetHideSelection: boolean;
|
|
begin
|
|
Result:=(tvoHideSelection in FOptions);
|
|
end;
|
|
|
|
function TCustomTreeView.GetHotTrack: boolean;
|
|
begin
|
|
Result:=(tvoHotTrack in FOptions);
|
|
end;
|
|
|
|
function TCustomTreeView.GetKeepCollapsedNodes: boolean;
|
|
begin
|
|
Result:=(tvoKeepCollapsedNodes in FOptions);
|
|
end;
|
|
|
|
function TCustomTreeView.GetReadOnly: boolean;
|
|
begin
|
|
Result:=(tvoReadOnly in FOptions);
|
|
end;
|
|
|
|
function TCustomTreeView.GetRightClickSelect: boolean;
|
|
begin
|
|
Result:=(tvoRightClickSelect in FOptions);
|
|
end;
|
|
|
|
function TCustomTreeView.GetRowSelect: boolean;
|
|
begin
|
|
Result:=(tvoRowSelect in FOptions);
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetDropTarget(Value: TTreeNode);
|
|
begin
|
|
if HandleAllocated then
|
|
if Value <> nil then
|
|
Value.DropTarget := True;
|
|
{else
|
|
TreeView_SelectDropTarget(Handle, nil);}
|
|
end;
|
|
|
|
function TCustomTreeView.IsEditing: Boolean;
|
|
begin
|
|
Result:=tvsIsEditing in FStates;
|
|
end;
|
|
|
|
function TCustomTreeView.GetDragImages: TDragImageList;
|
|
begin
|
|
if FDragImage.Count > 0 then
|
|
Result := FDragImage
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TCustomTreeView.WndProc(var Message: TLMessage);
|
|
begin
|
|
inherited WndProc(Message);
|
|
end;
|
|
|
|
procedure TCustomTreeView.UpdateInsertMark(X,Y: integer);
|
|
begin
|
|
if (tvoAutoInsertMark in Options) and (not (csDesigning in ComponentState))
|
|
then
|
|
SetInsertMarkAt(X,Y)
|
|
else
|
|
SetInsertMark(nil,tvimNone);
|
|
end;
|
|
|
|
procedure TCustomTreeView.DoSelectionChanged;
|
|
begin
|
|
if Assigned(OnSelectionChanged) then OnSelectionChanged(Self);
|
|
end;
|
|
|
|
function TCustomTreeView.IsInsertMarkVisible: boolean;
|
|
begin
|
|
Result:=(FInsertMarkType<>tvimNone) and (FInsertMarkNode<>nil)
|
|
and (FInsertMarkNode.IsVisible);
|
|
end;
|
|
|
|
procedure TCustomTreeView.DoStartDrag(var DragObject: TDragObject);
|
|
var
|
|
P: TPoint;
|
|
begin
|
|
{$IFDEF VerboseDrag}
|
|
DebugLn('TCustomTreeView.DoStartDrag A ',Name,':',ClassName);
|
|
{$ENDIF}
|
|
inherited DoStartDrag(DragObject);
|
|
FLastDropTarget := nil;
|
|
if FDragNode = nil then begin
|
|
GetCursorPos(P);
|
|
with ScreenToClient(P) do FDragNode := GetNodeAt(X, Y);
|
|
{$IFDEF VerboseDrag}
|
|
if FDragNode<>nil then
|
|
DebugLn('TCustomTreeView.DoStartDrag DragNode=',FDragNode.Text)
|
|
else
|
|
DebugLn('TCustomTreeView.DoStartDrag DragNode=nil');
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.DoEndDrag(Target: TObject; X, Y: Integer);
|
|
begin
|
|
{$IFDEF VerboseDrag}
|
|
DebugLn('TCustomTreeView.DoEndDrag A ',Name,':',ClassName);
|
|
{$ENDIF}
|
|
inherited DoEndDrag(Target, X, Y);
|
|
FLastDropTarget := nil;
|
|
end;
|
|
|
|
procedure TCustomTreeView.CMDrag(var AMessage: TCMDrag);
|
|
begin
|
|
inherited CMDrag(AMessage);
|
|
{$IFDEF VerboseDrag}
|
|
DebugLn('TCustomTreeView.CMDrag ',Name,':',ClassName,' ',ord(AMessage.DragMessage));
|
|
{$ENDIF}
|
|
with AMessage, DragRec^ do
|
|
case DragMessage of
|
|
{dmDragMove:
|
|
begin
|
|
P:=ScreenToClient(Pos);
|
|
DoDragOver(Source, P.X, P.Y, AMessage.Result <> 0);
|
|
end;}
|
|
dmDragLeave:
|
|
begin
|
|
TDragObject(Source).HideDragImage;
|
|
FLastDropTarget := DropTarget;
|
|
DropTarget := nil;
|
|
TDragObject(Source).ShowDragImage;
|
|
end;
|
|
dmDragDrop: FLastDropTarget := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.DragOver(Source: TObject; X,Y: Integer;
|
|
State: TDragState; var Accept: Boolean);
|
|
var
|
|
Node: TTreeNode;
|
|
begin
|
|
inherited DragOver(Source,X,Y,State,Accept);
|
|
Node := GetNodeAt(X, Y);
|
|
{$IFDEF VerboseDrag}
|
|
DebugLn('TCustomTreeView.DragOver ',Name,':',ClassName,' ',Node<>nil,' ',Node <> DropTarget,' ',Node = FLastDropTarget);
|
|
{$ENDIF}
|
|
if (Node <> nil)
|
|
and ((Node <> DropTarget) or (Node = FLastDropTarget)) then
|
|
begin
|
|
FLastDropTarget := nil;
|
|
TDragObject(Source).HideDragImage;
|
|
Node.DropTarget := True;
|
|
TDragObject(Source).ShowDragImage;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.DoPaint;
|
|
var
|
|
a,HalfBorderWidth:integer;
|
|
SpaceRect, DrawRect: TRect;
|
|
Node: TTreeNode;
|
|
InsertMarkRect: TRect;
|
|
begin
|
|
if [tvsUpdating,tvsPainting]*FStates<>[] then exit;
|
|
Include(FStates,tvsPainting);
|
|
if (tvoAutoItemHeight in fOptions) then
|
|
UpdateDefaultItemHeight;
|
|
UpdateScrollbars;
|
|
with Canvas do begin
|
|
if Assigned(FOnCustomDraw) or Assigned(FOnAdvancedCustomDraw) then begin
|
|
DrawRect:=ClientRect;
|
|
if not CustomDraw(DrawRect,cdPrePaint) then exit;
|
|
end;
|
|
// draw nodes
|
|
Node:=TopItem;
|
|
//write('[TCustomTreeView.DoPaint] A Node=',DbgS(Node));
|
|
//if Node<>nil then DebugLn(' Node.Text=',Node.Text) else DebugLn('');
|
|
while Node<>nil do begin
|
|
DoPaintNode(Node);
|
|
Node:=Node.GetNextVisible;
|
|
//write('[TCustomTreeView.DoPaint] B Node=',DbgS(Node));
|
|
//if Node<>nil then DebugLn(' Node.Text=',Node.Text) else DebugLn('');
|
|
end;
|
|
// draw insert mark for new root node
|
|
if (InsertMarkType=tvimAsFirstChild)
|
|
and (Items.Count=0) then begin
|
|
Pen.Color:=FTreeLineColor;
|
|
Brush.Color:=FSelectedColor;
|
|
InsertMarkRect:=Rect(0,0,ClientWidth,2);
|
|
Rectangle(InsertMarkRect);
|
|
end;
|
|
// draw unused space below nodes
|
|
SpaceRect:=Rect(BorderWidth,BorderWidth,
|
|
(ClientWidth-ScrollBarWidth)-BorderWidth,
|
|
(ClientHeight-ScrollBarWidth)-BorderWidth);
|
|
Node:=BottomItem;
|
|
if Node<>nil then
|
|
SpaceRect.Top:=Node.Top+Node.Height-FScrolledTop+BorderWidth;
|
|
//if Node<>nil then DebugLn('BottomItem=',BottomItem.text) else DebugLn('NO BOTTOMITEM!!!!!!!!!');
|
|
// TWinControl(Parent).InvalidateRect(Self,SpaceRect,true);
|
|
if (FBackgroundColor<>clNone) and (SpaceRect.Top<SpaceRect.Bottom) then
|
|
begin
|
|
//DebugLn(' SpaceRect=',SpaceRect.Left,',',SpaceRect.Top,',',SpaceRect.Right,',',SpaceRect.Bottom);
|
|
Brush.Color:=FBackgroundColor;
|
|
FillRect(SpaceRect);
|
|
end;
|
|
// draw border
|
|
HalfBorderWidth:=BorderWidth shr 1;
|
|
Pen.Color:=clGray;
|
|
for a:=0 to BorderWidth-1 do begin
|
|
if a=HalfBorderWidth then
|
|
Pen.Color:=clBlack;
|
|
MoveTo(a,(ClientHeight-ScrollBarWidth)-1-a);
|
|
LineTo(a,a);
|
|
LineTo((ClientWidth-ScrollBarWidth)-1-a,a);
|
|
end;
|
|
Pen.Color:=clWhite;
|
|
for a:=0 to BorderWidth-1 do begin
|
|
if a=HalfBorderWidth then
|
|
Pen.Color:=clLtGray;
|
|
MoveTo((ClientWidth-ScrollBarWidth)-1-a,a);
|
|
LineTo((ClientWidth-ScrollBarWidth)-1-a,(ClientHeight-ScrollBarWidth)-1-a);
|
|
LineTo(a,(ClientHeight-ScrollBarWidth)-1-a);
|
|
end;
|
|
if Assigned(FOnCustomDraw) or Assigned(FOnAdvancedCustomDraw) then begin
|
|
DrawRect:=ClientRect;
|
|
if not CustomDraw(DrawRect,cdPostPaint) then exit;
|
|
end;
|
|
end;
|
|
Exclude(FStates,tvsPainting);
|
|
end;
|
|
|
|
procedure TCustomTreeView.DoPaintNode(Node: TTreeNode);
|
|
var
|
|
NodeRect: TRect;
|
|
VertMid: integer;
|
|
NodeSelected: boolean;
|
|
|
|
function InvertColor(AColor: TColor): TColor;
|
|
var Red, Green, Blue: integer;
|
|
begin
|
|
Result:=clWhite;
|
|
Red:=(AColor shr 16) and $ff;
|
|
Green:=(AColor shr 8) and $ff;
|
|
Blue:=AColor and $ff;
|
|
if Red+Green+Blue>$180 then
|
|
Result:=clBlack;
|
|
//DebugLn('[TCustomTreeView.DoPaintNode.InvertColor] Result=',Result,' ',Red,',',Green,',',Blue);
|
|
end;
|
|
|
|
function DrawTreeLines(CurNode: TTreeNode): integer;
|
|
// paints tree lines, returns indent
|
|
var CurMid: integer;
|
|
begin
|
|
if CurNode<>nil then begin
|
|
Result:=DrawTreeLines(CurNode.Parent);
|
|
if ShowLines then begin
|
|
CurMid:=Result+(Indent shr 1);
|
|
if CurNode=Node then begin
|
|
// draw horizontal line
|
|
Canvas.MoveTo(CurMid,VertMid);
|
|
Canvas.LineTo(Result+Indent,VertMid);
|
|
end;
|
|
if (CurNode.GetNextSibling<>nil) then begin
|
|
// draw vertical line to next brother
|
|
Canvas.MoveTo(CurMid,NodeRect.Top);
|
|
Canvas.LineTo(CurMid,NodeRect.Bottom);
|
|
end else if CurNode=Node then begin
|
|
// draw vertical line from top to horizontal line
|
|
Canvas.MoveTo(CurMid,NodeRect.Top);
|
|
if ((InsertMarkNode=Node) and (InsertMarkType=tvimAsNextSibling)) then
|
|
Canvas.LineTo(CurMid,NodeRect.Bottom-1)
|
|
else
|
|
Canvas.LineTo(CurMid,VertMid);
|
|
end;
|
|
end;
|
|
inc(Result,Indent);
|
|
end else begin
|
|
Result:=BorderWidth-FScrolledLeft;
|
|
end;
|
|
end;
|
|
|
|
procedure DrawExpandSign(MidX,MidY: integer; CollapseSign: boolean);
|
|
var HalfSize, ALeft, ATop, ARight, ABottom: integer;
|
|
Points: PPoint;
|
|
begin
|
|
if not ShowButtons then exit;
|
|
with Canvas do begin
|
|
Brush.Color:=BackgroundColor;
|
|
Pen.Color:=FExpandSignColor;
|
|
Pen.Style:=psSolid;
|
|
HalfSize:=fExpandSignSize shr 1;
|
|
if ((FExpandSignSize and 1)=0) then dec(HalfSize);
|
|
ALeft:=MidX-HalfSize;
|
|
ATop:=MidY-HalfSize;
|
|
ARight:=ALeft+(HalfSize shl 1);
|
|
ABottom:=ATop+(HalfSize shl 1);
|
|
case ExpandSignType of
|
|
tvestPlusMinus:
|
|
begin
|
|
// draw a plus or a minus sign
|
|
Rectangle(ALeft, ATop, ARight, ABottom);
|
|
MoveTo(ALeft+2,MidY);
|
|
LineTo(ARight-2+1,MidY);
|
|
if not CollapseSign then begin
|
|
MoveTo(MidX,ATop+2);
|
|
LineTo(MidX,ABottom-2+1);
|
|
end;
|
|
end;
|
|
tvestArrow:
|
|
begin
|
|
// draw an arrow. down for collapse and right for expand
|
|
GetMem(Points,SizeOf(TPoint)*3);
|
|
if CollapseSign then begin
|
|
// draw an arrow down
|
|
Points[0]:=Point(ALeft,MidY);
|
|
Points[1]:=Point(ARight,MidY);
|
|
Points[2]:=Point(MidX,ABottom);
|
|
end else begin
|
|
// draw an arrow right
|
|
Points[0]:=Point(MidX-1,ATop);
|
|
Points[1]:=Point(ARight-1,MidY);
|
|
Points[2]:=Point(MidX-1,ABottom);
|
|
end;
|
|
Polygon(Points,3,false);
|
|
FreeMem(Points);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure DrawInsertMark;
|
|
var
|
|
InsertMarkRect: TRect;
|
|
x: Integer;
|
|
begin
|
|
case InsertMarkType of
|
|
|
|
tvimAsFirstChild:
|
|
if InsertMarkNode=Node then begin
|
|
// draw insert mark for new first child
|
|
with Canvas do begin
|
|
// draw virtual tree line
|
|
Pen.Color:=TreeLineColor;
|
|
Pen.Style:=psDot;
|
|
x:=Node.DisplayExpandSignRight+Indent div 2;
|
|
MoveTo(x,NodeRect.Bottom-3);
|
|
LineTo(x,NodeRect.Bottom-2);
|
|
x:=Node.DisplayExpandSignRight+Indent;
|
|
LineTo(x,NodeRect.Bottom-2);
|
|
Pen.Style:=psSolid;
|
|
|
|
// draw virtual rectangle
|
|
Pen.Color:=TreeLineColor;
|
|
Brush.Color:=FSelectedColor;
|
|
InsertMarkRect:=Rect(x,NodeRect.Bottom-3,
|
|
NodeRect.Right,NodeRect.Bottom-1);
|
|
Rectangle(InsertMarkRect);
|
|
end;
|
|
end;
|
|
|
|
tvimAsPrevSibling:
|
|
if InsertMarkNode=Node then begin
|
|
// draw insert mark for new previous sibling
|
|
with Canvas do begin
|
|
// draw virtual tree line
|
|
Pen.Color:=TreeLineColor;
|
|
Pen.Style:=psDot;
|
|
x:=Node.DisplayExpandSignLeft+Indent div 2;
|
|
MoveTo(x,NodeRect.Top+1);
|
|
x:=Node.DisplayExpandSignRight;
|
|
LineTo(x,NodeRect.Top+1);
|
|
Pen.Style:=psSolid;
|
|
|
|
// draw virtual rectangle
|
|
Pen.Color:=TreeLineColor;
|
|
Brush.Color:=FSelectedColor;
|
|
InsertMarkRect:=Rect(x,NodeRect.Top,
|
|
NodeRect.Right,NodeRect.Top+2);
|
|
Rectangle(InsertMarkRect);
|
|
end;
|
|
end;
|
|
|
|
tvimAsNextSibling:
|
|
if InsertMarkNode=Node then begin
|
|
// draw insert mark for new next sibling
|
|
with Canvas do begin
|
|
// draw virtual tree line
|
|
Pen.Color:=TreeLineColor;
|
|
Pen.Style:=psDot;
|
|
x:=Node.DisplayExpandSignLeft+Indent div 2;
|
|
MoveTo(x,NodeRect.Bottom-3);
|
|
LineTo(x,NodeRect.Bottom-2);
|
|
x:=Node.DisplayExpandSignRight;
|
|
LineTo(x,NodeRect.Bottom-2);
|
|
Pen.Style:=psSolid;
|
|
|
|
// draw virtual rectangle
|
|
Pen.Color:=TreeLineColor;
|
|
Brush.Color:=FSelectedColor;
|
|
InsertMarkRect:=Rect(x,NodeRect.Bottom-3,
|
|
NodeRect.Right,NodeRect.Bottom-1);
|
|
Rectangle(InsertMarkRect);
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
var x, ImgIndex: integer;
|
|
CurBackgroundColor, OldFontColor: TColor;
|
|
CurTextRect: TRect;
|
|
DrawState: TCustomDrawState;
|
|
PaintImages: boolean;
|
|
TextY: Integer;
|
|
begin
|
|
NodeRect:=Node.DisplayRect(false);
|
|
if (NodeRect.Bottom<0) or (NodeRect.Top>=(ClientHeight-ScrollBarWidth)) then
|
|
exit;
|
|
NodeSelected:=(Node.Selected) or (Node.MultiSelected);
|
|
if Assigned(OnCustomDrawItem) or Assigned(FOnAdvancedCustomDrawItem) then begin
|
|
DrawState:=[];
|
|
if NodeSelected then
|
|
Include(DrawState,cdsSelected);
|
|
if Node.Focused then
|
|
Include(DrawState,cdsFocused);
|
|
if Node.MultiSelected then
|
|
Include(DrawState,cdsMarked);
|
|
if not CustomDrawItem(Node,DrawState,cdPrePaint,PaintImages) then exit;
|
|
end else begin
|
|
PaintImages:=true;
|
|
end;
|
|
VertMid:=(NodeRect.Top+NodeRect.Bottom) shr 1;
|
|
//DebugLn('[TCustomTreeView.DoPaintNode] Node=',DbgS(Node),' Node.Text=',Node.Text,' NodeRect=',NodeRect.Left,',',NodeRect.Top,',',NodeRect.Right,',',NodeRect.Bottom,' VertMid=',VertMid);
|
|
with Canvas do begin
|
|
// draw background
|
|
if (tvoRowSelect in FOptions) and NodeSelected then
|
|
CurBackgroundColor:=FSelectedColor
|
|
else
|
|
CurBackgroundColor:=FBackgroundColor;
|
|
if CurBackgroundColor<>clNone then begin
|
|
Brush.Color:=CurBackgroundColor;
|
|
FillRect(NodeRect);
|
|
end;
|
|
// draw tree lines
|
|
Pen.Color:=TreeLineColor;
|
|
Pen.Style:=psDot;
|
|
x:=DrawTreeLines(Node);
|
|
Pen.Style:=psSolid;
|
|
// draw expand sign
|
|
if Node.HasChildren then begin
|
|
DrawExpandSign(x-Indent+(Indent shr 1),VertMid,Node.Expanded);
|
|
end;
|
|
// draw icon
|
|
if (Images<>nil) and PaintImages then begin
|
|
if FSelectedNode<>Node then
|
|
ImgIndex:=Node.ImageIndex
|
|
else
|
|
ImgIndex:=Node.SelectedIndex;
|
|
if (ImgIndex>=0) and (ImgIndex<Images.Count) then
|
|
Images.Draw(Canvas,x+1,NodeRect.Top,ImgIndex,true);
|
|
inc(x,Images.Width+2);
|
|
end;
|
|
// draw state icon
|
|
if (StateImages<>nil) and PaintImages then begin
|
|
if (Node.StateIndex>=0) and (Node.StateIndex<StateImages.Count) then
|
|
StateImages.Draw(Canvas,x+1,NodeRect.Top,Node.StateIndex,true);
|
|
inc(x,StateImages.Width+2);
|
|
end;
|
|
// draw text
|
|
if Node.Text<>'' then begin
|
|
TextY:=NodeRect.Top+
|
|
((NodeRect.Bottom-NodeRect.Top-TextHeight(Node.Text)) div 2);
|
|
if NodeSelected and (FSelectedColor<>clNone) then begin
|
|
Brush.Color:=FSelectedColor;
|
|
CurTextRect:=NodeRect;
|
|
CurTextRect.Left:=x;
|
|
CurTextRect.Right:=x+TextWidth(Node.Text);
|
|
OldFontColor:=Font.Color;
|
|
Font.Color:=InvertColor(Brush.Color);
|
|
FillRect(CurTextRect);
|
|
TextOut(x,TextY,Node.Text);
|
|
Font.Color:=OldFontColor;
|
|
end else begin
|
|
TextOut(x,TextY,Node.Text);
|
|
end;
|
|
end;
|
|
// draw separator
|
|
if (tvoShowSeparators in FOptions) then begin
|
|
Pen.Color:=SeparatorColor;
|
|
MoveTo(NodeRect.Left,NodeRect.Bottom-1);
|
|
LineTo(NodeRect.Right,NodeRect.Bottom-1);
|
|
end;
|
|
// draw insert mark
|
|
DrawInsertMark;
|
|
end;
|
|
if Assigned(OnCustomDrawItem) or Assigned(FOnAdvancedCustomDrawItem) then
|
|
begin
|
|
DrawState:=[];
|
|
if Node.Selected then
|
|
Include(DrawState,cdsSelected);
|
|
if Node.Focused then
|
|
Include(DrawState,cdsFocused);
|
|
if Node.MultiSelected then
|
|
Include(DrawState,cdsMarked);
|
|
if not CustomDrawItem(Node,DrawState,cdPostPaint,PaintImages) then exit;
|
|
end else begin
|
|
PaintImages:=true;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.GetImageIndex(Node: TTreeNode);
|
|
begin
|
|
if Assigned(FOnGetImageIndex) then FOnGetImageIndex(Self, Node);
|
|
end;
|
|
|
|
procedure TCustomTreeView.GetSelectedIndex(Node: TTreeNode);
|
|
begin
|
|
if Assigned(FOnGetSelectedIndex) then FOnGetSelectedIndex(Self, Node);
|
|
end;
|
|
|
|
function TCustomTreeView.CanChange(Node: TTreeNode): Boolean;
|
|
begin
|
|
Result := True;
|
|
if Assigned(FOnChanging) then FOnChanging(Self, Node, Result);
|
|
end;
|
|
|
|
procedure TCustomTreeView.Change(Node: TTreeNode);
|
|
begin
|
|
if Assigned(FOnChange) then FOnChange(Self, Node);
|
|
end;
|
|
|
|
procedure TCustomTreeView.Delete(Node: TTreeNode);
|
|
begin
|
|
if Assigned(FOnDeletion) then FOnDeletion(Self, Node);
|
|
end;
|
|
|
|
procedure TCustomTreeView.Expand(Node: TTreeNode);
|
|
begin
|
|
if Assigned(FOnExpanded) then FOnExpanded(Self, Node);
|
|
end;
|
|
|
|
function TCustomTreeView.CanExpand(Node: TTreeNode): Boolean;
|
|
begin
|
|
Result := True;
|
|
if Assigned(FOnExpanding) then FOnExpanding(Self, Node, Result);
|
|
end;
|
|
|
|
procedure TCustomTreeView.Collapse(Node: TTreeNode);
|
|
begin
|
|
if Assigned(FOnCollapsed) then FOnCollapsed(Self, Node);
|
|
end;
|
|
|
|
function TCustomTreeView.CanCollapse(Node: TTreeNode): Boolean;
|
|
begin
|
|
Result := True;
|
|
if Assigned(FOnCollapsing) then FOnCollapsing(Self, Node, Result);
|
|
end;
|
|
|
|
function TCustomTreeView.CanEdit(Node: TTreeNode): Boolean;
|
|
begin
|
|
Result := True;
|
|
if Assigned(FOnEditing) then FOnEditing(Self, Node, Result);
|
|
end;
|
|
|
|
procedure TCustomTreeView.EndEditing;
|
|
begin
|
|
if not (tvsIsEditing in FStates) then exit;
|
|
// ToDo:
|
|
// restore value
|
|
|
|
// end editing
|
|
Exclude(FStates,tvsIsEditing);
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomTreeView.EnsureNodeIsVisible(ANode: TTreeNode);
|
|
var b: integer;
|
|
begin
|
|
if ANode=nil then exit;
|
|
ANode.ExpandParents;
|
|
if ANode.Top<ScrolledTop then
|
|
ScrolledTop:=ANode.Top
|
|
else begin
|
|
b:=ANode.Top+ANode.Height-GetNodeDrawAreaHeight;
|
|
if ScrolledTop<b then ScrolledTop:=b;
|
|
end;
|
|
end;
|
|
|
|
function TCustomTreeView.CreateNode: TTreeNode;
|
|
begin
|
|
Result := nil;
|
|
if Assigned(FOnCustomCreateItem) then
|
|
FOnCustomCreateItem(Self, Result);
|
|
if Result = nil then
|
|
Result := TTreeNode.Create(Items);
|
|
end;
|
|
|
|
procedure TCustomTreeView.ImageListChange(Sender: TObject);
|
|
begin
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomTreeView.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
var
|
|
CursorNode: TTreeNode;
|
|
bStartDrag: boolean;
|
|
LogicalX: Integer;
|
|
begin
|
|
{$IFDEF VerboseDrag}
|
|
DebugLn('TCustomTreeView.MouseDown A ',Name,':',ClassName,' ');
|
|
{$ENDIF}
|
|
fMouseDownX := X;
|
|
fMouseDownY := Y;
|
|
if Button=mbMiddle then begin
|
|
if ([ssDouble,ssTriple,ssQuad]*Shift)<>[] then Exit;
|
|
if tvsIsEditing in FStates then begin
|
|
// ToDo: insert clipboard text into node text
|
|
// :=PrimarySelection.AsText;
|
|
end;
|
|
end else if Button=mbRight then begin
|
|
if RightClickSelect then begin
|
|
Selected:=GetNodeAt(X,Y);
|
|
end;
|
|
end;
|
|
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
|
|
CursorNode:=GetNodeAt(X,Y);
|
|
LogicalX:=X+FScrolledLeft-BorderWidth;
|
|
bStartDrag := false;
|
|
if ([ssDouble,ssTriple,ssQuad]*Shift)=[] then begin
|
|
if (Button = mbLeft) and (CursorNode<>nil) then begin
|
|
Exclude(fStates,tvsWaitForDragging);
|
|
if CursorNode.HasChildren
|
|
and (LogicalX>=CursorNode.DisplayExpandSignLeft)
|
|
and (LogicalX<CursorNode.DisplayExpandSignRight) then begin
|
|
// mousedown occured on expand sign -> expand/collapse
|
|
CursorNode.Expanded:=not CursorNode.Expanded;
|
|
end else if LogicalX>=CursorNode.DisplayIconLeft then begin
|
|
// mousedown occured in text or icon
|
|
// -> select node and begin drag operation
|
|
{$IFDEF VerboseDrag}
|
|
DebugLn('TCustomTreeView.MouseDown In Text ',Name,':',ClassName,' MouseCapture=',MouseCapture);
|
|
{$ENDIF}
|
|
if MouseCapture then
|
|
Include(FStates,tvsMouseCapture);
|
|
if not (tvoAllowMultiselect in Options) then begin
|
|
Selected:=CursorNode;
|
|
end else begin
|
|
if (ssShift in Shift) then begin
|
|
CursorNode.MultiSelectGroup;
|
|
end else if (ssCtrl in Shift) then begin
|
|
CursorNode.MultiSelected:=not CursorNode.MultiSelected;
|
|
end else begin
|
|
if (Selected<>CursorNode) or Items.IsMultiSelection then begin
|
|
LockSelectionChangeEvent;
|
|
Items.ClearMultiSelection;
|
|
CursorNode.MultiSelected:=true;
|
|
UnlockSelectionChangeEvent;
|
|
end;
|
|
end;
|
|
end;
|
|
bStartDrag := tvsMouseCapture in FStates;
|
|
end;
|
|
end;
|
|
if (bStartDrag) then begin
|
|
{$IFDEF VerboseDrag}
|
|
DebugLn('TCustomTreeView.MouseDown A bStartDrag ',Name,':',ClassName,' ');
|
|
{$ENDIF}
|
|
FDragNode:=CursorNode;
|
|
Include(fStates,tvsWaitForDragging);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
inherited MouseMove(Shift, x, y);
|
|
if (tvsWaitForDragging in fStates) then begin
|
|
if (Abs(fMouseDownX - X) >= GetSystemMetrics(SM_CXDRAG))
|
|
or (Abs(fMouseDownY - Y) >= GetSystemMetrics(SM_CYDRAG))
|
|
then begin
|
|
{$IFDEF VerboseDrag}
|
|
DebugLn('TCustomTreeView.MouseMove A Begindrag ',Name,':',ClassName,' ');
|
|
{$ENDIF}
|
|
Exclude(fStates, tvsWaitForDragging);
|
|
BeginDrag(false);
|
|
end;
|
|
end;
|
|
if (tvoAutoInsertMark in FOptions) then
|
|
UpdateInsertMark(X,Y);
|
|
end;
|
|
|
|
procedure TCustomTreeView.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
if (Button = mbRight) and (Shift = [ssRight]) and Assigned(PopupMenu) then
|
|
exit;
|
|
if Button=mbLeft then
|
|
MouseCapture := False;
|
|
Exclude(fStates, tvsWaitForDragging);
|
|
if (Button=mbLeft)
|
|
and (fStates * [tvsDblClicked, tvsTripleClicked, tvsQuadClicked,
|
|
tvsWaitForDragging] = [])
|
|
then begin
|
|
//AquirePrimarySelection;
|
|
end;
|
|
fStates:=fStates-[tvsDblClicked,tvsTripleClicked,tvsQuadClicked];
|
|
end;
|
|
|
|
procedure TCustomTreeView.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if Operation = opRemove then begin
|
|
if AComponent = Images then Images := nil;
|
|
if AComponent = StateImages then StateImages := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetImages(Value: TCustomImageList);
|
|
begin
|
|
if Images = Value then exit;
|
|
if Images <> nil then
|
|
Images.UnRegisterChanges(FImageChangeLink);
|
|
FImages := Value;
|
|
if Images <> nil then begin
|
|
Images.RegisterChanges(FImageChangeLink);
|
|
Images.FreeNotification(Self);
|
|
if DefaultItemHeight<Images.Height+2 then
|
|
DefaultItemHeight:=Images.Height+2;
|
|
end;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetInsertMarkNode(const AValue: TTreeNode);
|
|
var
|
|
InvalidateNeeded: Boolean;
|
|
begin
|
|
if FInsertMarkNode=AValue then exit;
|
|
InvalidateNeeded:=IsInsertMarkVisible;
|
|
FInsertMarkNode:=AValue;
|
|
InvalidateNeeded:=InvalidateNeeded or IsInsertMarkVisible;
|
|
if InvalidateNeeded then Invalidate;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetInsertMarkType(
|
|
const AValue: TTreeViewInsertMarkType);
|
|
var
|
|
InvalidateNeeded: Boolean;
|
|
begin
|
|
if FInsertMarkType=AValue then exit;
|
|
InvalidateNeeded:=IsInsertMarkVisible;
|
|
FInsertMarkType:=AValue;
|
|
InvalidateNeeded:=InvalidateNeeded or IsInsertMarkVisible;
|
|
if InvalidateNeeded then Invalidate;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetStateImages(Value: TCustomImageList);
|
|
begin
|
|
if FStateImages=Value then exit;
|
|
if StateImages <> nil then
|
|
StateImages.UnRegisterChanges(FStateChangeLink);
|
|
FStateImages := Value;
|
|
if StateImages <> nil then begin
|
|
StateImages.RegisterChanges(FStateChangeLink);
|
|
StateImages.FreeNotification(Self);
|
|
if DefaultItemHeight<StateImages.Height+2 then
|
|
DefaultItemHeight:=StateImages.Height+2;
|
|
end;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomTreeView.LoadFromFile(const FileName: string);
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := TFileStream.Create(FileName, fmOpenRead);
|
|
try
|
|
LoadFromStream(Stream);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.LoadFromStream(Stream: TStream);
|
|
begin
|
|
with TTreeStrings.Create(Items) do
|
|
try
|
|
LoadTreeFromStream(Stream);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SaveToFile(const FileName: string);
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := TFileStream.Create(FileName, fmCreate);
|
|
try
|
|
SaveToStream(Stream);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SaveToStream(Stream: TStream);
|
|
begin
|
|
with TTreeStrings.Create(Items) do
|
|
try
|
|
SaveTreeToStream(Stream);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.WMVScroll(var Msg: TLMScroll);
|
|
begin
|
|
case Msg.ScrollCode of
|
|
// Scrolls to start / end of the text
|
|
SB_TOP: ScrolledTop := 0;
|
|
SB_BOTTOM: ScrolledTop := GetMaxScrollTop;
|
|
// Scrolls one line up / down
|
|
SB_LINEDOWN: ScrolledTop := ScrolledTop + FDefItemHeight div 2;
|
|
SB_LINEUP: ScrolledTop := ScrolledTop - FDefItemHeight div 2;
|
|
// Scrolls one page of lines up / down
|
|
SB_PAGEDOWN: ScrolledTop := ScrolledTop + (ClientHeight-ScrollBarWidth)
|
|
- FDefItemHeight;
|
|
SB_PAGEUP: ScrolledTop := ScrolledTop - (ClientHeight-ScrollBarWidth)
|
|
+ FDefItemHeight;
|
|
// Scrolls to the current scroll bar position
|
|
SB_THUMBPOSITION,
|
|
SB_THUMBTRACK: ScrolledTop := Msg.Pos;
|
|
|
|
SB_ENDSCROLL: ; // Ends scrolling
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.WMHScroll(var Msg: TLMScroll);
|
|
begin
|
|
case Msg.ScrollCode of
|
|
// Scrolls to start / end of the text
|
|
SB_LEFT: ScrolledLeft := 0;
|
|
SB_RIGHT: ScrolledLeft := GetMaxScrollLeft;
|
|
// Scrolls one line left / right
|
|
SB_LINERIGHT: ScrolledLeft := ScrolledLeft + FDefItemHeight div 2;
|
|
SB_LINELEFT: ScrolledLeft := ScrolledLeft - FDefItemHeight div 2;
|
|
// Scrolls one page of lines left / right
|
|
SB_PAGERIGHT: ScrolledLeft := ScrolledLeft + (ClientHeight-ScrollBarWidth)
|
|
- FDefItemHeight;
|
|
SB_PAGELEFT: ScrolledLeft := ScrolledLeft - (ClientHeight-ScrollBarWidth)
|
|
+ FDefItemHeight;
|
|
// Scrolls to the current scroll bar position
|
|
SB_THUMBPOSITION,
|
|
SB_THUMBTRACK: ScrolledLeft := Msg.Pos;
|
|
|
|
SB_ENDSCROLL: ;// Ends scrolling
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.WMLButtonDown(var AMessage: TLMLButtonDown);
|
|
{var
|
|
Node: TTreeNode;
|
|
MousePos: TPoint;
|
|
P: TSmallPoint;}
|
|
begin
|
|
{$IFDEF VerboseDrag}
|
|
DebugLn('TCustomTreeView.WMLButtonDown A ',Name,':',ClassName,' ');
|
|
{$ENDIF}
|
|
Exclude(FStates,tvsDragged);
|
|
inherited WMLButtonDown(AMessage);
|
|
{$IFDEF VerboseDrag}
|
|
DebugLn('TCustomTreeView.WMLButtonDown END ',Name,':',ClassName,' ');
|
|
{$ENDIF}
|
|
{ ToDo
|
|
FDragNode := nil;
|
|
try
|
|
inherited;
|
|
if (DragMode = dmAutomatic) and (DragKind = dkDrag) then
|
|
begin
|
|
SetFocus;
|
|
if not (tvsDragged in FStates) then begin
|
|
GetCursorPos(MousePos);
|
|
P:=PointToSmallPoint(ScreenToClient(MousePos));
|
|
Perform(LM_LBUTTONUP, 0, LParam(MakeLong(P.X, P.Y)));
|
|
end
|
|
else begin
|
|
Node := GetNodeAt(AMessage.XPos, AMessage.YPos);
|
|
if Node <> nil then
|
|
begin
|
|
Node.Focused := True;
|
|
Node.Selected := True;
|
|
BeginDrag(False);
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
FDragNode := nil;
|
|
end;}
|
|
end;
|
|
|
|
procedure TCustomTreeView.WMNotify(var AMessage: TLMNotify);
|
|
begin
|
|
inherited WMNotify(AMessage);
|
|
end;
|
|
|
|
procedure TCustomTreeView.Resize;
|
|
begin
|
|
FStates:=FStates+[tvsScrollbarChanged,
|
|
tvsBottomItemNeedsUpdate];
|
|
inherited Resize;
|
|
end;
|
|
|
|
procedure TCustomTreeView.InternalSelectionChanged;
|
|
begin
|
|
if fSelectionChangeEventLock>0 then begin
|
|
Include(fStates,tvsSelectionChanged);
|
|
end else begin
|
|
Exclude(fStates,tvsSelectionChanged);
|
|
DoSelectionChanged;
|
|
FChangeTimer.Enabled := false;
|
|
FChangeTimer.Enabled := true;
|
|
//debugln('TCustomTreeView.InternalSelectionChanged');
|
|
end;
|
|
end;
|
|
|
|
{ CustomDraw support }
|
|
|
|
procedure TCustomTreeView.CanvasChanged(Sender: TObject);
|
|
begin
|
|
Include(FStates,tvsCanvasChanged);
|
|
end;
|
|
|
|
function TCustomTreeView.IsCustomDrawn(Target: TCustomDrawTarget;
|
|
Stage: TCustomDrawStage): Boolean;
|
|
begin
|
|
{ Tree view doesn't support erase notifications }
|
|
if Stage = cdPrePaint then begin
|
|
if Target = dtItem then
|
|
Result := Assigned(FOnCustomDrawItem)
|
|
or Assigned(FOnAdvancedCustomDrawItem)
|
|
else if Target = dtControl then
|
|
Result := Assigned(FOnCustomDraw) or Assigned(FOnAdvancedCustomDraw) or
|
|
Assigned(FOnCustomDrawItem) or Assigned(FOnAdvancedCustomDrawItem)
|
|
else
|
|
Result := False;
|
|
end else begin
|
|
if Target = dtItem then
|
|
Result := Assigned(FOnAdvancedCustomDrawItem)
|
|
else if Target = dtControl then
|
|
Result := Assigned(FOnAdvancedCustomDraw)
|
|
or Assigned(FOnAdvancedCustomDrawItem)
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function TCustomTreeView.CustomDraw(const ARect: TRect;
|
|
Stage: TCustomDrawStage): Boolean;
|
|
begin
|
|
Result := True;
|
|
if (Stage = cdPrePaint) and Assigned(FOnCustomDraw) then
|
|
FOnCustomDraw(Self, ARect, Result);
|
|
if Assigned(FOnAdvancedCustomDraw) then
|
|
FOnAdvancedCustomDraw(Self, ARect, Stage, Result);
|
|
end;
|
|
|
|
function TCustomTreeView.CustomDrawItem(Node: TTreeNode;
|
|
State: TCustomDrawState;
|
|
Stage: TCustomDrawStage; var PaintImages: Boolean): Boolean;
|
|
begin
|
|
Result := True;
|
|
PaintImages := True;
|
|
if (Stage = cdPrePaint) and Assigned(FOnCustomDrawItem) then
|
|
FOnCustomDrawItem(Self, Node, State, Result);
|
|
if Assigned(FOnAdvancedCustomDrawItem) then
|
|
FOnAdvancedCustomDrawItem(Self, Node, State, Stage, PaintImages, Result);
|
|
end;
|
|
|
|
procedure TCustomTreeView.ConsistencyCheck;
|
|
var OldMaxRight, OldLastTop, OldMaxLvl: integer;
|
|
OldTopItem, OldBottomItem: TTreeNode;
|
|
begin
|
|
if Canvas=nil then
|
|
RaiseGDBException('Canvas=nil');
|
|
if (fExpandSignSize<0) then
|
|
RaiseGDBException('fExpandSignSize='+IntToStr(fExpandSignSize));
|
|
if FDefItemHeight<0 then
|
|
RaiseGDBException('FDefItemHeight='+IntToStr(FDefItemHeight));
|
|
if FIndent<0 then
|
|
RaiseGDBException('FIndent='+IntToStr(FIndent));
|
|
if FMaxRight<0 then
|
|
RaiseGDBException('FMaxRight='+IntToStr(FMaxRight));
|
|
if FTreeNodes=nil then
|
|
RaiseGDBException('FTreeNodes=nil');
|
|
FTreeNodes.ConsistencyCheck;
|
|
if FUpdateCount<0 then
|
|
RaiseGDBException('FUpdateCount='+IntToStr(FUpdateCount));
|
|
if (not (tvsTopsNeedsUpdate in FStates)) then begin
|
|
if Items.GetLastSubNode<>nil then begin
|
|
OldLastTop:=Items.GetLastSubNode.Top;
|
|
Include(FStates,tvsTopsNeedsUpdate);
|
|
UpdateAllTops;
|
|
if OldLastTop<>Items.GetLastSubNode.Top then
|
|
RaiseGDBException('OldLastTop='+DbgS(OldLastTop)
|
|
+'<>Items.GetLastSubNode.Top='+DbgS(Items.GetLastSubNode.Top));
|
|
end;
|
|
end;
|
|
if not (tvsMaxRightNeedsUpdate in FStates) then begin
|
|
OldMaxRight:=FMaxRight;
|
|
Include(FStates,tvsMaxRightNeedsUpdate);
|
|
UpdateMaxRight;
|
|
if OldMaxRight<>FMaxRight then
|
|
RaiseGDBException('OldMaxRight<>FMaxRight');
|
|
end;
|
|
if not (tvsMaxLvlNeedsUpdate in FStates) then begin
|
|
OldMaxLvl:=FMaxLvl;
|
|
Include(FStates,tvsMaxLvlNeedsUpdate);
|
|
UpdateMaxLvl;
|
|
if OldMaxLvl<>FMaxLvl then
|
|
RaiseGDBException('OldMaxLvl<>FMaxLvl');
|
|
end;
|
|
if (tvsIsEditing in FStates) and (FSelectedNode=nil) then
|
|
RaiseGDBException('');
|
|
if (FSelectedNode<>nil) then begin
|
|
if not FSelectedNode.IsVisible then
|
|
RaiseGDBException('not FSelectedNode.IsVisible');
|
|
end;
|
|
if not (tvsTopItemNeedsUpdate in FStates) then begin
|
|
OldTopItem:=FTopItem;
|
|
UpdateTopItem;
|
|
if FTopItem<>OldTopItem then
|
|
RaiseGDBException('FTopItem<>OldTopItem');
|
|
end;
|
|
if not (tvsBottomItemNeedsUpdate in FStates) then begin
|
|
OldBottomItem:=FBottomItem;
|
|
UpdateBottomItem;
|
|
if FBottomItem<>OldBottomItem then
|
|
RaiseGDBException('FBottomItem<>OldBottomItem');
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.WriteDebugReport(const Prefix: string;
|
|
AllNodes: boolean);
|
|
begin
|
|
DbgOut('%s%s.WriteDebugReport Self=%p', [Prefix, ClassName, Pointer(Self)]);
|
|
ConsistencyCheck;
|
|
DebugLn('');
|
|
if AllNodes then begin
|
|
Items.WriteDebugReport(Prefix+' ',true);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.LockSelectionChangeEvent;
|
|
begin
|
|
inc(fSelectionChangeEventLock);
|
|
end;
|
|
|
|
procedure TCustomTreeView.UnlockSelectionChangeEvent;
|
|
begin
|
|
dec(fSelectionChangeEventLock);
|
|
if fSelectionChangeEventLock<0 then
|
|
RaiseGDBException('TCustomTreeView.UnlockSelectionChangeEvent');
|
|
if (fSelectionChangeEventLock=0)
|
|
and (tvsSelectionChanged in fStates) then
|
|
InternalSelectionChanged;
|
|
end;
|
|
|
|
function TCustomTreeView.GetFirstMultiSelected: TTreeNode;
|
|
begin
|
|
Result:=Items.FFirstMultiSelected;
|
|
end;
|
|
|
|
function TCustomTreeView.SelectionVisible: boolean;
|
|
var
|
|
ANode: TTreeNode;
|
|
begin
|
|
ANode:=GetFirstMultiSelected;
|
|
if (ANode<>nil) and (ANode.GetNextMultiSelected<>nil) then begin
|
|
// 2 or more elements => a real multi selection =>
|
|
// is visible if even one of its nodes is partly visible
|
|
while (ANode<>nil) do begin
|
|
if ANode.IsVisible then begin
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
ANode:=ANode.GetNextMultiSelected;
|
|
end;
|
|
Result:=false;
|
|
end else begin
|
|
if ANode=nil then
|
|
ANode:=Selected;
|
|
Result:=(ANode<>nil) and (ANode.IsFullHeightVisible);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTreeView.MakeSelectionVisible;
|
|
var
|
|
ANode: TTreeNode;
|
|
begin
|
|
if SelectionVisible then exit;
|
|
ANode:=GetFirstMultiSelected;
|
|
if (ANode=nil) then
|
|
ANode:=Selected;
|
|
if ANode=nil then exit;
|
|
ANode.MakeVisible;
|
|
end;
|
|
|
|
procedure TCustomTreeView.SetSeparatorColor(const AValue: TColor);
|
|
begin
|
|
if fSeparatorColor=AValue then exit;
|
|
fSeparatorColor:=AValue;
|
|
if tvoShowSeparators in Options then
|
|
Invalidate;
|
|
end;
|
|
|
|
// back to comctrls.pp
|
|
|