我可以更改监视列表中字符串的显示格式吗?

时间:2015-10-14 09:20:55

标签: delphi debugging delphi-xe3

我不时地使用监视窗口来显示包含sql语句的字符串。

Debugger watch window

现在我从上下文菜单中选择复制值并获取

'SELECT NAME FROM SAMPLE_TABLE WHERE  FIRST_NAME = ''George'''#$D#$A

当然,如果我想在显示结果的sql工具中执行它,则必须重新格式化此语句。这有点烦人。

是否有技巧/解决方法?

2 个答案:

答案 0 :(得分:15)

我认为通过在IDE中添加一些东西来尝试找到一种方法来实现这一点会很有趣,主要是因为当你发布你的q时,我并不知道怎么做。事实证明,您可以使用包含如下单位的自定义OTA包轻松地完成此操作。

顺便说一下,我特别不得不向Rob Kennedy指出另一个SO问题,即IDE有一个Screen对象就像其他任何一个一样。这提供了一个简单的解决问题的方法,绕过了我通常不得不使用的OTA接口的迷宫来编写IDE插件。

它的工作原理是

  • 查找Watch Window

  • 在其上下文菜单中找到Copy Watch value项目&在其后添加新的菜单项

  • 使用新项目的OnClick处理程序从Watch Window的焦点项中获取值,根据需要重新格式化,然后将其粘贴到Clipboard

就使用OTA服务而言,它并没有做任何花哨的事情,但我认为KISS原则适用于IDE。

代码:

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: OP提到当Delphi首次启动时,下面代码的上一版本未能通过WatchWindow <> Nil断言。我想原因是在IDE中创建Watch Window之前调用了代码。我已经重新安排了代码,添加了一个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.

答案 1 :(得分:4)

我将此作为单独的答案发布,因为它使用了不同的实现 基于ToolsAPI的调试器可视化工具。展示台中有一些例子 Delphi源代码的子文件夹。看起来最有前途的那个 起始点是StringListVisualizer.Pas文件中的示例。但是,我找到了 在前几个读数中难以理解,事实证明它实际上并没有 做我希望的。

下面的代码,当然需要编译成一个IDE包 需要 rtl和指定单元,基于更简单的DateTime 示例可视化工具,但适用于Text个对象的TStrings属性。这种改编仍然需要做很多工作,这就是我发布这个额外答案的主要原因,为了让其他人有些头疼。

通常,Text变量的TStrings属性在监视窗口中显示为由单引号括起并由字符串#$ D#$ A分隔的一个或多个文本行。代码删除单引号并用空格替换#$ D#$ A.这是在代码顶部附近的GetReplacementValue函数内部。代码的其余部分只是实现可视化工具所需要包含的内容,即使在这种极简主义的实现中也存在相当多的代码。

安装软件包后,以及Watch Window中显示的软件包, 可以使用TextCopy 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.