mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-11 00:28:18 +02:00
Debugger: Watches-Win, expand arrays to view entries
This commit is contained in:
Martin
parent
6deb576cda
commit
b814c37698
@ -41,11 +41,12 @@ uses
|
||||
Classes, Forms, Controls, math, sysutils, LazLoggerBase, LazUTF8, Clipbrd,
|
||||
{$ifdef Windows} ActiveX, {$else} laz.FakeActiveX, {$endif}
|
||||
IDEWindowIntf, Menus, ComCtrls, ActnList, ExtCtrls, StdCtrls, LCLType,
|
||||
IDEImagesIntf, LazarusIDEStrConsts, DebuggerStrConst, Debugger,
|
||||
LMessages, IDEImagesIntf, LazarusIDEStrConsts, DebuggerStrConst, Debugger,
|
||||
DebuggerTreeView, IdeDebuggerBase, DebuggerDlg, DbgIntfBaseTypes,
|
||||
DbgIntfDebuggerBase, DbgIntfMiscClasses, SynEdit, laz.VirtualTrees,
|
||||
DbgIntfDebuggerBase, DbgIntfMiscClasses, SynEdit, laz.VirtualTrees, SpinEx,
|
||||
LazDebuggerIntf, LazDebuggerIntfBaseTypes, BaseDebugManager, EnvironmentOpts,
|
||||
StrUtils, IdeDebuggerWatchResult, IdeDebuggerWatchResPrinter;
|
||||
StrUtils, IdeDebuggerWatchResult, IdeDebuggerWatchResPrinter,
|
||||
ArrayNavigationFrame;
|
||||
|
||||
type
|
||||
|
||||
@ -151,6 +152,7 @@ type
|
||||
function GetWatches: TIdeWatches;
|
||||
procedure ContextChanged(Sender: TObject);
|
||||
procedure SnapshotChanged(Sender: TObject);
|
||||
procedure WatchNavChanged(Sender: TArrayNavigationBar; AValue: Int64);
|
||||
private
|
||||
FWatchPrinter: TWatchResultPrinter;
|
||||
FWatchesInView: TIdeWatches;
|
||||
@ -168,6 +170,8 @@ type
|
||||
|
||||
procedure UpdateInspectPane;
|
||||
procedure UpdateItem(const VNode: PVirtualNode; const AWatch: TIdeWatch);
|
||||
procedure UpdateArraySubItems(const VNode: PVirtualNode;
|
||||
const AWatchValue: TIdeWatchValue; out ChildCount: LongWord);
|
||||
procedure UpdateSubItems(const VNode: PVirtualNode;
|
||||
const AWatchValue: TIdeWatchValue; out ChildCount: LongWord);
|
||||
procedure UpdateAll;
|
||||
@ -175,6 +179,7 @@ type
|
||||
function GetSelectedSnapshot: TSnapshot;
|
||||
property Watches: TIdeWatches read GetWatches;
|
||||
protected
|
||||
function IsShortcut(var Message: TLMKey): Boolean; override;
|
||||
procedure DoBeginUpdate; override;
|
||||
procedure DoEndUpdate; override;
|
||||
procedure DoWatchesChanged; override;
|
||||
@ -495,6 +500,12 @@ var
|
||||
s: String;
|
||||
NewWatch: TCurrentWatch;
|
||||
begin
|
||||
if (ActiveControl <> nil) and (
|
||||
(ActiveControl is TCustomEdit) or (ActiveControl is TCustomSpinEditEx)
|
||||
)
|
||||
then
|
||||
exit;
|
||||
|
||||
if (Shift * [ssShift, ssAlt, ssAltGr, ssCtrl] = [ssCtrl]) and (Key = VK_V)
|
||||
then begin
|
||||
Key := 0;
|
||||
@ -699,6 +710,28 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWatchesDlg.WatchNavChanged(Sender: TArrayNavigationBar; AValue: Int64
|
||||
);
|
||||
var
|
||||
VNode: PVirtualNode;
|
||||
AWatch: TIdeWatch;
|
||||
WatchValue: TIdeWatchValue;
|
||||
c: LongWord;
|
||||
begin
|
||||
if Sender.OwnerData = nil then
|
||||
exit;
|
||||
|
||||
AWatch := TIdeWatch(Sender.OwnerData);
|
||||
if AWatch.Enabled and AWatch.HasAllValidParents(GetThreadId, GetStackframe) then begin
|
||||
VNode := tvWatches.FindNodeForItem(AWatch);
|
||||
if VNode = nil then
|
||||
exit;
|
||||
|
||||
WatchValue := AWatch.Values[GetThreadId, GetStackframe];
|
||||
UpdateSubItems(VNode, WatchValue, c);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TWatchesDlg.GetWatches: TIdeWatches;
|
||||
var
|
||||
Snap: TSnapshot;
|
||||
@ -1058,8 +1091,11 @@ begin
|
||||
if DoDelayedDelete then
|
||||
exit;
|
||||
|
||||
HasChildren := ((TypInfo <> nil) and (TypInfo.Fields <> nil) and (TypInfo.Fields.Count > 0)) or
|
||||
((WatchValue.ResultData <> nil) and (WatchValue.ResultData.FieldCount > 0));
|
||||
HasChildren := ( (TypInfo <> nil) and (TypInfo.Fields <> nil) and (TypInfo.Fields.Count > 0) ) or
|
||||
( (WatchValue.ResultData <> nil) and
|
||||
( (WatchValue.ResultData.FieldCount > 0) or
|
||||
( (WatchValue.ResultData.ValueKind = rdkArray) and (WatchValue.ResultData.ArrayLength > 0) )
|
||||
) );
|
||||
tvWatches.HasChildren[VNode] := HasChildren;
|
||||
if HasChildren and (WatchValue.Validity = ddsValid) and tvWatches.Expanded[VNode] then begin
|
||||
(* The current "AWatch" should be done. Allow UpdateItem for nested entries *)
|
||||
@ -1095,6 +1131,93 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWatchesDlg.UpdateArraySubItems(const VNode: PVirtualNode;
|
||||
const AWatchValue: TIdeWatchValue; out ChildCount: LongWord);
|
||||
var
|
||||
NewWatch, AWatch: TIdeWatch;
|
||||
i, TotalCount: Integer;
|
||||
ResData: TWatchResultData;
|
||||
ExistingNode, nd: PVirtualNode;
|
||||
Nav: TArrayNavigationBar;
|
||||
Idx: String;
|
||||
Offs, KeepCnt, KeepBelow: Int64;
|
||||
begin
|
||||
ChildCount := 0;
|
||||
ResData := AWatchValue.ResultData;
|
||||
if (ResData = nil) then
|
||||
exit;
|
||||
|
||||
TotalCount := ResData.ArrayLength;
|
||||
if (ResData.ValueKind <> rdkArray) or (TotalCount = 0) then
|
||||
TotalCount := ResData.Count;
|
||||
|
||||
AWatch := AWatchValue.Watch;
|
||||
ExistingNode := tvWatches.GetFirstChildNoInit(VNode);
|
||||
if ExistingNode = nil then
|
||||
ExistingNode := tvWatches.AddChild(VNode, nil)
|
||||
else
|
||||
tvWatches.NodeItem[ExistingNode] := nil;
|
||||
|
||||
Nav := TArrayNavigationBar(tvWatches.NodeControl[ExistingNode]);
|
||||
if Nav = nil then begin
|
||||
Nav := TArrayNavigationBar.Create(Self);
|
||||
Nav.ParentColor := False;
|
||||
Nav.ParentBackground := False;
|
||||
Nav.Color := tvWatches.Colors.BackGroundColor;
|
||||
Nav.LowBound := ResData.LowBound;
|
||||
Nav.HighBound := ResData.LowBound + TotalCount - 1;
|
||||
Nav.ShowBoundInfo := True;
|
||||
Nav.Index := ResData.LowBound;
|
||||
Nav.PageSize := 10;
|
||||
Nav.OwnerData := AWatch;
|
||||
Nav.OnIndexChanged := @WatchNavChanged;
|
||||
Nav.OnPageSize := @WatchNavChanged;
|
||||
tvWatches.NodeControl[ExistingNode] := Nav;
|
||||
tvWatches.NodeText[ExistingNode, 0] := ' ';
|
||||
tvWatches.NodeText[ExistingNode, 1] := ' ';
|
||||
end;
|
||||
ChildCount := Nav.LimitedPageSize;
|
||||
|
||||
ExistingNode := tvWatches.GetNextSiblingNoInit(ExistingNode);
|
||||
|
||||
Offs := Nav.Index;
|
||||
for i := 0 to ChildCount do begin
|
||||
Idx := IntToStr(Offs + i);
|
||||
|
||||
NewWatch := AWatch.ChildrenByName[Idx];
|
||||
if NewWatch = nil then begin
|
||||
dec(ChildCount);
|
||||
continue;
|
||||
end;
|
||||
|
||||
if AWatch is TCurrentWatch then begin
|
||||
NewWatch.DisplayFormat := wdfDefault;
|
||||
NewWatch.Enabled := AWatch.Enabled;
|
||||
if EnvironmentOptions.DebuggerAutoSetInstanceFromClass then
|
||||
NewWatch.EvaluateFlags := [defClassAutoCast];
|
||||
end;
|
||||
|
||||
if ExistingNode <> nil then begin
|
||||
tvWatches.NodeItem[ExistingNode] := NewWatch;
|
||||
nd := ExistingNode;
|
||||
ExistingNode := tvWatches.GetNextSiblingNoInit(ExistingNode);
|
||||
end
|
||||
else begin
|
||||
nd := tvWatches.AddChild(VNode, NewWatch);
|
||||
end;
|
||||
UpdateItem(nd, NewWatch);
|
||||
end;
|
||||
|
||||
if AWatch is TCurrentWatch then begin
|
||||
KeepCnt := Nav.PageSize;
|
||||
KeepBelow := KeepCnt;
|
||||
KeepCnt := Max(Max(50, KeepCnt+10),
|
||||
Min(KeepCnt*10, 500) );
|
||||
KeepBelow := Min(KeepBelow, KeepCnt - Nav.PageSize);
|
||||
AWatch.LimitChildWatchCount(KeepCnt, ResData.LowBound + KeepBelow);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWatchesDlg.UpdateSubItems(const VNode: PVirtualNode;
|
||||
const AWatchValue: TIdeWatchValue; out ChildCount: LongWord);
|
||||
var
|
||||
@ -1112,6 +1235,8 @@ begin
|
||||
ChildCount := ResData.FieldCount;
|
||||
AWatch := AWatchValue.Watch;
|
||||
ExistingNode := tvWatches.GetFirstChildNoInit(VNode);
|
||||
if ExistingNode <> nil then
|
||||
tvWatches.NodeControl[ExistingNode].Free;
|
||||
|
||||
for i := 0 to ResData.FieldCount-1 do begin
|
||||
ChildInfo := ResData.Fields[i];
|
||||
@ -1141,6 +1266,13 @@ begin
|
||||
end;
|
||||
|
||||
end
|
||||
else
|
||||
if (AWatchValue.ResultData <> nil) and
|
||||
(AWatchValue.ResultData.ValueKind = rdkArray) and
|
||||
(AWatchValue.ResultData.ArrayLength > 0)
|
||||
then begin
|
||||
UpdateArraySubItems(VNode, AWatchValue, ChildCount);
|
||||
end
|
||||
else begin
|
||||
// Old Interface
|
||||
TypInfo := AWatchValue.TypeInfo;
|
||||
@ -1258,6 +1390,17 @@ begin
|
||||
then Result := SnapshotManager.SelectedEntry;
|
||||
end;
|
||||
|
||||
function TWatchesDlg.IsShortcut(var Message: TLMKey): Boolean;
|
||||
begin
|
||||
Result := false;
|
||||
if (ActiveControl <> nil) and (
|
||||
(ActiveControl is TCustomEdit) or (ActiveControl is TCustomSpinEditEx)
|
||||
)
|
||||
then
|
||||
exit;
|
||||
Result := inherited IsShortcut(Message);
|
||||
end;
|
||||
|
||||
procedure TWatchesDlg.WatchAdd(const ASender: TIdeWatches; const AWatch: TIdeWatch);
|
||||
var
|
||||
VNode: PVirtualNode;
|
||||
|
||||
@ -107,4 +107,13 @@ object ArrayNavigationBar: TArrayNavigationBar
|
||||
Flat = True
|
||||
OnClick = BtnChangeSizeClicked
|
||||
end
|
||||
object lblBounds: TLabel
|
||||
Left = 252
|
||||
Height = 26
|
||||
Top = 0
|
||||
Width = 1
|
||||
Align = alLeft
|
||||
BorderSpacing.Left = 10
|
||||
Visible = False
|
||||
end
|
||||
end
|
||||
|
||||
@ -26,6 +26,7 @@ type
|
||||
edArrayPageSize: TSpinEditEx;
|
||||
edArrayStart: TSpinEditEx;
|
||||
Label1: TLabel;
|
||||
lblBounds: TLabel;
|
||||
procedure BtnChangePageClicked(Sender: TObject);
|
||||
procedure BtnChangeSizeClicked(Sender: TObject);
|
||||
procedure edArrayPageSizeEditingDone(Sender: TObject);
|
||||
@ -35,19 +36,31 @@ type
|
||||
FLowBound: int64;
|
||||
FOnIndexChanged: TArrayNavChangeEvent;
|
||||
FOnPageSize: TArrayNavChangeEvent;
|
||||
FOwnerData: pointer;
|
||||
FShowBoundInfo: Boolean;
|
||||
function GetIndex: int64;
|
||||
function GetIndexOffs: int64;
|
||||
function GetLimitedPageSize: int64;
|
||||
function GetPageSize: int64;
|
||||
procedure SetHighBound(AValue: int64);
|
||||
procedure SetIndex(AValue: int64);
|
||||
procedure SetLowBound(AValue: int64);
|
||||
procedure SetPageSize(AValue: int64);
|
||||
procedure Loaded; override;
|
||||
procedure SetShowBoundInfo(AValue: Boolean);
|
||||
procedure UpdateBoundsInfo;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
property LowBound: int64 read FLowBound write SetLowBound;
|
||||
property HighBound: int64 read FHighBound write SetHighBound;
|
||||
property ShowBoundInfo: Boolean read FShowBoundInfo write SetShowBoundInfo;
|
||||
|
||||
property Index: int64 read GetIndex write SetIndex;
|
||||
property PageSize: int64 read GetPageSize write SetPageSize;
|
||||
property IndexOffs: int64 read GetIndexOffs;
|
||||
property LimitedPageSize: int64 read GetLimitedPageSize;
|
||||
|
||||
property OwnerData: pointer read FOwnerData write FOwnerData;
|
||||
published
|
||||
property OnIndexChanged: TArrayNavChangeEvent read FOnIndexChanged write FOnIndexChanged;
|
||||
property OnPageSize: TArrayNavChangeEvent read FOnPageSize write FOnPageSize;
|
||||
@ -63,6 +76,7 @@ procedure TArrayNavigationBar.SetHighBound(AValue: int64);
|
||||
begin
|
||||
if FHighBound = AValue then Exit;
|
||||
FHighBound := AValue;
|
||||
UpdateBoundsInfo;
|
||||
end;
|
||||
|
||||
procedure TArrayNavigationBar.BtnChangePageClicked(Sender: TObject);
|
||||
@ -123,6 +137,21 @@ begin
|
||||
Result := edArrayStart.Value;
|
||||
end;
|
||||
|
||||
function TArrayNavigationBar.GetIndexOffs: int64;
|
||||
begin
|
||||
Result := edArrayStart.Value - FLowBound;
|
||||
end;
|
||||
|
||||
function TArrayNavigationBar.GetLimitedPageSize: int64;
|
||||
var
|
||||
idx: Int64;
|
||||
begin
|
||||
Result := edArrayPageSize.Value;
|
||||
idx := edArrayStart.Value;
|
||||
if (idx >= FLowBound) and (idx < FHighBound) then
|
||||
Result := Max(1, Min(Result, FHighBound + 1 - idx));
|
||||
end;
|
||||
|
||||
function TArrayNavigationBar.GetPageSize: int64;
|
||||
begin
|
||||
Result := edArrayPageSize.Value;
|
||||
@ -137,6 +166,7 @@ procedure TArrayNavigationBar.SetLowBound(AValue: int64);
|
||||
begin
|
||||
if FLowBound = AValue then Exit;
|
||||
FLowBound := AValue;
|
||||
UpdateBoundsInfo;
|
||||
end;
|
||||
|
||||
procedure TArrayNavigationBar.SetPageSize(AValue: int64);
|
||||
@ -144,9 +174,34 @@ begin
|
||||
edArrayPageSize.Value := AValue;
|
||||
end;
|
||||
|
||||
procedure TArrayNavigationBar.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
Constraints.MinWidth := btnArrayPageInc.Left + btnArrayPageInc.Width;
|
||||
end;
|
||||
|
||||
procedure TArrayNavigationBar.SetShowBoundInfo(AValue: Boolean);
|
||||
begin
|
||||
if FShowBoundInfo = AValue then Exit;
|
||||
FShowBoundInfo := AValue;
|
||||
|
||||
UpdateBoundsInfo;
|
||||
lblBounds.Visible := FShowBoundInfo;
|
||||
end;
|
||||
|
||||
procedure TArrayNavigationBar.UpdateBoundsInfo;
|
||||
begin
|
||||
if not FShowBoundInfo then
|
||||
exit;
|
||||
|
||||
lblBounds.Caption := format(dlgInspectBoundsDD, [FLowBound, FHighBound]);
|
||||
end;
|
||||
|
||||
constructor TArrayNavigationBar.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
Name := '';
|
||||
Constraints.MinWidth := btnArrayPageInc.Left + btnArrayPageInc.Width;
|
||||
|
||||
edArrayStart.Hint := dlgInspectIndexOfFirstItemToShow;
|
||||
edArrayPageSize.Hint := dlgInspectAmountOfItemsToShow;
|
||||
|
||||
@ -609,6 +609,7 @@ type
|
||||
|
||||
procedure BeginChildUpdate;
|
||||
procedure EndChildUpdate;
|
||||
procedure LimitChildWatchCount(AMaxCnt: Integer; AKeepIndexEntriesBelow: Int64 = low(Int64));
|
||||
property ChildrenByName[AName: String]: TIdeWatch read GetChildrenByName;
|
||||
function HasAllValidParents(AThreadId: Integer; AStackFrame: Integer): boolean;
|
||||
property ParentWatch: TIdeWatch read FParentWatch;
|
||||
@ -6230,6 +6231,23 @@ begin
|
||||
FChildWatches.EndUpdate;
|
||||
end;
|
||||
|
||||
procedure TIdeWatch.LimitChildWatchCount(AMaxCnt: Integer;
|
||||
AKeepIndexEntriesBelow: Int64);
|
||||
var
|
||||
w: TIdeWatch;
|
||||
x: int64;
|
||||
i: Integer;
|
||||
begin
|
||||
i := 0;
|
||||
while (FChildWatches.Count > AMaxCnt) and (i < FChildWatches.Count) do begin
|
||||
w := FChildWatches[i];
|
||||
if TryStrToInt64(w.Expression, x) and (x < AKeepIndexEntriesBelow) then
|
||||
inc(i)
|
||||
else
|
||||
FChildWatches.Delete(0);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TIdeWatch.HasAllValidParents(AThreadId: Integer; AStackFrame: Integer
|
||||
): boolean;
|
||||
begin
|
||||
@ -6266,7 +6284,10 @@ var
|
||||
begin
|
||||
Result := Expression;
|
||||
if FParentWatch <> nil then begin
|
||||
Result := '(' + FParentWatch.GetFullExpression(AThreadId, AStackFrame) + ').' + Result;
|
||||
if (Result <> '') and (Result[1] in ['0'..'9']) then
|
||||
Result := '(' + FParentWatch.GetFullExpression(AThreadId, AStackFrame) + ')[' + Result+']'
|
||||
else
|
||||
Result := '(' + FParentWatch.GetFullExpression(AThreadId, AStackFrame) + ').' + Result;
|
||||
if (defClassAutoCast in FParentWatch.FEvaluateFlags) then begin
|
||||
wv := GetAnyValidParentWatchValue(AThreadId, AStackFrame);
|
||||
if wv.ResultData <> nil then
|
||||
@ -6463,7 +6484,14 @@ end;
|
||||
destructor TCurrentWatch.Destroy;
|
||||
var
|
||||
w: TCurrentWatches;
|
||||
s: TIdeWatch;
|
||||
begin
|
||||
if FSnapShot <> nil then begin
|
||||
s := FSnapShot;
|
||||
SnapShot := Nil;
|
||||
FreeAndNil(s);
|
||||
end;
|
||||
|
||||
if (TCurrentWatches(Collection) <> nil)
|
||||
then begin
|
||||
TCurrentWatches(Collection).NotifyRemove(Self);
|
||||
|
||||
@ -5,13 +5,14 @@ unit DebuggerTreeView;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, laz.VirtualTrees, LMessages;
|
||||
Classes, SysUtils, laz.VirtualTrees, SpinEx, LMessages, Controls;
|
||||
|
||||
type
|
||||
|
||||
TDbgTreeNodeData = record
|
||||
Item: TObject;
|
||||
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;
|
||||
end;
|
||||
PDbgTreeNodeData = ^TDbgTreeNodeData;
|
||||
|
||||
@ -19,11 +20,14 @@ type
|
||||
|
||||
TDbgTreeView = class(TLazVirtualStringTree)
|
||||
private
|
||||
function GetNodeControl(Node: PVirtualNode): TControl;
|
||||
function GetNodeItem(Node: PVirtualNode): TObject;
|
||||
function GetNodeText(Node: PVirtualNode; AColumn: integer): String;
|
||||
procedure SetNodeControl(Node: PVirtualNode; AValue: TControl);
|
||||
procedure SetNodeItem(Node: PVirtualNode; AValue: TObject);
|
||||
procedure SetNodeText(Node: PVirtualNode; AColumn: integer; AValue: String);
|
||||
protected
|
||||
function DoCollapsing(Node: PVirtualNode): Boolean; override;
|
||||
procedure ValidateNodeDataSize(var Size: Integer); override;
|
||||
procedure DoFreeNode(Node: PVirtualNode); override;
|
||||
function DetermineLineImageAndSelectLevel(Node: PVirtualNode;
|
||||
@ -31,6 +35,7 @@ type
|
||||
procedure HandleMouseDblClick(var Message: TLMMouse; const HitInfo: THitInfo); override;
|
||||
procedure DoGetText(Node: PVirtualNode; Column: TColumnIndex;
|
||||
TextType: TVSTTextType; var AText: String); override;
|
||||
procedure DoPaintNode(var PaintInfo: TVTPaintInfo); override;
|
||||
public
|
||||
function GetNodeData(Node: PVirtualNode): PDbgTreeNodeData; reintroduce;
|
||||
|
||||
@ -44,12 +49,23 @@ type
|
||||
|
||||
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;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TDbgTreeView }
|
||||
|
||||
function TDbgTreeView.GetNodeControl(Node: PVirtualNode): TControl;
|
||||
var
|
||||
Data: PDbgTreeNodeData;
|
||||
begin
|
||||
Result := nil;
|
||||
Data := GetNodeData(Node);
|
||||
if Data <> nil then
|
||||
Result := Data^.Control;
|
||||
end;
|
||||
|
||||
function TDbgTreeView.GetNodeItem(Node: PVirtualNode): TObject;
|
||||
var
|
||||
Data: PDbgTreeNodeData;
|
||||
@ -70,6 +86,25 @@ begin
|
||||
Result := Data^.CachedText[AColumn];
|
||||
end;
|
||||
|
||||
procedure TDbgTreeView.SetNodeControl(Node: PVirtualNode; AValue: TControl);
|
||||
var
|
||||
Data: PDbgTreeNodeData;
|
||||
begin
|
||||
Data := GetNodeData(Node);
|
||||
if Data = nil then
|
||||
exit;
|
||||
if Data^.Control = AValue then
|
||||
exit;
|
||||
|
||||
Data^.Control.Free;
|
||||
Data^.Control := AValue;
|
||||
if AValue <> nil then begin
|
||||
AValue.Visible := False;
|
||||
AValue.Parent := Self;
|
||||
AValue.AutoSize := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDbgTreeView.SetNodeItem(Node: PVirtualNode; AValue: TObject);
|
||||
var
|
||||
Data: PDbgTreeNodeData;
|
||||
@ -92,6 +127,33 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDbgTreeView.DoCollapsing(Node: PVirtualNode): Boolean;
|
||||
procedure RecursivelyHideControls(N: PVirtualNode);
|
||||
var
|
||||
N2: PVirtualNode;
|
||||
NData: PDbgTreeNodeData;
|
||||
begin
|
||||
NData := GetNodeData(N);
|
||||
if NData^.Control <> nil then
|
||||
NData^.Control.Visible := False;
|
||||
|
||||
while N <> nil do begin
|
||||
N2 := GetFirstChildNoInit(N);
|
||||
if N2 <> nil then
|
||||
RecursivelyHideControls(N2);
|
||||
N := GetNextSiblingNoInit(N);
|
||||
end;
|
||||
end;
|
||||
var
|
||||
n: PVirtualNode;
|
||||
begin
|
||||
n := GetFirstChildNoInit(Node);
|
||||
if n <> nil then
|
||||
RecursivelyHideControls(n);
|
||||
|
||||
Result := inherited DoCollapsing(Node);
|
||||
end;
|
||||
|
||||
procedure TDbgTreeView.ValidateNodeDataSize(var Size: Integer);
|
||||
begin
|
||||
Size := SizeOf(TDbgTreeNodeData);
|
||||
@ -99,6 +161,7 @@ end;
|
||||
|
||||
procedure TDbgTreeView.DoFreeNode(Node: PVirtualNode);
|
||||
begin
|
||||
PDbgTreeNodeData(GetNodeData(Node))^.Control.Free;
|
||||
PDbgTreeNodeData(GetNodeData(Node))^ := Default(TDbgTreeNodeData);
|
||||
inherited DoFreeNode(Node);
|
||||
end;
|
||||
@ -134,6 +197,29 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDbgTreeView.DoPaintNode(var PaintInfo: TVTPaintInfo);
|
||||
var
|
||||
NData: PDbgTreeNodeData;
|
||||
r: TRect;
|
||||
begin
|
||||
NData := GetNodeData(PaintInfo.Node);
|
||||
if NData^.Control <> nil then begin
|
||||
if PaintInfo.Column = 0 then begin
|
||||
r := GetDisplayRect(PaintInfo.Node, 0, True, False);
|
||||
r.Right := ClientWidth - r.Left - 1;
|
||||
NData^.Control.BoundsRect := r;
|
||||
NData^.Control.Visible := True;
|
||||
if (r.Top < (r.Bottom - r.Height) * 2 + 5) or
|
||||
(r.Bottom > ClientHeight - (r.Bottom - r.Height) * 2 - 5)
|
||||
then
|
||||
NData^.Control.Invalidate;
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
|
||||
inherited DoPaintNode(PaintInfo);
|
||||
end;
|
||||
|
||||
function TDbgTreeView.GetNodeData(Node: PVirtualNode): PDbgTreeNodeData;
|
||||
begin
|
||||
Result := PDbgTreeNodeData(inherited GetNodeData(Node));
|
||||
|
||||
@ -10,6 +10,7 @@ interface
|
||||
resourcestring
|
||||
dlgInspectIndexOfFirstItemToShow = 'Index of first item to show';
|
||||
dlgInspectAmountOfItemsToShow = 'Amount of items to show';
|
||||
dlgInspectBoundsDD = 'Bounds: %d .. %d';
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user