Могу ли я изменить формат отображения строк в списке просмотра?
Время от времени я использую окно просмотра для отображения строк, содержащих операторы SQL.
Теперь я выбираю Copy Value из контекстного меню и получаю
'SELECT NAME FROM SAMPLE_TABLE WHERE FIRST_NAME = ''George'''#$D#$A
Конечно, этот оператор должен быть переформатирован, если я хочу выполнить его в инструменте SQL, отображающем результаты. Это немного раздражает.
Есть ли уловка / обходной путь для этого?
2 ответа
Я подумал, что было бы забавно попытаться найти способ сделать это, добавив что-то в IDE, главным образом потому, что когда вы опубликовали свой вопрос, у меня не было понятия, как это сделать. Оказывается, вы можете сделать это довольно легко, используя специальный OTA-пакет, содержащий модуль, подобный приведенному ниже.
Кстати, я особенно обязан Робу Кеннеди за то, что он указал в другом вопросе о том, что в IDE есть объект Screen, как и любой другой. Это позволяет легко решить проблему, минуя лабиринт интерфейсов OTA, с которыми мне обычно приходилось кодировать надстройку IDE.
Это работает
Нахождение
Watch Window
,Нахождение
Copy Watch value
пункт в его контекстном меню и добавление нового пункта меню после негоИспользуя обработчик OnClick нового элемента, выберите значение из выделенного элемента окна просмотра, переформатируйте его по мере необходимости, затем вставьте его в
Clipboard
,
Что касается использования OTA-сервисов, то это не делает ничего особенного, но я думаю, что с IDE применим принцип KISS.
Код:
unit IdeMenuProcessing;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ToolsAPI, Menus, ClipBrd, ComCtrls;
type
TOtaMenuForm = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
OurMenuItem : TMenuItem;
WatchWindow : TForm;
WWListView : TListView;
procedure GetWatchValue(Sender : TObject);
end;
var
OtaMenuForm: TOtaMenuForm;
procedure Register;
implementation
{$R *.dfm}
procedure ShowMenus;
begin
OtaMenuForm := TOtaMenuForm.Create(Nil);
OtaMenuForm.Show;
end;
procedure Register;
begin
ShowMenus;
end;
procedure TOtaMenuForm.FormCreate(Sender: TObject);
var
i : Integer;
S : String;
PM : TPopUpMenu;
Item : TMenuItem;
begin
// First create a menu item to insert in the Watch Window's context menu
OurMenuItem := TMenuItem.Create(Self);
OurMenuItem.OnClick := GetWatchValue;
OurMenuItem.Caption := 'Get processed watch value';
WatchWindow := Nil;
WWListView := Nil;
// Next, iterate the IDE's forms to find the Watch Window
for i := 0 to Screen.FormCount - 1 do begin
S := Screen.Forms[i].Name;
if CompareText(S, 'WatchWindow') = 0 then begin // < Localize if necessary
WatchWindow := Screen.Forms[i];
Break;
end;
end;
Assert(WatchWindow <> Nil);
if WatchWindow <> Nil then begin
// Next, scan the Watch Window's context menu to find the existing "Copy watch value" entry
// and insert our menu iem after it
PM := WatchWindow.PopUpMenu;
for i:= 0 to PM.Items.Count - 1 do begin
Item := PM.Items[i];
if CompareText('Copy Watch &Value', Item.Caption) = 0 then begin // < Localize if necessary
PM.Items.Insert(i + 1, OurMenuItem);
Break;
end;
end;
// Now, find the TListView in the Watch Window
for i := 0 to WatchWindow.ComponentCount - 1 do begin
if WatchWindow.Components[i] is TListView then begin
WWListView := WatchWindow.Components[i] as TListView;
Break;
end;
end;
Assert(WWListView <> Nil);
end;
end;
procedure TOtaMenuForm.GetWatchValue(Sender: TObject);
var
WatchValue : String;
begin
// This is called when the Watch Window menu item we added is clicked
if WWListView.ItemFocused = Nil then begin
Memo1.Lines.Add('no Watch selected');
exit;
end;
WatchValue := WWListView.ItemFocused.SubItems[0];
WatchValue := StringReplace(WatchValue, #$D#$A, ' ', [rfreplaceAll]);
if WatchValue[1] = '''' then
Delete(WatchValue, 1, 1);
if WatchValue[Length(WatchValue)] = '''' then
WatchValue := Copy(WatchValue, 1, Length(WatchValue) - 1);
// [etc]
ClipBoard.AsText := WatchValue;
Memo1.Lines.Add('>' + WatchValue + '<');
end;
initialization
finalization
if Assigned(OTAMenuForm) then begin
OTAMenuForm.Close;
FreeAndNil(OTAMenuForm);
end;
end.
Кстати, я написал это в D7, потому что я использую это как своего рода наименьший общий знаменатель для ответов SO, потому что совершенно очевидно, что большое количество людей здесь все еще используют его. Более поздние версии имеют дополнительные строковые функции, такие как AniDequotedStr, упомянутые в комментарии, которые могут быть полезны при переформатировании значения наблюдения.
Обновление: согласно OP, вышеупомянутое не работает с XE3, потому что окно просмотра реализовано с использованием TVirtualStringTree, а не TListView. Причина, по которой я использовал ListView, заключалась в том, что я обнаружил, что выбор значения Watch из буфера обмена (после имитации щелчка по контекстному меню Copy Watch Value
) обрабатывать его было не очень надежно. Кажется, что это улучшилось в XE4 (у меня нет XE3 для тестирования), поэтому вот версия, которая, кажется, работает в XE4:
Обновление № 2: ФП упомянул, что предыдущая версия кода ниже не смогла WatchWindow <> Nil
утверждение при первом запуске Delphi. Я думаю, причина в том, что код вызывается до Watch Window
был создан в IDE. Я перестроил код и добавил OTANotifier, который используется для получения уведомления о том, что рабочий стол проекта загружен, реклама использует его для вызова нового SetUp
рутина.
unit IdeMenuProcessing;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ToolsAPI, Menus, ClipBrd, ComCtrls;
type
TIdeNotifier = class(TNotifierObject, IOTANotifier, IOTAIDENotifier)
protected
procedure AfterCompile(Succeeded: Boolean);
procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
procedure FileNotification(NotifyCode: TOTAFileNotification;
const FileName: string; var Cancel: Boolean);
end;
TOtaMenuForm = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
IsSetUp : Boolean;
ExistingMenuItem,
OurMenuItem : TMenuItem;
WatchWindow : TForm;
Services: IOTAServices;
Notifier : TIdeNotifier;
NotifierIndex: Integer;
procedure GetWatchValue(Sender : TObject);
procedure SetUp;
end;
var
OtaMenuForm: TOtaMenuForm;
procedure Register;
implementation
{$R *.dfm}
procedure ShowMenus;
begin
OtaMenuForm := TOtaMenuForm.Create(Nil);
OtaMenuForm.Services := BorlandIDEServices as IOTAServices;
OtaMenuForm.NotifierIndex := OtaMenuForm.Services.AddNotifier(TIdeNotifier.Create);
OtaMenuForm.Show;
end;
procedure Register;
begin
ShowMenus;
end;
procedure TOtaMenuForm.SetUp;
var
i : Integer;
S : String;
PM : TPopUpMenu;
Item : TMenuItem;
begin
if IsSetUp then exit;
// First create a menu item to insert in the Watch Window's context menu
OurMenuItem := TMenuItem.Create(Self);
OurMenuItem.OnClick := GetWatchValue;
OurMenuItem.Caption := 'Get processed watch value';
WatchWindow := Nil;
// Next, iterate the IDE's forms to find the Watch Window
for i := 0 to Screen.FormCount - 1 do begin
S := Screen.Forms[i].Name;
if CompareText(S, 'WatchWindow') = 0 then begin
WatchWindow := Screen.Forms[i];
Break;
end;
end;
Assert(WatchWindow <> Nil);
if WatchWindow <> Nil then begin
// Next, scan the Watch Window's context menu to find the existing "Copy watch value" entry
// and insert our menu item after it
PM := WatchWindow.PopUpMenu;
for i:= 0 to PM.Items.Count - 1 do begin
Item := PM.Items[i];
if CompareText('Copy Watch &Value', Item.Caption) = 0 then begin
ExistingMenuItem := Item;
PM.Items.Insert(i + 1, OurMenuItem);
if ExistingMenuItem.Action <> Nil then
Memo1.Lines.Add('Has action')
else
Memo1.Lines.Add('No action');
Break;
end;
end;
end;
Caption := 'Setup complete';
IsSetUp := True;
end;
procedure TOtaMenuForm.FormCreate(Sender: TObject);
begin
IsSetUp := False;
end;
procedure TOtaMenuForm.GetWatchValue(Sender: TObject);
var
S,
WatchValue : String;
TL : TStringList;
i : Integer;
begin
// This is called when the Watch Window menu item we added is clicked
ExistingMenuItem.Click;
WatchValue := ClipBoard.AsText;
WatchValue := StringReplace(WatchValue, '#$D#$A', #$D#$A, [rfreplaceAll]);
if WatchValue <> '' then begin
TL := TStringList.Create;
try
TL.Text := WatchValue;
WatchValue := '';
for i := 0 to TL.Count - 1 do begin
S := TL[i];
if S[1] = '''' then
Delete(S, 1, 1);
if S[Length(S)] = '''' then
S := Copy(S, 1, Length(S) - 1);
if WatchValue <> '' then
WatchValue := WatchValue + ' ';
WatchValue := WatchValue + S;
end;
finally
TL.Free;
end;
// [etc]
end;
ClipBoard.AsText := WatchValue;
Memo1.Lines.Add('>' + WatchValue + '<');
end;
{ TIdeNotifier }
procedure TIdeNotifier.AfterCompile(Succeeded: Boolean);
begin
end;
procedure TIdeNotifier.BeforeCompile(const Project: IOTAProject;
var Cancel: Boolean);
begin
end;
procedure TIdeNotifier.FileNotification(NotifyCode: TOTAFileNotification;
const FileName: string; var Cancel: Boolean);
begin
if NotifyCode = ofnProjectDesktopLoad then
OTAMenuForm.SetUp
end;
initialization
finalization
if Assigned(OTAMenuForm) then begin
OTAMenuForm.Services.RemoveNotifier(OTAMenuForm.NotifierIndex);
OTAMenuForm.Close;
FreeAndNil(OTAMenuForm);
end;
end.
Я публикую это как отдельный ответ, потому что он использует другую реализацию, основанную на визуализаторах отладчика ToolsAPI. В подпапке Visualizer исходного кода Delphi есть примеры. Примером, который выглядел наиболее многообещающим в качестве отправной точки, является пример файла StringListVisualizer.Pas. Тем не менее, я обнаружил, что это непроницаемо в первых нескольких чтениях, и оказалось, что на самом деле это не то, на что я надеялся.
Приведенный ниже код, который, конечно, должен быть скомпилирован в пакет IDE,требующий модулей rtl и designide, основан на гораздо более простом образце визуализатора DateTime, но адаптирован к Text
собственностью TStrings
объекты. Эта адаптация все еще требовала много работы, и это главная причина, по которой я публикую этот дополнительный ответ, чтобы избавить других от каких-то головокружительных царапин.
Обычно Text
свойство TStrings
переменная отображается в окне просмотра в виде одной или нескольких текстовых строк, заключенных в одинарные кавычки и разделенных строкой #$D#$A. Код удаляет одинарные кавычки и заменяет # $ D # $ A пробелом. Это сделано внутри GetReplacementValue
функция в верхней части кода. Остальная часть кода - это просто багаж, который нужно включить для реализации визуализатора, и его довольно много, даже в этой довольно минималистской реализации.
После установки пакета, а также отображается в Watch Window
, Text
свойство может быть вставлено в буфер обмена с помощью Copy Watch Value
запись на Watch Window
контекстное меню.
Код (написанный и протестированный в XE4):
{*******************************************************}
{ }
{ RadStudio Debugger Visualizer Sample }
{ Copyright(c) 2009-2013 Embarcadero Technologies, Inc. }
{ }
{*******************************************************}
{Adapted by Martyn Ayers, Bristol, UK Oct 2015}
unit SimpleTStringsVisualizeru;
interface
procedure Register;
implementation
uses
Classes, Forms, SysUtils, ToolsAPI;
resourcestring
sVisualizerName = 'TStrings Simple Visualizer for Delphi';
sVisualizerDescription = 'Simplifies TStrings Text property format';
const
CRLFReplacement = ' ';
type
TDebuggerSimpleTStringsVisualizer = class(TInterfacedObject,
IOTADebuggerVisualizer, IOTADebuggerVisualizerValueReplacer,
IOTAThreadNotifier, IOTAThreadNotifier160)
private
FNotifierIndex: Integer;
FCompleted: Boolean;
FDeferredResult: string;
public
{ IOTADebuggerVisualizer }
function GetSupportedTypeCount: Integer;
procedure GetSupportedType(Index: Integer; var TypeName: string;
var AllDescendants: Boolean);
function GetVisualizerIdentifier: string;
function GetVisualizerName: string;
function GetVisualizerDescription: string;
{ IOTADebuggerVisualizerValueReplacer }
function GetReplacementValue(const Expression, TypeName, EvalResult: string): string;
{ IOTAThreadNotifier }
procedure EvaluteComplete(const ExprStr: string; const ResultStr: string;
CanModify: Boolean; ResultAddress: Cardinal; ResultSize: Cardinal;
ReturnCode: Integer);
procedure ModifyComplete(const ExprStr: string; const ResultStr: string;
ReturnCode: Integer);
procedure ThreadNotify(Reason: TOTANotifyReason);
procedure AfterSave;
procedure BeforeSave;
procedure Destroyed;
procedure Modified;
{ IOTAThreadNotifier160 }
procedure EvaluateComplete(const ExprStr: string; const ResultStr: string;
CanModify: Boolean; ResultAddress: TOTAAddress; ResultSize: LongWord;
ReturnCode: Integer);
end;
TTypeLang = (tlDelphi, tlCpp);
// The following function is the one which actually changes the TStrings
// representation in the Watch Window
//
// Normally, the Text property of TStrings variable is displayed in the Watch Window
// and Evaluate window as one or more text lines surrounded by single quotes
// and separated by the string #$D#$A
//
// This implementation removes the single quotes and replaces the #$D#$A
// by a space
//
// Note the addition of '.Text' to the expression which gets evaluated; this is to
// produce the desired result when using the 'Copy Watch Value' item in the
// Watch Window context menu.
function TDebuggerSimpleTStringsVisualizer.GetReplacementValue(
const Expression, TypeName, EvalResult: string): string;
var
Lang: TTypeLang;
i: Integer;
CurProcess: IOTAProcess;
CurThread: IOTAThread;
ResultStr: array[0..4095] of Char; // was 255
CanModify: Boolean;
ResultAddr, ResultSize, ResultVal: LongWord;
EvalRes: TOTAEvaluateResult;
DebugSvcs: IOTADebuggerServices;
function FormatResult(const Input: string; out ResStr: string): Boolean;
var
TL : TStringList;
i : Integer;
S : String;
const
CRLFDisplayed = '#$D#$A';
begin
Result := True;
ResStr := '';
TL := TStringList.Create;
try
S := Input;
S := StringReplace(S, CRLFDisplayed, #13#10, [rfReplaceAll]);
TL.Text := S;
for i := 0 to TL.Count - 1 do begin
S := TL[i];
if S <> '' then begin
if S[1] = '''' then // Remove single quote at start of line
Delete(S, 1, 1);
if S[Length(S)] = '''' then // Remove single quote at end of line
S := Copy(S, 1, Length(S) - 1);
end;
if ResStr <> '' then
ResStr := ResStr + CRLFReplacement;
ResStr := ResStr + S;
end;
finally
TL.Free;
end;
end;
begin
Lang := tlDelphi;
if Lang = tlDelphi then
begin
if Supports(BorlandIDEServices, IOTADebuggerServices, DebugSvcs) then
CurProcess := DebugSvcs.CurrentProcess;
if CurProcess <> nil then
begin
CurThread := CurProcess.CurrentThread;
if CurThread <> nil then
begin
EvalRes := CurThread.Evaluate(Expression + '.Text', @ResultStr, Length(ResultStr),
CanModify, eseAll, '', ResultAddr, ResultSize, ResultVal, '', 0);
if EvalRes = erOK then
begin
Result := ResultStr;
end else if EvalRes = erDeferred then
begin
FCompleted := False;
FDeferredResult := '';
FNotifierIndex := CurThread.AddNotifier(Self);
while not FCompleted do
DebugSvcs.ProcessDebugEvents;
CurThread.RemoveNotifier(FNotifierIndex);
FNotifierIndex := -1;
if (FDeferredResult = '') then
Result := EvalResult
else
FormatResult(FDeferredResult, Result);
end;
end;
end;
end
else
;
end;
procedure TDebuggerSimpleTStringsVisualizer.AfterSave;
begin
// don't care about this notification
end;
procedure TDebuggerSimpleTStringsVisualizer.BeforeSave;
begin
// don't care about this notification
end;
procedure TDebuggerSimpleTStringsVisualizer.Destroyed;
begin
// don't care about this notification
end;
procedure TDebuggerSimpleTStringsVisualizer.Modified;
begin
// don't care about this notification
end;
procedure TDebuggerSimpleTStringsVisualizer.ModifyComplete(const ExprStr,
ResultStr: string; ReturnCode: Integer);
begin
// don't care about this notification
end;
procedure TDebuggerSimpleTStringsVisualizer.EvaluteComplete(const ExprStr,
ResultStr: string; CanModify: Boolean; ResultAddress, ResultSize: Cardinal;
ReturnCode: Integer);
begin
EvaluateComplete(ExprStr, ResultStr, CanModify, TOTAAddress(ResultAddress),
LongWord(ResultSize), ReturnCode);
end;
procedure TDebuggerSimpleTStringsVisualizer.EvaluateComplete(const ExprStr,
ResultStr: string; CanModify: Boolean; ResultAddress: TOTAAddress; ResultSize: LongWord;
ReturnCode: Integer);
begin
FCompleted := True;
if ReturnCode = 0 then
FDeferredResult := ResultStr;
end;
function TDebuggerSimpleTStringsVisualizer.GetSupportedTypeCount: Integer;
begin
Result := 1;
end;
procedure TDebuggerSimpleTStringsVisualizer.GetSupportedType(Index: Integer; var TypeName: string;
var AllDescendants: Boolean);
begin
AllDescendants := True;
TypeName := 'TStrings';
end;
function TDebuggerSimpleTStringsVisualizer.GetVisualizerDescription: string;
begin
Result := sVisualizerDescription;
end;
function TDebuggerSimpleTStringsVisualizer.GetVisualizerIdentifier: string;
begin
Result := ClassName;
end;
function TDebuggerSimpleTStringsVisualizer.GetVisualizerName: string;
begin
Result := sVisualizerName;
end;
procedure TDebuggerSimpleTStringsVisualizer.ThreadNotify(Reason: TOTANotifyReason);
begin
// don't care about this notification
end;
var
TStringsVis: IOTADebuggerVisualizer;
procedure Register;
begin
TStringsVis := TDebuggerSimpleTStringsVisualizer.Create;
(BorlandIDEServices as IOTADebuggerServices).RegisterDebugVisualizer(TStringsVis);
end;
procedure RemoveVisualizer;
var
DebuggerServices: IOTADebuggerServices;
begin
if Supports(BorlandIDEServices, IOTADebuggerServices, DebuggerServices) then
begin
DebuggerServices.UnregisterDebugVisualizer(TStringsVis);
TStringsVis := nil;
end;
end;
initialization
finalization
RemoveVisualizer;
end.