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

Debugger, RegisterDialog: replace Listview with Grid. Listview cuts item to 260 chars length max. Issue #37797

Browse Source 
git-svn-id: trunk@63914 -
This commit is contained in:
martin 2020-09-23 21:11:50 +00:00
parent 466084cebd
commit 54c7239f4f
2 changed files with 173 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
debugger/registersdlg.lfm
View File

@ -1,4 +1,4 @@
inherited RegistersDlg: TRegistersDlg object RegistersDlg: TRegistersDlg
Left = 342 Left = 342
Height = 253 Height = 253
Top = 117 Top = 117
@ -9,29 +9,6 @@ inherited RegistersDlg: TRegistersDlg
ClientHeight = 253 ClientHeight = 253
ClientWidth = 346 ClientWidth = 346
LCLVersion = '2.1.0.0' LCLVersion = '2.1.0.0'
object lvRegisters: TListView
Left = 0
Height = 227
Top = 26
Width = 346
Align = alClient
Columns = <
item
Caption = 'Name'
Width = 150
end
item
Caption = 'Value'
end>
MultiSelect = True
PopupMenu = PopupMenu1
RowSelect = True
SmallImages = ImageList1
SortType = stText
TabOrder = 0
ViewStyle = vsReport
OnSelectItem = lvRegistersSelectItem
end
object ToolBar1: TToolBar object ToolBar1: TToolBar
Left = 0 Left = 0
Height = 26 Height = 26
@ -52,13 +29,13 @@ inherited RegistersDlg: TRegistersDlg
end end
object ToolButton1: TToolButton object ToolButton1: TToolButton
Left = 24 Left = 24
Height = 22
Top = 2 Top = 2
Width = 10
Caption = 'ToolButton1' Caption = 'ToolButton1'
Style = tbsSeparator Style = tbsSeparator
end end
object ToolButtonDispType: TToolButton object ToolButtonDispType: TToolButton
Left = 34 Left = 32
Top = 2 Top = 2
Caption = '...' Caption = '...'
DropdownMenu = PopupDispType DropdownMenu = PopupDispType
@ -68,26 +45,51 @@ inherited RegistersDlg: TRegistersDlg
Style = tbsDropDown Style = tbsDropDown
end end
end end
object lvRegisters: TStringGridAllowRightMouse
Left = 0
Height = 227
Top = 26
Width = 346
Align = alClient
AutoEdit = False
ColCount = 3
ColumnClickSorts = True
Columns = <
item
Title.Caption = ' '
Width = 18
end
item
Title.Caption = 'Name'
Width = 70
end
item
Title.Caption = 'Value'
Width = 400
end>
FixedCols = 0
Options = [goFixedVertLine, goRangeSelect, goColSizing, goRowSelect, goThumbTracking, goSmoothScroll, goFixedColSizing]
PopupMenu = PopupMenu1
RowCount = 1
TabOrder = 0
OnDrawCell = lvRegistersDrawCell
OnSelection = lvRegistersSelection
end
object ImageList1: TImageList object ImageList1: TImageList
Height = 8 Height = 8
Width = 8 Width = 8
Left = 112 left = 96
Top = 93 top = 104
Bitmap = { Bitmap = {
4C69010000000800000008000000000000000000000000000000000000000000 4C7A010000000800000008000000630000000000000078DA6360200EC4DCEDFA
000000000000000000000000000000000000000000005CDD8AFF33D56FFF65DE 6F7C35FF7FEABDFEFFE872FE974BFE8B1EF3FC2F7ECCFBBF0890F63F5B84A246
8FFF000000000000000000000000000000004FD374FF15C649FF17C64BFF14C6 72BBCD7F9ECD06406C08A6453758A0C8FBED89FDCFBC40EA3FCB4219202DF93F
49FF4FCD72FF00000000000000000000000019B73CFF0CB330FF0CB331FF0CB3 60673C861DDE9BC2FF8BCD55FF1FB615538E120000CF852E03
30FF15B038FF0000000000000000000000004EBC5DFF03A01AFF04A11CFF03A0
19FF50B95FFF000000000000000000000000000000004BB257FF169D27FF56B5
5FFF000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000
} }
end end
object ActionList1: TActionList object ActionList1: TActionList
Left = 200 left = 200
Top = 112 top = 112
object actPower: TAction object actPower: TAction
Enabled = False Enabled = False
OnExecute = actPowerExecute OnExecute = actPowerExecute
@ -118,8 +120,8 @@ inherited RegistersDlg: TRegistersDlg
end end
end end
object PopupDispType: TPopupMenu object PopupDispType: TPopupMenu
Left = 200 left = 200
Top = 176 top = 176
object DispDefault: TMenuItem object DispDefault: TMenuItem
Caption = 'New Item1' Caption = 'New Item1'
OnClick = DispDefaultClick OnClick = DispDefaultClick
@ -146,8 +148,8 @@ inherited RegistersDlg: TRegistersDlg
end end
end end
object PopupMenu1: TPopupMenu object PopupMenu1: TPopupMenu
Left = 95 left = 95
Top = 178 top = 178
object popFormat: TMenuItem object popFormat: TMenuItem
Caption = 'New Item1' Caption = 'New Item1'
object PopDispDefault: TMenuItem object PopDispDefault: TMenuItem

193
debugger/registersdlg.pp
View File

@ -38,11 +38,20 @@ interface
uses uses
SysUtils, Classes, Controls, Forms, Clipbrd, SysUtils, Classes, Controls, Forms, Clipbrd,
BaseDebugManager, IDEWindowIntf, DebuggerStrConst, BaseDebugManager, IDEWindowIntf, DebuggerStrConst,
ComCtrls, ActnList, Menus, Debugger, DebuggerDlg, ComCtrls, ActnList, Menus, Grids, Debugger, DebuggerDlg,
LazarusIDEStrConsts, IDEImagesIntf, DbgIntfDebuggerBase; LazarusIDEStrConsts, IDEImagesIntf, DbgIntfDebuggerBase, Types;
type type
{ TStringGridAllowRightMouse }
TStringGridAllowRightMouse = class(TStringGrid)
protected
FAllowRightButton: Boolean;
function MouseButtonAllowed(Button: TMouseButton): boolean; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
end;
{ TRegistersDlg } { TRegistersDlg }
TRegistersDlg = class(TDebuggerDlg) TRegistersDlg = class(TDebuggerDlg)
@ -53,7 +62,7 @@ type
actPower: TAction; actPower: TAction;
ActionList1: TActionList; ActionList1: TActionList;
ImageList1: TImageList; ImageList1: TImageList;
lvRegisters: TListView; lvRegisters: TStringGridAllowRightMouse;
DispDefault: TMenuItem; DispDefault: TMenuItem;
DispHex: TMenuItem; DispHex: TMenuItem;
DispBin: TMenuItem; DispBin: TMenuItem;
@ -84,7 +93,9 @@ type
procedure actCopyValueExecute(Sender: TObject); procedure actCopyValueExecute(Sender: TObject);
procedure actPowerExecute(Sender: TObject); procedure actPowerExecute(Sender: TObject);
procedure DispDefaultClick(Sender: TObject); procedure DispDefaultClick(Sender: TObject);
procedure lvRegistersSelectItem(Sender: TObject; Item: TListItem; {%H-}Selected: Boolean); procedure lvRegistersDrawCell(Sender: TObject; aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState);
procedure lvRegistersSelection(Sender: TObject; aCol, aRow: Integer);
procedure ToolButtonDispTypeClick(Sender: TObject); procedure ToolButtonDispTypeClick(Sender: TObject);
function GetCurrentRegisters: TRegisters; function GetCurrentRegisters: TRegisters;
private private
@ -118,7 +129,7 @@ var
const const
COL_REGISTER_NAME = 1; COL_REGISTER_NAME = 1;
COL_REGISTER_VALUE = 2; COL_REGISTER_VALUE = 2;
COL_WIDTHS: Array[0..1] of integer = ( 150, 50); COL_WIDTHS: Array[0..2] of integer = (18, 50, 350);
function RegisterDlgColSizeGetter(AForm: TCustomForm; AColId: Integer; var ASize: Integer): Boolean; function RegisterDlgColSizeGetter(AForm: TCustomForm; AColId: Integer; var ASize: Integer): Boolean;
begin begin
@ -133,6 +144,29 @@ begin
TRegistersDlg(AForm).ColSizeSetter(AColId, ASize); TRegistersDlg(AForm).ColSizeSetter(AColId, ASize);
end; end;
{ TStringGridAllowRightMouse }
function TStringGridAllowRightMouse.MouseButtonAllowed(Button: TMouseButton
): boolean;
begin
Result := inherited MouseButtonAllowed(Button);
if (not Result) and (Button = mbRight) then
Result := FAllowRightButton;
end;
procedure TStringGridAllowRightMouse.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
p: TPoint;
begin
FAllowRightButton := False;
if Button = mbRight then begin
p := MouseToCell(Point(X,Y));
FAllowRightButton := not IsCellSelected[p.X, p.Y];
end;
inherited MouseDown(Button, Shift, X, Y);
end;
{ TRegistersDlg } { TRegistersDlg }
constructor TRegistersDlg.Create(AOwner: TComponent); constructor TRegistersDlg.Create(AOwner: TComponent);
@ -145,8 +179,9 @@ begin
RegistersNotification.OnChange := @RegistersChanged; RegistersNotification.OnChange := @RegistersChanged;
Caption:= lisRegisters; Caption:= lisRegisters;
lvRegisters.Columns[0].Caption:= lisName; lvRegisters.Columns[1].Title.Caption:= lisName;
lvRegisters.Columns[1].Caption:= lisValue; lvRegisters.Columns[2].Title.Caption:= lisValue;
lvRegisters.RangeSelectMode := rsmMulti;
ActionList1.Images := IDEImages.Images_16; ActionList1.Images := IDEImages.Images_16;
ToolBar1.Images := IDEImages.Images_16; ToolBar1.Images := IDEImages.Images_16;
@ -193,7 +228,7 @@ begin
popFormat.Caption := regdlgFormat; popFormat.Caption := regdlgFormat;
for i := low(COL_WIDTHS) to high(COL_WIDTHS) do for i := low(COL_WIDTHS) to high(COL_WIDTHS) do
lvRegisters.Column[i].Width := COL_WIDTHS[i]; lvRegisters.Columns[i].Width := COL_WIDTHS[i];
end; end;
destructor TRegistersDlg.Destroy; destructor TRegistersDlg.Destroy;
@ -216,48 +251,72 @@ begin
end; end;
procedure TRegistersDlg.actCopyNameExecute(Sender: TObject); procedure TRegistersDlg.actCopyNameExecute(Sender: TObject);
var
s: String;
i: Integer;
begin begin
s := '';
for i := 1 to lvRegisters.RowCount - 1 do
if lvRegisters.IsCellSelected[0,i] then begin
if s <> '' then
s := s + LineEnding;
s := s + lvRegisters.Cells[1, i];
end;
Clipboard.Open; Clipboard.Open;
Clipboard.AsText := lvRegisters.Selected.Caption; Clipboard.AsText := s;
Clipboard.Close; Clipboard.Close;
end; end;
procedure TRegistersDlg.actCopyValueExecute(Sender: TObject); procedure TRegistersDlg.actCopyValueExecute(Sender: TObject);
var
s: String;
i: Integer;
begin begin
s := '';
for i := 1 to lvRegisters.RowCount - 1 do
if lvRegisters.IsCellSelected[0,i] then begin
if s <> '' then
s := s + LineEnding;
s := s + lvRegisters.Cells[2,i];
end;
Clipboard.Open; Clipboard.Open;
Clipboard.AsText := lvRegisters.Selected.SubItems[0]; Clipboard.AsText := s;
Clipboard.Close; Clipboard.Close;
end; end;
procedure TRegistersDlg.actCopyNameValueExecute(Sender: TObject); procedure TRegistersDlg.actCopyNameValueExecute(Sender: TObject);
var
s: String;
i: Integer;
begin begin
s := '';
for i := 1 to lvRegisters.RowCount - 1 do
if lvRegisters.IsCellSelected[0,i] then begin
if s <> '' then
s := s + LineEnding;
s := s + lvRegisters.Cells[1, i] + '=' + lvRegisters.Cells[2,i];
end;
Clipboard.Open; Clipboard.Open;
Clipboard.AsText := Concat(lvRegisters.Selected.Caption, '=', Clipboard.AsText := s;
lvRegisters.Selected.SubItems[0]);
Clipboard.Close; Clipboard.Close;
end; end;
procedure TRegistersDlg.actCopyAllExecute(Sender: TObject); procedure TRegistersDlg.actCopyAllExecute(Sender: TObject);
var var
T: string; s: String;
I: Integer; i: Integer;
LI: TListItem;
begin begin
s := '';
for i := 1 to lvRegisters.RowCount - 1 do
s := Concat(s, lvRegisters.Cells[1, i], '=', lvRegisters.Cells[2,i], sLineBreak);
Clipboard.Open; Clipboard.Open;
T := ''; Clipboard.AsText := s;
for I := 0 to Pred(lvRegisters.Items.Count) do
begin
LI := lvRegisters.Items[I];
T := Concat(T, LI.Caption, '=', LI.SubItems[0], sLineBreak);
end;
Clipboard.AsText := T;
Clipboard.Close; Clipboard.Close;
end; end;
procedure TRegistersDlg.DispDefaultClick(Sender: TObject); procedure TRegistersDlg.DispDefaultClick(Sender: TObject);
var var
n: Integer; n: Integer;
Item: TListItem;
Reg: TRegisters; Reg: TRegisters;
RegVal: TRegisterValue; RegVal: TRegisterValue;
begin begin
@ -265,20 +324,28 @@ begin
Reg := GetCurrentRegisters; Reg := GetCurrentRegisters;
if Reg = nil then exit; if Reg = nil then exit;
for n := 0 to lvRegisters.Items.Count -1 do for n := 1 to lvRegisters.RowCount - 1 do
begin if lvRegisters.IsCellSelected[0,n] then begin
Item := lvRegisters.Items[n]; RegVal := Reg.EntriesByName[lvRegisters.Cells[1,n]];
if Item.Selected then begin
RegVal := Reg.EntriesByName[Item.Caption];
if RegVal <> nil then if RegVal <> nil then
RegVal.DisplayFormat := TRegisterDisplayFormat(TMenuItem(Sender).Tag); RegVal.DisplayFormat := TRegisterDisplayFormat(TMenuItem(Sender).Tag);
end; end;
end; lvRegistersSelection(nil, -1, -1);
lvRegistersSelectItem(nil, nil, True);
end; end;
procedure TRegistersDlg.lvRegistersSelectItem(Sender: TObject; Item: TListItem; procedure TRegistersDlg.lvRegistersDrawCell(Sender: TObject; aCol,
Selected: Boolean); aRow: Integer; aRect: TRect; aState: TGridDrawState);
begin
if (aCol = 0) and (aRow > 0) and
(lvRegisters.Objects[0, aRow] <> nil)
then begin
ImageList1.Draw(lvRegisters.Canvas, (aRect.Left + aRect.Right - ImageList1.Width) div 2,
(aRect.Top + aRect.Bottom - ImageList1.Height) div 2, 0);
end;
end;
procedure TRegistersDlg.lvRegistersSelection(Sender: TObject; aCol,
aRow: Integer);
var var
n, j: Integer; n, j: Integer;
SelFormat: TRegisterDisplayFormat; SelFormat: TRegisterDisplayFormat;
@ -292,11 +359,9 @@ begin
Reg := GetCurrentRegisters; Reg := GetCurrentRegisters;
if Reg = nil then exit; if Reg = nil then exit;
for n := 0 to lvRegisters.Items.Count -1 do for n := 1 to lvRegisters.RowCount - 1 do
begin if lvRegisters.IsCellSelected[0,n] then begin
Item := lvRegisters.Items[n]; RegVal := Reg.EntriesByName[lvRegisters.Cells[1,n]];
if Item.Selected then begin
RegVal := Reg.EntriesByName[Item.Caption];
if RegVal <> nil then begin if RegVal <> nil then begin
if j = 0 if j = 0
then SelFormat := RegVal.DisplayFormat; then SelFormat := RegVal.DisplayFormat;
@ -307,13 +372,12 @@ begin
end; end;
end; end;
end; end;
end;
ToolButtonDispType.Enabled := j > 0; ToolButtonDispType.Enabled := j > 0;
popFormat.Enabled := j > 0; popFormat.Enabled := j > 0;
actCopyName.Enabled := j > 0; actCopyName.Enabled := j > 0;
actCopyValue.Enabled := j > 0; actCopyValue.Enabled := j > 0;
actCopyNameValue.Enabled := j > 0; actCopyNameValue.Enabled := j > 0;
actCopyAll.Enabled := lvRegisters.Items.Count > 0; actCopyAll.Enabled := lvRegisters.RowCount > 1;
PopDispDefault.Checked := False; PopDispDefault.Checked := False;
PopDispHex.Checked := False; PopDispHex.Checked := False;
@ -381,9 +445,8 @@ end;
procedure TRegistersDlg.RegistersChanged(Sender: TObject); procedure TRegistersDlg.RegistersChanged(Sender: TObject);
var var
n, idx, Cnt: Integer; n, i, idx, Cnt: Integer;
List: TStringList; List: TStringList;
Item: TListItem;
S: String; S: String;
Reg: TRegisters; Reg: TRegisters;
begin begin
@ -400,25 +463,22 @@ begin
Reg := GetCurrentRegisters; Reg := GetCurrentRegisters;
if (Reg = nil) or (reg.DataValidity<> ddsValid) then begin if (Reg = nil) or (reg.DataValidity<> ddsValid) then begin
if (DebugBoss = nil) or not (DebugBoss.State in [dsPause, dsInternalPause, dsRun]) then if (DebugBoss = nil) or not (DebugBoss.State in [dsPause, dsInternalPause, dsRun]) then
lvRegisters.Items.Clear; lvRegisters.RowCount := 1;
if (reg <> nil) then if (reg <> nil) then
reg.Count; reg.Count;
for n := 0 to lvRegisters.Items.Count - 1 do for n := 1 to lvRegisters.RowCount - 1 do
if lvRegisters.Items[n].SubItems[0] <> '<Unavailable>' then lvRegisters.Cells[2, n] := '<Unavailable>';
lvRegisters.Items[n].SubItems[0] := '<Unavailable>';
exit; exit;
end; end;
List := TStringList.Create; List := TStringList.Create;
try try
//Get existing items //Get existing items
for n := 0 to lvRegisters.Items.Count - 1 do for n := 1 to lvRegisters.RowCount - 1 do
begin begin
Item := lvRegisters.Items[n]; S := UpperCase(lvRegisters.Cells[1,n]);
S := Item.Caption; List.AddObject(S, TObject(ptruint(n)));
S := UpperCase(S);
List.AddObject(S, Item);
end; end;
// add/update entries // add/update entries
@ -431,24 +491,27 @@ begin
if idx = -1 if idx = -1
then begin then begin
// New entry // New entry
Item := lvRegisters.Items.Add; i := lvRegisters.RowCount;
Item.Caption := Reg[n].Name; lvRegisters.RowCount := i + 1;
Item.SubItems.Add(Reg[n].Value); lvRegisters.Cells[1, i] := Reg[n].Name;
lvRegisters.Cells[2, i] := Reg[n].Value;
end end
else begin else begin
// Existing entry // Existing entry
Item := TListItem(List.Objects[idx]); i := PtrUInt(List.Objects[idx]);
Item.SubItems[0] := Reg[n].Value;
List.Delete(idx); List.Delete(idx);
lvRegisters.Cells[1, i] := Reg[n].Name;
lvRegisters.Cells[2, i] := Reg[n].Value;
end; end;
if Reg[n].Modified if Reg[n].Modified
then Item.ImageIndex := 0 then lvRegisters.Objects[0, i] := TObject(ptruint(1)) //Item.ImageIndex := 0
else Item.ImageIndex := -1; else lvRegisters.Objects[0, i] := nil; //Item.ImageIndex := -1;
end; end;
// remove obsolete entries // remove obsolete entries
for n := 0 to List.Count - 1 do for n := List.Count - 1 downto 0 do
lvRegisters.Items.Delete(TListItem(List.Objects[n]).Index); lvRegisters.DeleteRow(PtrUInt(List.Objects[n]));
lvRegisters.Invalidate;
finally finally
List.Free; List.Free;
@ -457,7 +520,7 @@ begin
EndUpdate; EndUpdate;
end; end;
lvRegistersSelectItem(nil, nil, True); lvRegistersSelection(nil, -1, -1);
end; end;
procedure TRegistersDlg.DoRegistersChanged; procedure TRegistersDlg.DoRegistersChanged;
@ -482,9 +545,9 @@ end;
function TRegistersDlg.ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean; function TRegistersDlg.ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean;
begin begin
if (AColId - 1 >= 0) and (AColId - 1 < lvRegisters.ColumnCount) then begin if (AColId >= 0) and (AColId < lvRegisters.Columns.Count) then begin
ASize := lvRegisters.Column[AColId - 1].Width; ASize := lvRegisters.Columns[AColId].Width;
Result := ASize <> COL_WIDTHS[AColId - 1]; Result := ASize <> COL_WIDTHS[AColId];
end end
else else
Result := False; Result := False;
@ -493,8 +556,8 @@ end;
procedure TRegistersDlg.ColSizeSetter(AColId: Integer; ASize: Integer); procedure TRegistersDlg.ColSizeSetter(AColId: Integer; ASize: Integer);
begin begin
case AColId of case AColId of
COL_REGISTER_NAME: lvRegisters.Column[0].Width := ASize; COL_REGISTER_NAME: lvRegisters.Columns[1].Width := ASize;
COL_REGISTER_VALUE: lvRegisters.Column[1].Width := ASize; COL_REGISTER_VALUE: lvRegisters.Columns[2].Width := ASize;
end; end;
end; end;