gdb com, add context menu to copy the lists content

This commit is contained in:
Basile Burg 2017-02-05 11:42:55 +01:00
parent c1c4df282c
commit c71b291558
No known key found for this signature in database
GPG Key ID: 1868039F415CB8CF
2 changed files with 222 additions and 6 deletions

View File

@ -5,7 +5,8 @@ unit ce_controls;
interface interface
uses uses
Classes, SysUtils, Forms, Controls, ComCtrls, ExtCtrls, buttons, Graphics; Classes, SysUtils, Forms, Controls, ComCtrls, ExtCtrls, buttons, Graphics,
Menus, Clipbrd;
type type
TCEPageControlButton = (pbClose, pbMoveLeft, pbMoveRight, pbAdd, pbSplit); TCEPageControlButton = (pbClose, pbMoveLeft, pbMoveRight, pbAdd, pbSplit);
@ -129,6 +130,26 @@ type
property OnDragDrop read fOnDragDrop write setOnDragDrop; property OnDragDrop read fOnDragDrop write setOnDragDrop;
end; end;
(**
* A context menu dedicated to TlistView with read-only content.
* Contains items allowing to copy a column, a line, a cell, etc.
*)
TCEListViewCopyMenu = class(TPopupMenu)
private
fList: TListView;
function getColumnIndex: integer;
function getLine(item: TListItem): string;
function getLineAsList(item: TListItem): string;
procedure copyCell(sender: TObject);
procedure copyLine(sender: TObject);
procedure copyLineAsList(sender: TObject);
procedure copyColumn(sender: TObject);
procedure copyAll(sender: TObject);
procedure copyAllAsList(sender: TObject);
public
constructor create(aOwner: TComponent); override;
end;
implementation implementation
function TCEPage.getIndex: integer; function TCEPage.getIndex: integer;
@ -602,5 +623,195 @@ begin
fMoveRightBtn.Enabled := fPageIndex < fPages.Count-1; fMoveRightBtn.Enabled := fPageIndex < fPages.Count-1;
end; end;
constructor TCEListViewCopyMenu.create(aOwner: TComponent);
var
itm: TMenuItem;
begin
inherited create(aOwner);
if not (aOwner is TListView) then
begin
{$IFDEF DEBUG}
raise Exception.Create(self.ClassName + ' owner must be a TListView');
{$ENDIF}
exit;
end;
fList := TListView(aOwner);
fList.PopupMenu := self;
itm := TMenuItem.Create(self);
itm.Caption := 'copy cell';
itm.OnClick := @copyCell;
items.Add(itm);
itm := TMenuItem.Create(self);
itm.Caption := 'copy line';
itm.OnClick := @copyLine;
items.Add(itm);
itm := TMenuItem.Create(self);
itm.Caption := 'copy line as list';
itm.OnClick := @copyLineAsList;
items.Add(itm);
itm := TMenuItem.Create(self);
itm.Caption := 'copy column';
itm.OnClick := @copyColumn;
items.Add(itm);
itm := TMenuItem.Create(self);
itm.Caption := 'copy all';
itm.OnClick := @copyAll;
items.Add(itm);
itm := TMenuItem.Create(self);
itm.Caption := 'copy all as list';
itm.OnClick := @copyAllAsList;
items.Add(itm);
end;
function TCEListViewCopyMenu.getColumnIndex: integer;
var
i: integer;
w: integer = 0;
o: integer = 0;
p: TPoint;
begin
result:= 0;
p := fList.ScreenToControl(PopupPoint);
for i := 0 to fList.ColumnCount - 1 do
begin
o := w;
w += fList.Column[i].Width;
if (o < p.x) and (p.x < w) then
exit(i);
end;
end;
function TCEListViewCopyMenu.getLine(item: TListItem): string;
var
c: integer;
i: integer;
begin
result := '';
if not assigned(item) then
exit;
result := item.Caption;
c := item.SubItems.count-1;
for i := 0 to c do
begin
if i <> c + 1 then
result += ' | ';
result += item.SubItems[i];
end;
end;
function TCEListViewCopyMenu.getLineAsList(item: TListItem): string;
var
i: integer;
begin
result := '';
if not assigned(item) then
exit;
result := item.Caption;
for i := 0 to item.SubItems.count-1 do
result += LineEnding + item.SubItems[i];
end;
procedure TCEListViewCopyMenu.copyCell(sender: TObject);
var
s: string = '';
c: integer;
begin
if not assigned(fList) or not assigned(fList.Selected) then
exit;
c := getColumnIndex;
if c = 0 then
s := fList.Selected.Caption
else
s := fList.Selected.SubItems[c-1];
clipboard.AsText := s;
end;
procedure TCEListViewCopyMenu.copyLine(sender: TObject);
begin
if not assigned(fList) or not assigned(fList.Selected) then
exit;
Clipboard.AsText := getLine(fList.Selected);
end;
procedure TCEListViewCopyMenu.copyLineAsList(sender: TObject);
begin
if not assigned(fList) or not assigned(fList.Selected) then
exit;
Clipboard.AsText := getLineAsList(fList.Selected);
end;
procedure TCEListViewCopyMenu.copyColumn(sender: TObject);
var
s: string = '';
c: integer;
i: integer;
begin
if not assigned(fList) or not assigned(fList.Selected) then
exit;
c := getColumnIndex;
if c = 0 then
begin
for i := 0 to fList.Items.Count - 1 do
s += fList.Items[i].Caption + LineEnding;
end
else
begin
for i := 0 to fList.Items.Count - 1 do
s += fList.Items[i].SubItems[c-1] + LineEnding;
end;
clipboard.AsText := s;
end;
procedure TCEListViewCopyMenu.copyAll(sender: TObject);
var
s: string = '';
c: integer;
i: integer;
begin
c := fList.Items.Count - 1;
for i := 0 to c do
begin
s += getLine(fList.Items[i]);
if i <> c then
s += LineEnding;
end;
clipboard.AsText := s;
end;
procedure TCEListViewCopyMenu.copyAllAsList(sender: TObject);
var
s: string = '';
c: integer;
i: integer;
begin
c := fList.Items.Count - 1;
for i := 0 to c do
begin
s += getLineAsList(fList.Items[i]);
if i <> c then
s += LineEnding + LineEnding;
end;
clipboard.AsText := s;
end;
end. end.

View File

@ -8,9 +8,10 @@ uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, RegExpr, ComCtrls, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, RegExpr, ComCtrls,
PropEdits, GraphPropEdits, RTTIGrids, Dialogs, ExtCtrls, Menus, Buttons, PropEdits, GraphPropEdits, RTTIGrids, Dialogs, ExtCtrls, Menus, Buttons,
StdCtrls, process, fpjson, typinfo, Unix, ListViewFilterEdit, SynEdit, StdCtrls, process, fpjson, typinfo, Unix, ListViewFilterEdit, SynEdit,
ObjectInspector,
ce_common, ce_interfaces, ce_widget, ce_processes, ce_observer, ce_synmemo, ce_common, ce_interfaces, ce_widget, ce_processes, ce_observer, ce_synmemo,
ce_sharedres, ce_stringrange, ce_dsgncontrols, ce_dialogs, ce_dbgitf, ce_sharedres, ce_stringrange, ce_dsgncontrols, ce_dialogs, ce_dbgitf,
ce_ddemangle, ce_writableComponent, EditBtn, strutils, ObjectInspector; ce_ddemangle, ce_writableComponent, EditBtn, strutils, ce_controls;
type type
@ -1110,6 +1111,8 @@ end;
{$REGION Common/standard comp --------------------------------------------------} {$REGION Common/standard comp --------------------------------------------------}
constructor TCEGdbWidget.create(aOwner: TComponent); constructor TCEGdbWidget.create(aOwner: TComponent);
var
m: TCEListViewCopyMenu;
begin begin
inherited; inherited;
EntitiesConnector.addObserver(self); EntitiesConnector.addObserver(self);
@ -1128,7 +1131,12 @@ begin
Edit1.Items.Assign(fOptions.commandsHistory); Edit1.Items.Assign(fOptions.commandsHistory);
fAddWatchPointKind := wpkWrite; fAddWatchPointKind := wpkWrite;
fBreakPoints := TPersistentBreakPoints.create(self); fBreakPoints := TPersistentBreakPoints.create(self);
//
TCEListViewCopyMenu.create(lstCallStack);
TCEListViewCopyMenu.create(lstAsm);
TCEListViewCopyMenu.create(lstVariables);
TCEListViewCopyMenu.create(lstThreads);
updateMenu; updateMenu;
AssignPng(btnSendCom, 'ACCEPT'); AssignPng(btnSendCom, 'ACCEPT');
updateButtonsState; updateButtonsState;
@ -2661,9 +2669,6 @@ begin
edit1.Text := ''; edit1.Text := '';
end; end;
//TODO-cGDB: copy from the lists: value, instructions, etc.
procedure TCEGdbWidget.setGpr(reg: TCpuRegister; val: TCpuGprValue); procedure TCEGdbWidget.setGpr(reg: TCpuRegister; val: TCpuGprValue);
const const
spec = 'set $%s = 0x%X'; spec = 'set $%s = 0x%X';