paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-27 13:00:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

Debugger, VTV: fix pop-up menu versus dragging. Only drag on left mouse -- Fix clearing controls that are invisible after scrolled by an expanding node.

Browse Source
This commit is contained in:
Martin 2022-06-14 22:34:13 +02:00
parent d1ca85c248
commit 3c5a7c2742
1 changed files with 16 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
ide/packages/idedebugger/debuggertreeview.pas
View File

@ -20,7 +20,7 @@ type
TDbgTreeView = class(TLazVirtualStringTree)
private
FLastVisibleBeforeExpanding: PVirtualNode;
FFirstVisibleBeforeExpanding, FLastVisibleBeforeExpanding: PVirtualNode;
function GetNodeControl(Node: PVirtualNode): TControl;
function GetNodeItem(Node: PVirtualNode): TObject;
function GetNodeText(Node: PVirtualNode; AColumn: integer): String;
@ -37,6 +37,7 @@ type
var LineImage: TLineImage): Integer; override;
function DetermineDropMode(const P: TPoint; var HitInfo: THitInfo;
var NodeRect: TRect): TDropMode; override;
procedure HandleMouseDown(var Message: TLMMouse; var HitInfo: THitInfo); override;
procedure HandleMouseDblClick(var Message: TLMMouse; const HitInfo: THitInfo); override;
procedure DoGetText(Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var AText: String); override;
@ -161,6 +162,7 @@ end;
function TDbgTreeView.DoExpanding(Node: PVirtualNode): Boolean;
begin
FFirstVisibleBeforeExpanding := GetFirstVisibleNoInit(Node);
FLastVisibleBeforeExpanding := GetLastVisibleNoInit(Node);
Result := inherited DoExpanding(Node);
end;
@ -170,7 +172,9 @@ var
N: PVirtualNode;
NData: PDbgTreeNodeData;
begin
N := GetLastVisibleNoInit(Node);
N := FFirstVisibleBeforeExpanding;
if N = nil then
N := GetFirstNoInit;
while (N <> nil) do begin
NData := GetNodeData(N);
if NData^.Control <> nil then
@ -225,6 +229,16 @@ begin
Result := dmNowhere;
end;
procedure TDbgTreeView.HandleMouseDown(var Message: TLMMouse;
var HitInfo: THitInfo);
begin
if Message.Msg = LM_LBUTTONDOWN then
DragMode := dmAutomatic
else
DragMode := dmManual;
inherited HandleMouseDown(Message, HitInfo);
end;
procedure TDbgTreeView.HandleMouseDblClick(var Message: TLMMouse;
const HitInfo: THitInfo);
begin