How to do a very simple debug value replacer for Delphi? - delphi

Question

Why do we need so much code just to tell the debugger to call .ToString on some objects?
I looked at the included examples under C:\Program Files (x86)\Embarcadero\Studio\19.0\source\Visualizers and adapted them for one of my objects - it works well.
Is there an easier way?
unit uMyObjectDebugVisualizer;
interface
procedure Register;
implementation
uses
Classes, Forms, SysUtils, ToolsAPI;
type
TMyObjectDebugVisualizer = 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;
{ TMyObjectDebugVisualizer }
procedure TMyObjectDebugVisualizer.AfterSave;
begin
// don't care about this notification
end;
procedure TMyObjectDebugVisualizer.BeforeSave;
begin
// don't care about this notification
end;
procedure TMyObjectDebugVisualizer.Destroyed;
begin
// don't care about this notification
end;
procedure TMyObjectDebugVisualizer.Modified;
begin
// don't care about this notification
end;
procedure TMyObjectDebugVisualizer.ModifyComplete(const ExprStr, ResultStr: string; ReturnCode: Integer);
begin
// don't care about this notification
end;
procedure TMyObjectDebugVisualizer.EvaluteComplete(const ExprStr,
ResultStr: string; CanModify: Boolean; ResultAddress, ResultSize: Cardinal;
ReturnCode: Integer);
begin
EvaluateComplete(ExprStr, ResultStr, CanModify, TOTAAddress(ResultAddress),
LongWord(ResultSize), ReturnCode);
end;
procedure TMyObjectDebugVisualizer.EvaluateComplete(const ExprStr,
ResultStr: string; CanModify: Boolean; ResultAddress: TOTAAddress; ResultSize: LongWord;
ReturnCode: Integer);
begin
FCompleted:= True;
if ReturnCode = 0 then
FDeferredResult:= ResultStr;
end;
procedure TMyObjectDebugVisualizer.ThreadNotify(Reason: TOTANotifyReason);
begin
// don't care about this notification
end;
function TMyObjectDebugVisualizer.GetReplacementValue(const Expression, TypeName, EvalResult: string): string;
var
CurProcess: IOTAProcess;
CurThread: IOTAThread;
ResultStr: array[0..255] of Char;
CanModify: Boolean;
ResultAddr, ResultSize, ResultVal: LongWord;
EvalRes: TOTAEvaluateResult;
DebugSvcs: IOTADebuggerServices;
Done: Boolean;
begin
Result:= EvalResult;
if Supports(BorlandIDEServices, IOTADebuggerServices, DebugSvcs) then CurProcess:= DebugSvcs.CurrentProcess;
if (CurProcess <> nil) and (CurProcess.GetProcessType <> optOSX32) then begin
CurThread:= CurProcess.CurrentThread;
if CurThread <> nil then repeat
Done:= True;
EvalRes:= CurThread.Evaluate(Expression + '.ToString', #ResultStr, Length(ResultStr),
CanModify, eseAll, '', ResultAddr, ResultSize, ResultVal, '', 0);
case EvalRes of
erOK: Result:= ResultStr;
erDeferred: begin
FCompleted:= False;
FDeferredResult:= '';
FNotifierIndex:= CurThread.AddNotifier(Self);
while not FCompleted do DebugSvcs.ProcessDebugEvents;
CurThread.RemoveNotifier(FNotifierIndex);
FNotifierIndex:= -1;
if FDeferredResult <> '' then Result:= FDeferredResult
else Result:= EvalResult;
end;
erBusy: begin
DebugSvcs.ProcessDebugEvents;
Done:= False;
end;
end;
until Done;
end;
end;
function TMyObjectDebugVisualizer.GetSupportedTypeCount: Integer;
begin
Result:= 1;
end;
procedure TMyObjectDebugVisualizer.GetSupportedType(Index: Integer; var TypeName: string; var AllDescendants: Boolean);
begin
AllDescendants:= True;
TypeName:= 'TMyObject';
end;
function TMyObjectDebugVisualizer.GetVisualizerDescription: string;
begin
Result:= 'Displays TMyObject objects';
end;
function TMyObjectDebugVisualizer.GetVisualizerIdentifier: string;
begin
Result:= ClassName;
end;
function TMyObjectDebugVisualizer.GetVisualizerName: string;
begin
Result:= 'TMyObject Visualizer for Delphi';
end;
var
MyObjectVis: IOTADebuggerVisualizer;
procedure Register;
begin
MyObjectVis:= TMyObjectDebugVisualizer.Create;
(BorlandIDEServices as IOTADebuggerServices).RegisterDebugVisualizer(MyObjectVis);
end;
procedure RemoveVisualizer;
var
DebuggerServices: IOTADebuggerServices;
begin
if Supports(BorlandIDEServices, IOTADebuggerServices, DebuggerServices) then begin
DebuggerServices.UnregisterDebugVisualizer(MyObjectVis);
MyObjectVis:= nil;
end;
end;
initialization
finalization
RemoveVisualizer;
end.
To get this working, you have to add it to a package. Also add "designide.dcp" to the required packages.