Can I change the display format for strings in the

问题:

Every now and then I use the watch window to display strings which contain sql statements.

Now I select Copy Value from the context menu and get

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

Of course, this statement has to be reformatted if I want to execute it in a sql tool displaying the results. This is a little bit annoying.

Is there a trick / workaround for that?

回答1:

I thought it would be amusing to try and work out a way to do this by adding something inside the IDE, mainly because when you posted your q, I didn't have a clue how to. It turns out that you can do it quite easily using a custom OTA package containing a unit like the one below.

Btw, I'm particularly obliged to Rob Kennedy for pointing out in another SO question that the IDE has a Screen object just like any other. That provides an easy way into the problem, bypassing the maze of OTA interfaces I've usually had to work with to code an IDE add-in.

It works by

• Finding the Watch Window,

• Finding the Copy Watch value item in its context menu & adding a new menu item after it

• Using the OnClick handler of the new item to pick up the value from the Watch Window's focused item, re-formatting it as required, then pasting it to the Clipboard.

So far as using OTA services is concerned, it doesn't do anything fancy, but with the IDE I think the KISS principle applies.

Code:

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.

Btw, I wrote this in D7 because I use that as a sort of lowest common denominator for SO answers because its quite obvious that a large number of people here still use it. Later versions have additional string functions, such as the AniDequotedStr mentioned in a comment, which might be helpful in reformatting the watch value.

Update: According to the OP, the above doesn't work with XE3 because the watch window is implemented using a TVirtualStringTree rather than a TListView. The reason I used the ListView was that I found that picking up the Watch value from the Clipboard (after simulating a click on the context menu's Copy Watch Value) to process it wasn't very reliable. That seems to have improved in XE4 (I don't have XE3 to test), so here's a version that seems to work in XE4:

Update #2: The OP mentioned that the previous version of the code below failed the WatchWindow <> Nil assertion when Delphi is first started. I imagine the reason is that the code is called before the Watch Window has been created in the IDE. I've re-arranged the code an added an OTANotifier that's used to get the notification that a project desktop has been loaded, ad uses that to called the new SetUp routine.

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.

回答2:

I'm posting this as a separate answer because it uses a different implementation based on the ToolsAPI's debugger visualizers. There are examples in the Visualizers sub-folder of the Delphi source code. The one which looked most promising as a starting point is the example in the StringListVisualizer.Pas file. However, I found that impenetrable on the first few readings and it turned out that it didn't actually do what I was hoping for.

The code below, which of course needs to be compiled into an IDE package which requires the rtl and designide units, is based upon the much simpler DateTime sample visualizer, but adapted to the Text property of TStrings objects. This adaptation still required quite a lot of work, and that's the main reason I'm posting this additional answer, to save others some head-scratching.

Normally, the Text property of a TStrings variable is displayed in the Watch Window as one or more text lines surrounded by single quotes and separated by the string #$D#$A. The code removes the single quotes and replaces the #$D#$A by a space. This isdone inside the GetReplacementValue function near the top of the code. The rest of the code is just the baggage that you need to include to implement a visualizer, and there's quite a lot of it, even in this rather minimalist implementation.

Once the package is installed, as well as being displayed in the Watch Window, the Text property can be pasted to the Clipboard using the Copy Watch Value entry on the Watch Window's context menu.

Code (written for and tested in 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.