TColor Visualizer

Who already didn’t know, I am using Delphi as my primary programming environment. I think it’s definitely the most comfortable, easiest to learn programming language which can build very fast and attractive native applications. One of the most useful features of the new Delphi (which IMO is hugely underestimated) is ability to write custom debugger visualizers. Delphi already has some internal ones (like visualizers for TStrings or TDateTime) but what if you need another one? Well, You can just go and write it yourself! Here is the sample code of my TColor visualizer:
[spoiler]

unit ColorVisualizer;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolsAPI, StdCtrls, ExtCtrls;
type
TAvailableState = (asAvailable, asProcRunning, asOutOfScope);
TColorViewerFrame = class(TFrame, IOTADebuggerVisualizerExternalViewerUpdater, IOTAThreadNotifier)
lbColor: TLabel;
private
FOwningForm: TCustomForm;
FClosedProc: TOTAVisualizerClosedProcedure;
FExpression: string;
FNotifierIndex: Integer;
FCompleted: Boolean;
FDeferredResult: string;
FDeferredError: Boolean;
FColor: TColor;
sColor: string;
FAvailableState: TAvailableState;
function Evaluate(Expression: string): string;
protected
procedure SetParent(AParent: TWinControl); override;
public
procedure CloseVisualizer;
procedure MarkUnavailable(Reason: TOTAVisualizerUnavailableReason);
procedure RefreshVisualizer(const Expression, TypeName, EvalResult: string);
procedure SetClosedCallback(ClosedProc: TOTAVisualizerClosedProcedure);
procedure SetForm(AForm: TCustomForm);
procedure DisplayColor(const Expression, TypeName, EvalResult: string);
procedure AfterSave;
procedure BeforeSave;
procedure Destroyed;
procedure Modified;
procedure ThreadNotify(Reason: TOTANotifyReason);
procedure EvaluteComplete(const ExprStr, ResultStr: string; CanModify: Boolean;
ResultAddress, ResultSize: LongWord; ReturnCode: Integer);
procedure ModifyComplete(const ExprStr, ResultStr: string; ReturnCode: Integer);
end;
procedure Register;
implementation
uses
DesignIntf, Actnlist, ImgList, Menus, IniFiles;
{$R *.dfm}
resourcestring
sColorVisualizerName = 'TColor Visualizer for Delphi';
sColorVisualizerDescription = 'Displays a color of TColor';
sMenuText = 'Show Color';
sFormCaption = 'TColor Visualizer for %s';
sProcessNotAccessible = 'process not accessible';
sOutOfScope = 'out of scope';
type
IFrameFormHelper = interface
['{0FD4A98F-CE6B-422A-BF13-14E59707D3B2}']
function GetForm: TCustomForm;
function GetFrame: TCustomFrame;
procedure SetForm(Form: TCustomForm);
procedure SetFrame(Form: TCustomFrame);
end;
TColorVisualizerForm = class(TInterfacedObject, INTACustomDockableForm, IFrameFormHelper)
private
FMyFrame: TColorViewerFrame;
FMyForm: TCustomForm;
FExpression: string;
public
constructor Create(const Expression: string);
{ INTACustomDockableForm }
function GetCaption: string;
function GetFrameClass: TCustomFrameClass;
procedure FrameCreated(AFrame: TCustomFrame);
function GetIdentifier: string;
function GetMenuActionList: TCustomActionList;
function GetMenuImageList: TCustomImageList;
procedure CustomizePopupMenu(PopupMenu: TPopupMenu);
function GetToolbarActionList: TCustomActionList;
function GetToolbarImageList: TCustomImageList;
procedure CustomizeToolBar(ToolBar: TToolBar);
procedure LoadWindowState(Desktop: TCustomIniFile; const Section: string);
procedure SaveWindowState(Desktop: TCustomIniFile; const Section: string; IsProject: Boolean);
function GetEditState: TEditState;
function EditAction(Action: TEditAction): Boolean;
{ IFrameFormHelper }
function GetForm: TCustomForm;
function GetFrame: TCustomFrame;
procedure SetForm(Form: TCustomForm);
procedure SetFrame(Frame: TCustomFrame);
end;
TDebuggerColorVisualizer = class(TInterfacedObject, IOTADebuggerVisualizer,
IOTADebuggerVisualizerExternalViewer)
public
function GetSupportedTypeCount: Integer;
procedure GetSupportedType(Index: Integer; var TypeName: string;
var AllDescendants: Boolean);
function GetVisualizerIdentifier: string;
function GetVisualizerName: string;
function GetVisualizerDescription: string;
function GetMenuText: string;
function Show(const Expression, TypeName, EvalResult: string; Suggestedleft, SuggestedTop: Integer): IOTADebuggerVisualizerExternalViewerUpdater;
end;
{ TDebuggerDateTimeVisualizer }
function TDebuggerColorVisualizer.GetMenuText: string;
begin
Result := sMenuText;
end;
procedure TDebuggerColorVisualizer.GetSupportedType(Index: Integer;
var TypeName: string; var AllDescendants: Boolean);
begin
TypeName := 'TColor';
AllDescendants := True;
end;
function TDebuggerColorVisualizer.GetSupportedTypeCount: Integer;
begin
Result := 1;
end;
function TDebuggerColorVisualizer.GetVisualizerDescription: string;
begin
Result := sColorVisualizerDescription;
end;
function TDebuggerColorVisualizer.GetVisualizerIdentifier: string;
begin
Result := ClassName;
end;
function TDebuggerColorVisualizer.GetVisualizerName: string;
begin
Result := sColorVisualizerName;
end;
function TDebuggerColorVisualizer.Show(const Expression, TypeName, EvalResult: string; SuggestedLeft, SuggestedTop: Integer): IOTADebuggerVisualizerExternalViewerUpdater;
var
AForm: TCustomForm;
AFrame: TColorViewerFrame;
VisDockForm: INTACustomDockableForm;
begin
VisDockForm := TColorVisualizerForm.Create(Expression) as INTACustomDockableForm;
AForm := (BorlandIDEServices as INTAServices).CreateDockableForm(VisDockForm);
AForm.Left := SuggestedLeft;
AForm.Top := SuggestedTop;
(VisDockForm as IFrameFormHelper).SetForm(AForm);
AFrame := (VisDockForm as IFrameFormHelper).GetFrame as TColorViewerFrame;
AFrame.DisplayColor(Expression, TypeName, EvalResult);
Result := AFrame as IOTADebuggerVisualizerExternalViewerUpdater;
end;
{ TColorViewerFrame }
procedure TColorViewerFrame.DisplayColor(const Expression, TypeName,
EvalResult: string);
begin
FAvailableState := asAvailable;
FExpression := Expression;
try
FColor := StringToColor(EvalResult);
Self.Color := FColor;
if not ColorToIdent(FColor, sColor) then
begin
sColor := EvalResult;
end;
lbColor.Caption := Format('%S Value: %S',[FExpression, sColor]);
except
on E: Exception do
begin
Self.Color := clBtnFace;
lbColor.Caption :=  E.Message;
end;
end;
lbColor.Invalidate;
Self.Invalidate;
end;
procedure TColorViewerFrame.AfterSave;
begin
end;
procedure TColorViewerFrame.BeforeSave;
begin
end;
procedure TColorViewerFrame.CloseVisualizer;
begin
if FOwningForm <> nil then
FOwningForm.Close;
end;
procedure TColorViewerFrame.Destroyed;
begin
end;
function TColorViewerFrame.Evaluate(Expression: string): string;
var
CurProcess: IOTAProcess;
CurThread: IOTAThread;
ResultStr: array[0..4095] of Char;
CanModify: Boolean;
ResultAddr, ResultSize, ResultVal: LongWord;
EvalRes: TOTAEvaluateResult;
DebugSvcs: IOTADebuggerServices;
begin
begin
Result := '';
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, @ResultStr, Length(ResultStr),
CanModify, eseAll, '', ResultAddr, ResultSize, ResultVal, '', 0);
case EvalRes of
erOK: Result := ResultStr;
erDeferred:
begin
FCompleted := False;
FDeferredResult := '';
FDeferredError := False;
FNotifierIndex := CurThread.AddNotifier(Self);
while not FCompleted do
DebugSvcs.ProcessDebugEvents;
CurThread.RemoveNotifier(FNotifierIndex);
FNotifierIndex := -1;
if not FDeferredError then
begin
if FDeferredResult <> '' then
Result := FDeferredResult
else
Result := ResultStr;
end;
end;
erBusy:
begin
DebugSvcs.ProcessDebugEvents;
Result := Evaluate(Expression);
end;
end;
end;
end;
end;
end;
procedure TColorViewerFrame.EvaluteComplete(const ExprStr,
ResultStr: string; CanModify: Boolean; ResultAddress, ResultSize: LongWord;
ReturnCode: Integer);
begin
FCompleted := True;
FDeferredResult := ResultStr;
FDeferredError := ReturnCode <> 0;
end;
procedure TColorViewerFrame.MarkUnavailable(
Reason: TOTAVisualizerUnavailableReason);
begin
if Reason = ovurProcessRunning then
begin
FAvailableState := asProcRunning;
end else if Reason = ovurOutOfScope then
FAvailableState := asOutOfScope;
end;
procedure TColorViewerFrame.Modified;
begin
end;
procedure TColorViewerFrame.ModifyComplete(const ExprStr,
ResultStr: string; ReturnCode: Integer);
begin
end;
procedure TColorViewerFrame.RefreshVisualizer(const Expression, TypeName,
EvalResult: string);
begin
FAvailableState := asAvailable;
DisplayColor(Expression, TypeName, EvalResult);
end;
procedure TColorViewerFrame.SetClosedCallback(
ClosedProc: TOTAVisualizerClosedProcedure);
begin
FClosedProc := ClosedProc;
end;
procedure TColorViewerFrame.SetForm(AForm: TCustomForm);
begin
FOwningForm := AForm;
end;
procedure TColorViewerFrame.SetParent(AParent: TWinControl);
begin
if AParent = nil then
begin
sColor := '';
if Assigned(FClosedProc) then
FClosedProc;
end;
inherited;
end;
procedure TColorViewerFrame.ThreadNotify(Reason: TOTANotifyReason);
begin
end;
{ TColorVisualizerForm }
constructor TColorVisualizerForm.Create(const Expression: string);
begin
inherited Create;
FExpression := Expression;
end;
procedure TColorVisualizerForm.CustomizePopupMenu(PopupMenu: TPopupMenu);
begin
// no toolbar
end;
procedure TColorVisualizerForm.CustomizeToolBar(ToolBar: TToolBar);
begin
// no toolbar
end;
function TColorVisualizerForm.EditAction(Action: TEditAction): Boolean;
begin
Result := False;
end;
procedure TColorVisualizerForm.FrameCreated(AFrame: TCustomFrame);
begin
FMyFrame :=  TColorViewerFrame(AFrame);
end;
function TColorVisualizerForm.GetCaption: string;
begin
Result := Format(sFormCaption, [FExpression]);
end;
function TColorVisualizerForm.GetEditState: TEditState;
begin
Result := [];
end;
function TColorVisualizerForm.GetForm: TCustomForm;
begin
Result := FMyForm;
end;
function TColorVisualizerForm.GetFrame: TCustomFrame;
begin
Result := FMyFrame;
end;
function TColorVisualizerForm.GetFrameClass: TCustomFrameClass;
begin
Result := TColorViewerFrame;
end;
function TColorVisualizerForm.GetIdentifier: string;
begin
Result := 'ColorDebugVisualizer';
end;
function TColorVisualizerForm.GetMenuActionList: TCustomActionList;
begin
Result := nil;
end;
function TColorVisualizerForm.GetMenuImageList: TCustomImageList;
begin
Result := nil;
end;
function TColorVisualizerForm.GetToolbarActionList: TCustomActionList;
begin
Result := nil;
end;
function TColorVisualizerForm.GetToolbarImageList: TCustomImageList;
begin
Result := nil;
end;
procedure TColorVisualizerForm.LoadWindowState(Desktop: TCustomIniFile;
const Section: string);
begin
//no desktop saving
end;
procedure TColorVisualizerForm.SaveWindowState(Desktop: TCustomIniFile;
const Section: string; IsProject: Boolean);
begin
//no desktop saving
end;
procedure TColorVisualizerForm.SetForm(Form: TCustomForm);
begin
FMyForm := Form;
if Assigned(FMyFrame) then
FMyFrame.SetForm(FMyForm);
end;
procedure TColorVisualizerForm.SetFrame(Frame: TCustomFrame);
begin
FMyFrame := TColorViewerFrame(Frame);
end;
var
ColorVis: IOTADebuggerVisualizer;
procedure Register;
begin
ColorVis := TDebuggerColorVisualizer.Create;
(BorlandIDEServices as IOTADebuggerServices).RegisterDebugVisualizer(ColorVis);
end;
procedure RemoveVisualizer;
var
DebuggerServices: IOTADebuggerServices;
begin
if Supports(BorlandIDEServices, IOTADebuggerServices, DebuggerServices) then
begin
DebuggerServices.UnregisterDebugVisualizer(ColorVis);
ColorVis := nil;
end;
end;
initialization
finalization
RemoveVisualizer;
end.

[/spoiler]

Screenshot:

Download full source code with project package. Just open the package, then compile and install it.