IdeDebugger: Treeview, update embedded controls on resize

(cherry picked from commit cc98242bec)

ide/packages/idedebugger/debuggertreeview.pas

@@ -5,16 +5,48 @@ unit DebuggerTreeView;
 interface
 
 uses
-  Classes, SysUtils, laz.VirtualTrees, SpinEx, LMessages, Controls;
+  Classes, SysUtils, Types, laz.VirtualTrees, SpinEx, LMessages, Controls,
+  ImgList;
 
 type
 
   TDbgTreeView = class;
 
+  PVTVirtualItemNodeEnumeration = ^TVTVirtualItemNodeEnumeration;
+
+  { TVTVirtualItemNodeEnumerator }
+
+  TVTVirtualItemNodeEnumerator = class
+  private
+    FNode: PVirtualNode;
+    FCanModeNext: Boolean;
+    FEnumeration: PVTVirtualItemNodeEnumeration;
+    function GetCurrent: PVirtualNode; {$ifdef COMPILER_10_UP}inline;{$endif}
+  public
+    function MoveNext: Boolean; {$ifdef COMPILER_10_UP}inline;{$endif}
+    property Current: PVirtualNode read GetCurrent;
+  end;
+
+  { TVTVirtualItemNodeEnumeration }
+
+  TVTVirtualItemNodeEnumeration = object
+  private
+    FTree: TDbgTreeView;
+    FMode: TVZVirtualNodeEnumerationMode;
+    FConsiderChildrenAbove, FIncludeNonItemNodes: Boolean;
+    FControlNodes: Boolean;
+    FNextNode: PVirtualNode;
+    function GetNext(Node: PVirtualNode): PVirtualNode;
+    function DoGetNext(Node: PVirtualNode): PVirtualNode;
+  public
+    function GetEnumerator: TVTVirtualItemNodeEnumerator;
+  end;
+
   TDbgTreeNodeData = record
     Item: TObject;  // Must be the first field.  Node.AddChild will write the new "Item" at UserData^  (aka the memory at the start of UserData)
     CachedText: Array of String;
     Control: TControl;
+    PrevControlNode, NextControlNode: PVirtualNode;
   end;
   PDbgTreeNodeData = ^TDbgTreeNodeData;
 
@@ -24,7 +56,7 @@ type
 
   TDbgTreeView = class(TLazVirtualStringTree)
   private
-    FFirstVisibleBeforeExpanding, FLastVisibleBeforeExpanding: PVirtualNode;
+    FFirstControlNode: PVirtualNode; // not ordered
     FOnItemRemoved: TItemRemovedEvent;
     function GetNodeControl(Node: PVirtualNode): TControl;
     function GetNodeItem(Node: PVirtualNode): TObject;
@@ -32,9 +64,13 @@ type
     procedure SetNodeControl(Node: PVirtualNode; AValue: TControl);
     procedure SetNodeItem(Node: PVirtualNode; AValue: TObject);
     procedure SetNodeText(Node: PVirtualNode; AColumn: integer; AValue: String);
+    procedure ChangeControl(Node: PVirtualNode; NData: PDbgTreeNodeData; AControl: TControl);
   protected
+    procedure CheckControlsVisible;
+    procedure EndUpdate; override;
+    function DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOptions;
+      ClipRect: PRect = nil): Boolean; override;
     function DoCollapsing(Node: PVirtualNode): Boolean; override;
-    function DoExpanding(Node: PVirtualNode): Boolean; override;
     procedure DoExpanded(Node: PVirtualNode); override;
     procedure ValidateNodeDataSize(var Size: Integer); override;
     procedure DoFreeNode(Node: PVirtualNode); override;
@@ -50,17 +86,26 @@ type
   public
     function GetNodeData(Node: PVirtualNode): PDbgTreeNodeData; reintroduce;
 
-    function GetFocusedNode(OnlySelected: Boolean = True): PVirtualNode;
+    function GetFocusedNode(OnlySelected: Boolean = True; AnIncludeControlNodes: Boolean = False): PVirtualNode;
     function FocusedData(OnlySelected: Boolean = True): PDbgTreeNodeData;
     function FocusedItem(OnlySelected: Boolean = True): TObject;
 
     procedure SelectNode(Node: PVirtualNode; ASetFocus: boolean = True);
     function FindNodeForItem(AnItem: TObject): PVirtualNode;
+    function FindNodeForControl(AControl: TObject): PVirtualNode;
     function FindNodeForText(AText: String; AColumn: integer; ATopLvlOnly: Boolean = False): PVirtualNode;
     procedure DeleteNodeEx(Node: PVirtualNode; FreeItem: Boolean; Reindex: Boolean = True);
     // LazMoveTo: Don't mess with children
     procedure LazMoveTo(Source, Target: PVirtualNode; Mode: TVTNodeAttachMode);
 
+    (* NoInitItemNodes, SelectedItemNodes
+       - By default iterate only nodes WITHOUT control
+       - Allow the current node to be deleted, or moved (if moved, it can be seen twice)
+    *)
+    function NoInitItemNodes(ConsiderChildrenAbove: Boolean = False; IncludeNonItemNodes: Boolean = False): TVTVirtualItemNodeEnumeration;
+    function SelectedItemNodes(ConsiderChildrenAbove: Boolean = False; IncludeNonItemNodes: Boolean = False): TVTVirtualItemNodeEnumeration;
+    function ControlNodes: TVTVirtualItemNodeEnumeration;
+
     property NodeItem[Node: PVirtualNode]: TObject read GetNodeItem write SetNodeItem;
     property NodeText[Node: PVirtualNode; AColumn: integer]: String read GetNodeText write SetNodeText;
     property NodeControl[Node: PVirtualNode]: TControl read GetNodeControl write SetNodeControl;
@@ -70,6 +115,74 @@ type
 
 implementation
 
+{ TVTVirtualItemNodeEnumerator }
+
+function TVTVirtualItemNodeEnumerator.GetCurrent: PVirtualNode;
+begin
+  Result := FNode;
+end;
+
+function TVTVirtualItemNodeEnumerator.MoveNext: Boolean;
+begin
+  Result := FCanModeNext;
+  if Result then
+  begin
+    FNode := FEnumeration^.GetNext(FNode);
+    Result := FNode <> nil;
+    FCanModeNext := Result;
+  end;
+end;
+
+{ TVTVirtualItemNodeEnumeration }
+
+function TVTVirtualItemNodeEnumeration.GetEnumerator: TVTVirtualItemNodeEnumerator;
+begin
+  Result := TVTVirtualItemNodeEnumerator.Create;
+  Result.FNode := nil;
+  Result.FCanModeNext := True;
+  Result.FEnumeration := @Self;
+  FNextNode := DoGetNext(nil);
+end;
+
+function TVTVirtualItemNodeEnumeration.GetNext(Node: PVirtualNode
+  ): PVirtualNode;
+begin
+  Result := FNextNode;
+  if FNextNode <> nil then
+    FNextNode := DoGetNext(FNextNode); // if the current node gets deleted or moved, continue from the original pos
+end;
+
+function TVTVirtualItemNodeEnumeration.DoGetNext(Node: PVirtualNode
+  ): PVirtualNode;
+begin
+  if FControlNodes then begin
+    if Node = nil then
+      Result := FTree.FFirstControlNode
+    else
+      Result := FTree.GetNodeData(Node)^.NextControlNode;
+    exit;
+  end;
+
+  repeat
+    case FMode of
+      vneNoInit:
+        if Node = nil then
+          Result := FTree.GetFirstNoInit(FConsiderChildrenAbove)
+        else
+          Result := FTree.GetNextNoInit(Node, FConsiderChildrenAbove);
+
+      vneSelected:
+        if Node = nil then
+          Result := FTree.GetFirstSelected(FConsiderChildrenAbove)
+        else
+          Result := FTree.GetNextSelected(Node, FConsiderChildrenAbove);
+    else
+      Result := nil;
+    end;
+    Node := Result;
+  until (Result=nil) or FIncludeNonItemNodes or (FTree.NodeControl[Result] = nil);
+end;
+
 { TDbgTreeView }
 
 function TDbgTreeView.GetNodeControl(Node: PVirtualNode): TControl;
@@ -113,7 +226,7 @@ begin
     exit;
 
   Data^.Control.Free;
-  Data^.Control := AValue;
+  ChangeControl(Node, Data, AValue);
   if AValue <> nil then begin
     AValue.Visible := False;
     AValue.Parent := Self;
@@ -149,6 +262,103 @@ begin
   end;
 end;
 
+procedure TDbgTreeView.ChangeControl(Node: PVirtualNode;
+  NData: PDbgTreeNodeData; AControl: TControl);
+var
+  NData2: PDbgTreeNodeData;
+begin
+  if (NData^.Control = nil) = (AControl = nil) then begin
+    NData^.Control := AControl;
+    exit;
+  end;
+
+  NData^.Control := AControl;
+
+  if AControl = nil then begin
+    // node must have had a control
+    if NData^.PrevControlNode = nil then begin
+      assert(FFirstControlNode = Node, 'TDbgTreeView.DoFreeNode: FFirstControlNode = Node');
+      FFirstControlNode := NData^.NextControlNode;
+    end
+    else begin
+      NData2 := GetNodeData(NData^.PrevControlNode);
+      assert((NData2 <> nil) and (NData2^.NextControlNode = Node), 'TDbgTreeView.DoFreeNode: (NData2 <> nil) and (NData2^.NextControlNode = Node)');
+      NData2^.NextControlNode := NData^.NextControlNode;
+    end;
+
+    if NData^.NextControlNode <> nil then begin
+      NData2 := GetNodeData(NData^.NextControlNode);
+      assert((NData2 <> nil) and (NData2^.PrevControlNode = Node), 'TDbgTreeView.DoFreeNode: (NData2 <> nil) and (NData2^.PrevControlNode = Node)');
+      NData2^.PrevControlNode := NData^.PrevControlNode;
+    end;
+    NData^.PrevControlNode := nil;
+    NData^.NextControlNode := nil;
+  end
+  else begin
+    assert((NData^.NextControlNode = nil) and (NData^.PrevControlNode = nil), 'TDbgTreeView.ChangeControl: (NData^.NextControlNode = nil) and (NData^.PrevControlNode = nil)');
+    assert(FFirstControlNode <> Node, 'TDbgTreeView.ChangeControl: FFirstControlNode <> Node');
+    if FFirstControlNode <> nil then begin
+      NData2 := GetNodeData(FFirstControlNode);
+      NData2^.PrevControlNode := Node;
+      NData^.NextControlNode := FFirstControlNode;
+    end;
+    FFirstControlNode := Node;
+  end;
+end;
+
+procedure TDbgTreeView.CheckControlsVisible;
+var
+  VNode: PVirtualNode;
+  Y, H: Integer;
+  Ctrl: TControl;
+  Chg: Boolean;
+begin
+  if (FFirstControlNode = nil) or (UpdateCount > 0) then
+    exit;
+
+  Y := OffsetY;
+  Chg := False;
+  for VNode in VisibleNoInitNodes do begin
+    Ctrl := NodeControl[VNode];
+    H := NodeHeight[VNode];
+    if (Ctrl <> nil) then begin
+      if (Y < 0) or (Y + H >= ClientHeight) then begin
+        Chg := Chg or Ctrl.Visible;
+        Ctrl.Visible := False;
+      end
+      else begin
+        Chg := Chg or
+               (Ctrl.Top     <> Y) or
+               (Ctrl.Height  <> H) or
+               (Ctrl.Visible <> True);
+
+        Ctrl.Top     := Y;
+        Ctrl.Height  := H;
+        Ctrl.Visible := True;
+      end;
+    end;
+    Y := Y + H;
+  end;
+
+  if Chg then
+    Invalidate;
+end;
+
+procedure TDbgTreeView.EndUpdate;
+begin
+  inherited EndUpdate;
+  CheckControlsVisible;
+end;
+
+function TDbgTreeView.DoSetOffsetXY(Value: TPoint;
+  Options: TScrollUpdateOptions; ClipRect: PRect): Boolean;
+begin
+  Result := inherited DoSetOffsetXY(Value, Options, ClipRect);
+  {$if defined(LCLGtk) or defined(LCLGtk2)}
+  CheckControlsVisible;
+  {$endif}
+end;
+
 function TDbgTreeView.DoCollapsing(Node: PVirtualNode): Boolean;
   procedure RecursivelyHideControls(N: PVirtualNode);
   var
@@ -172,35 +382,15 @@ begin
   n := GetFirstChildNoInit(Node);
   if n <> nil then
     RecursivelyHideControls(n);
+  CheckControlsVisible;
 
   Result := inherited DoCollapsing(Node);
 end;
 
-function TDbgTreeView.DoExpanding(Node: PVirtualNode): Boolean;
-begin
-  FFirstVisibleBeforeExpanding := GetFirstVisibleNoInit(Node);
-  FLastVisibleBeforeExpanding := GetLastVisibleNoInit(Node);
-  Result := inherited DoExpanding(Node);
-end;
-
 procedure TDbgTreeView.DoExpanded(Node: PVirtualNode);
-var
-  N: PVirtualNode;
-  NData: PDbgTreeNodeData;
 begin
-  N := FFirstVisibleBeforeExpanding;
-  if N = nil then
-    N := GetFirstNoInit;
-  while (N <> nil) do begin
-    NData := GetNodeData(N);
-    if NData^.Control <> nil then
-      NData^.Control.Visible := False;
-
-    if N = FLastVisibleBeforeExpanding then
-      break;
-    N := GetNextNoInit(N);
-  end;
   inherited DoExpanded(Node);
+  CheckControlsVisible;
 end;
 
 procedure TDbgTreeView.ValidateNodeDataSize(var Size: Integer);
@@ -217,7 +407,8 @@ begin
     if (FOnItemRemoved <> nil) and (NData^.Item <> nil) then
       FOnItemRemoved(Self, NData^.Item, Node);
 
-    FreeAndNil(NData^.Control);
+    NData^.Control.Free;
+    ChangeControl(Node, NData, nil);
     NData^ := Default(TDbgTreeNodeData);
   end;
 
@@ -307,9 +498,12 @@ begin
   Result := PDbgTreeNodeData(inherited GetNodeData(Node));
 end;
 
-function TDbgTreeView.GetFocusedNode(OnlySelected: Boolean): PVirtualNode;
+function TDbgTreeView.GetFocusedNode(OnlySelected: Boolean;
+  AnIncludeControlNodes: Boolean): PVirtualNode;
 begin
   Result := FocusedNode;
+  if (not AnIncludeControlNodes) and (Result <> nil) and (NodeControl[Result] <> nil) then
+    Result := nil;
   if (Result = nil) or (OnlySelected and not Selected[Result]) then
     Result := nil;
 end;
@@ -353,6 +547,17 @@ begin
   Result := nil;
 end;
 
+function TDbgTreeView.FindNodeForControl(AControl: TObject): PVirtualNode;
+var
+  VNode: PVirtualNode;
+begin
+  for VNode in NoInitNodes do begin
+    if GetNodeControl(VNode) = AControl then
+      exit(VNode);
+  end;
+  Result := nil;
+end;
+
 function TDbgTreeView.FindNodeForText(AText: String; AColumn: integer;
   ATopLvlOnly: Boolean): PVirtualNode;
 var
@@ -385,8 +590,6 @@ begin
 end;
 
 procedure TDbgTreeView.LazMoveTo(Source, Target: PVirtualNode; Mode: TVTNodeAttachMode);
-var
-  NewNode: PVirtualNode;
 begin
   if Target = nil then
   begin
@@ -424,6 +627,33 @@ begin
   StructureChange(Source, crNodeMoved);
 end;
 
+function TDbgTreeView.NoInitItemNodes(ConsiderChildrenAbove: Boolean;
+  IncludeNonItemNodes: Boolean): TVTVirtualItemNodeEnumeration;
+begin
+  Result.FMode := vneNoInit;
+  Result.FTree := Self;
+  Result.FConsiderChildrenAbove := ConsiderChildrenAbove;
+  Result.FControlNodes := False;
+  Result.FIncludeNonItemNodes := IncludeNonItemNodes;
+end;
+
+function TDbgTreeView.SelectedItemNodes(ConsiderChildrenAbove: Boolean;
+  IncludeNonItemNodes: Boolean): TVTVirtualItemNodeEnumeration;
+begin
+  Result.FMode := vneSelected;
+  Result.FTree := Self;
+  Result.FConsiderChildrenAbove := ConsiderChildrenAbove;
+  Result.FControlNodes := False;
+  Result.FIncludeNonItemNodes := IncludeNonItemNodes;
+end;
+
+function TDbgTreeView.ControlNodes: TVTVirtualItemNodeEnumeration;
+begin
+  Result.FMode := vneNoInit;
+  Result.FTree := Self;
+  Result.FControlNodes := True;
+end;
+
 initialization
   RegisterClass(TDbgTreeView);