diff --git a/debugger/registersdlg.lfm b/debugger/registersdlg.lfm index 546a858f4a..659f54d5bb 100644 --- a/debugger/registersdlg.lfm +++ b/debugger/registersdlg.lfm @@ -1,4 +1,4 @@ -inherited RegistersDlg: TRegistersDlg +object RegistersDlg: TRegistersDlg Left = 342 Height = 253 Top = 117 @@ -9,29 +9,6 @@ inherited RegistersDlg: TRegistersDlg ClientHeight = 253 ClientWidth = 346 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 Left = 0 Height = 26 @@ -52,13 +29,13 @@ inherited RegistersDlg: TRegistersDlg end object ToolButton1: TToolButton Left = 24 + Height = 22 Top = 2 - Width = 10 Caption = 'ToolButton1' Style = tbsSeparator end object ToolButtonDispType: TToolButton - Left = 34 + Left = 32 Top = 2 Caption = '...' DropdownMenu = PopupDispType @@ -68,26 +45,51 @@ inherited RegistersDlg: TRegistersDlg Style = tbsDropDown 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 Height = 8 Width = 8 - Left = 112 - Top = 93 + left = 96 + top = 104 Bitmap = { - 4C69010000000800000008000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000005CDD8AFF33D56FFF65DE - 8FFF000000000000000000000000000000004FD374FF15C649FF17C64BFF14C6 - 49FF4FCD72FF00000000000000000000000019B73CFF0CB330FF0CB331FF0CB3 - 30FF15B038FF0000000000000000000000004EBC5DFF03A01AFF04A11CFF03A0 - 19FF50B95FFF000000000000000000000000000000004BB257FF169D27FF56B5 - 5FFF000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000 + 4C7A010000000800000008000000630000000000000078DA6360200EC4DCEDFA + 6F7C35FF7FEABDFEFFE872FE974BFE8B1EF3FC2F7ECCFBBF0890F63F5B84A246 + 72BBCD7F9ECD06406C08A6453758A0C8FBED89FDCFBC40EA3FCB4219202DF93F + 60673C861DDE9BC2FF8BCD55FF1FB615538E120000CF852E03 } end object ActionList1: TActionList - Left = 200 - Top = 112 + left = 200 + top = 112 object actPower: TAction Enabled = False OnExecute = actPowerExecute @@ -118,8 +120,8 @@ inherited RegistersDlg: TRegistersDlg end end object PopupDispType: TPopupMenu - Left = 200 - Top = 176 + left = 200 + top = 176 object DispDefault: TMenuItem Caption = 'New Item1' OnClick = DispDefaultClick @@ -146,8 +148,8 @@ inherited RegistersDlg: TRegistersDlg end end object PopupMenu1: TPopupMenu - Left = 95 - Top = 178 + left = 95 + top = 178 object popFormat: TMenuItem Caption = 'New Item1' object PopDispDefault: TMenuItem diff --git a/debugger/registersdlg.pp b/debugger/registersdlg.pp index f6aaba5204..2f873ffc23 100644 --- a/debugger/registersdlg.pp +++ b/debugger/registersdlg.pp @@ -38,11 +38,20 @@ interface uses SysUtils, Classes, Controls, Forms, Clipbrd, BaseDebugManager, IDEWindowIntf, DebuggerStrConst, - ComCtrls, ActnList, Menus, Debugger, DebuggerDlg, - LazarusIDEStrConsts, IDEImagesIntf, DbgIntfDebuggerBase; + ComCtrls, ActnList, Menus, Grids, Debugger, DebuggerDlg, + LazarusIDEStrConsts, IDEImagesIntf, DbgIntfDebuggerBase, Types; 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 = class(TDebuggerDlg) @@ -53,7 +62,7 @@ type actPower: TAction; ActionList1: TActionList; ImageList1: TImageList; - lvRegisters: TListView; + lvRegisters: TStringGridAllowRightMouse; DispDefault: TMenuItem; DispHex: TMenuItem; DispBin: TMenuItem; @@ -84,7 +93,9 @@ type procedure actCopyValueExecute(Sender: TObject); procedure actPowerExecute(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); function GetCurrentRegisters: TRegisters; private @@ -118,7 +129,7 @@ var const COL_REGISTER_NAME = 1; 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; begin @@ -133,6 +144,29 @@ begin TRegistersDlg(AForm).ColSizeSetter(AColId, ASize); 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 } constructor TRegistersDlg.Create(AOwner: TComponent); @@ -145,8 +179,9 @@ begin RegistersNotification.OnChange := @RegistersChanged; Caption:= lisRegisters; - lvRegisters.Columns[0].Caption:= lisName; - lvRegisters.Columns[1].Caption:= lisValue; + lvRegisters.Columns[1].Title.Caption:= lisName; + lvRegisters.Columns[2].Title.Caption:= lisValue; + lvRegisters.RangeSelectMode := rsmMulti; ActionList1.Images := IDEImages.Images_16; ToolBar1.Images := IDEImages.Images_16; @@ -193,7 +228,7 @@ begin popFormat.Caption := regdlgFormat; 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; destructor TRegistersDlg.Destroy; @@ -216,48 +251,72 @@ begin end; procedure TRegistersDlg.actCopyNameExecute(Sender: TObject); +var + s: String; + i: Integer; 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.AsText := lvRegisters.Selected.Caption; + Clipboard.AsText := s; Clipboard.Close; end; procedure TRegistersDlg.actCopyValueExecute(Sender: TObject); +var + s: String; + i: Integer; 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.AsText := lvRegisters.Selected.SubItems[0]; + Clipboard.AsText := s; Clipboard.Close; end; procedure TRegistersDlg.actCopyNameValueExecute(Sender: TObject); +var + s: String; + i: Integer; 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.AsText := Concat(lvRegisters.Selected.Caption, '=', - lvRegisters.Selected.SubItems[0]); + Clipboard.AsText := s; Clipboard.Close; end; procedure TRegistersDlg.actCopyAllExecute(Sender: TObject); var - T: string; - I: Integer; - LI: TListItem; + s: String; + i: Integer; begin + s := ''; + for i := 1 to lvRegisters.RowCount - 1 do + s := Concat(s, lvRegisters.Cells[1, i], '=', lvRegisters.Cells[2,i], sLineBreak); Clipboard.Open; - T := ''; - 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.AsText := s; Clipboard.Close; end; procedure TRegistersDlg.DispDefaultClick(Sender: TObject); var n: Integer; - Item: TListItem; Reg: TRegisters; RegVal: TRegisterValue; begin @@ -265,20 +324,28 @@ begin Reg := GetCurrentRegisters; if Reg = nil then exit; - for n := 0 to lvRegisters.Items.Count -1 do - begin - Item := lvRegisters.Items[n]; - if Item.Selected then begin - RegVal := Reg.EntriesByName[Item.Caption]; + for n := 1 to lvRegisters.RowCount - 1 do + if lvRegisters.IsCellSelected[0,n] then begin + RegVal := Reg.EntriesByName[lvRegisters.Cells[1,n]]; if RegVal <> nil then RegVal.DisplayFormat := TRegisterDisplayFormat(TMenuItem(Sender).Tag); end; - end; - lvRegistersSelectItem(nil, nil, True); + lvRegistersSelection(nil, -1, -1); end; -procedure TRegistersDlg.lvRegistersSelectItem(Sender: TObject; Item: TListItem; - Selected: Boolean); +procedure TRegistersDlg.lvRegistersDrawCell(Sender: TObject; aCol, + 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 n, j: Integer; SelFormat: TRegisterDisplayFormat; @@ -292,11 +359,9 @@ begin Reg := GetCurrentRegisters; if Reg = nil then exit; - for n := 0 to lvRegisters.Items.Count -1 do - begin - Item := lvRegisters.Items[n]; - if Item.Selected then begin - RegVal := Reg.EntriesByName[Item.Caption]; + for n := 1 to lvRegisters.RowCount - 1 do + if lvRegisters.IsCellSelected[0,n] then begin + RegVal := Reg.EntriesByName[lvRegisters.Cells[1,n]]; if RegVal <> nil then begin if j = 0 then SelFormat := RegVal.DisplayFormat; @@ -307,13 +372,12 @@ begin end; end; end; - end; ToolButtonDispType.Enabled := j > 0; popFormat.Enabled := j > 0; actCopyName.Enabled := j > 0; actCopyValue.Enabled := j > 0; actCopyNameValue.Enabled := j > 0; - actCopyAll.Enabled := lvRegisters.Items.Count > 0; + actCopyAll.Enabled := lvRegisters.RowCount > 1; PopDispDefault.Checked := False; PopDispHex.Checked := False; @@ -381,9 +445,8 @@ end; procedure TRegistersDlg.RegistersChanged(Sender: TObject); var - n, idx, Cnt: Integer; + n, i, idx, Cnt: Integer; List: TStringList; - Item: TListItem; S: String; Reg: TRegisters; begin @@ -400,25 +463,22 @@ begin Reg := GetCurrentRegisters; if (Reg = nil) or (reg.DataValidity<> ddsValid) then begin if (DebugBoss = nil) or not (DebugBoss.State in [dsPause, dsInternalPause, dsRun]) then - lvRegisters.Items.Clear; + lvRegisters.RowCount := 1; if (reg <> nil) then reg.Count; - for n := 0 to lvRegisters.Items.Count - 1 do - if lvRegisters.Items[n].SubItems[0] <> '' then - lvRegisters.Items[n].SubItems[0] := ''; + for n := 1 to lvRegisters.RowCount - 1 do + lvRegisters.Cells[2, n] := ''; exit; end; List := TStringList.Create; try //Get existing items - for n := 0 to lvRegisters.Items.Count - 1 do + for n := 1 to lvRegisters.RowCount - 1 do begin - Item := lvRegisters.Items[n]; - S := Item.Caption; - S := UpperCase(S); - List.AddObject(S, Item); + S := UpperCase(lvRegisters.Cells[1,n]); + List.AddObject(S, TObject(ptruint(n))); end; // add/update entries @@ -431,24 +491,27 @@ begin if idx = -1 then begin // New entry - Item := lvRegisters.Items.Add; - Item.Caption := Reg[n].Name; - Item.SubItems.Add(Reg[n].Value); + i := lvRegisters.RowCount; + lvRegisters.RowCount := i + 1; + lvRegisters.Cells[1, i] := Reg[n].Name; + lvRegisters.Cells[2, i] := Reg[n].Value; end else begin // Existing entry - Item := TListItem(List.Objects[idx]); - Item.SubItems[0] := Reg[n].Value; + i := PtrUInt(List.Objects[idx]); List.Delete(idx); + lvRegisters.Cells[1, i] := Reg[n].Name; + lvRegisters.Cells[2, i] := Reg[n].Value; end; if Reg[n].Modified - then Item.ImageIndex := 0 - else Item.ImageIndex := -1; + then lvRegisters.Objects[0, i] := TObject(ptruint(1)) //Item.ImageIndex := 0 + else lvRegisters.Objects[0, i] := nil; //Item.ImageIndex := -1; end; // remove obsolete entries - for n := 0 to List.Count - 1 do - lvRegisters.Items.Delete(TListItem(List.Objects[n]).Index); + for n := List.Count - 1 downto 0 do + lvRegisters.DeleteRow(PtrUInt(List.Objects[n])); + lvRegisters.Invalidate; finally List.Free; @@ -457,7 +520,7 @@ begin EndUpdate; end; - lvRegistersSelectItem(nil, nil, True); + lvRegistersSelection(nil, -1, -1); end; procedure TRegistersDlg.DoRegistersChanged; @@ -482,9 +545,9 @@ end; function TRegistersDlg.ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean; begin - if (AColId - 1 >= 0) and (AColId - 1 < lvRegisters.ColumnCount) then begin - ASize := lvRegisters.Column[AColId - 1].Width; - Result := ASize <> COL_WIDTHS[AColId - 1]; + if (AColId >= 0) and (AColId < lvRegisters.Columns.Count) then begin + ASize := lvRegisters.Columns[AColId].Width; + Result := ASize <> COL_WIDTHS[AColId]; end else Result := False; @@ -493,8 +556,8 @@ end; procedure TRegistersDlg.ColSizeSetter(AColId: Integer; ASize: Integer); begin case AColId of - COL_REGISTER_NAME: lvRegisters.Column[0].Width := ASize; - COL_REGISTER_VALUE: lvRegisters.Column[1].Width := ASize; + COL_REGISTER_NAME: lvRegisters.Columns[1].Width := ASize; + COL_REGISTER_VALUE: lvRegisters.Columns[2].Width := ASize; end; end;