Custom VCL Control for getting window handles. (Spy++ style reticle)

Introduction

Over the years, I don’t think I can count the number of times that I’ve wanted to send window messages to some other application. It can be useful for automating the target application, or even as a primitive form of Inter-process communication. Each time, I have to decide how I’m going to get the target window handle in order to send messages to it, and on many occasions the best approach is to provide the application user with a reticle for locating the target window.

If you’ve ever used Microsoft’s Spy++ tool (which comes with professional editions of visual studio), you’ll know precisely what I mean when I describe this reticle. Spy++ has a “Find Window” dialog which contains this icon:

When you click on the icon and hold down your mouse pointer, the little targeting reticle becomes detached from the icon and tracks your mouse. Move the reticle over some other window, and Spy++ reads out the window handle, class name and caption, along with a small bunch of other information.

As I want this functionality in my own application, I decided to build a custom control to reproduce this behavior.

The solution

If you just want to get to the solution, go ahead and skip down to the “completed source” heading and grab the source-code. Otherwise, stick around and I’ll walk you through how to build this component…

Completed Source

You can download the completed source code for this project here: reticle
Or, if you’d rather simply copy and paste it into a package of your own, here it is in long form..

unit comp.reticle;

interface
uses
  Winapi.Windows,
  System.SysUtils, System.Classes, Vcl.Controls;

type
  TWindowReticle = class(TCustomControl)
  private
    fDragging: boolean;
    fWindowHandle: HWnd;
    fWindowCaption: string;
    fWindowClass: string;
    fAncestorHandle: Hwnd;
    fAncestorClass: string;
    fAncestorCaption: string;
    fOnWindowChange: TNotifyEvent;
  private
    procedure ClearWindowProperties;
    function GetWndFromClientPoint(Pt: TPoint): HWND;
  protected
    function CanResize(var NewWidth, NewHeight: Integer): Boolean; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    procedure Paint; override;
    constructor Create( aOwner: TComponent ); override;
  published
    property OnWindowChange: TNotifyEvent read fOnWindowChange write fOnWindowChange;
    property WindowHandle: Hwnd read fWindowHandle;
    property WindowClass: string read fWindowClass;
    property WindowCaption: string read fWindowCaption;
    property AncestorClass: string read fAncestorClass;
    property AncestorCaption: string read fAncestorCaption;
    property AncestorHandle: Hwnd read fAncestorHandle;
  end;

procedure Register;

implementation
uses
  vcl.forms,
  vcl.graphics;

const
  cFixedSize = 32;
  cHalfSize = 16;
  cQuaterSize = 8;

procedure Register;
begin
  RegisterComponents('Samples', [TWindowReticle]);
end;

{ TWindowReticle }

function TWindowReticle.CanResize(var NewWidth, NewHeight: Integer): Boolean;
begin
  Result := False;
end;

constructor TWindowReticle.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  Width := cFixedSize;
  Height := cFixedSize;
  fOnWindowChange := nil;
  fDragging := False;
  ClearWindowProperties;
end;

procedure TWindowReticle.ClearWindowProperties;
begin
  fWindowHandle := 0;
  fWindowCaption := '';
  fWindowClass := '';
  fAncestorClass := '';
  fAncestorHandle := 0;
  fAncestorCaption := '';
end;

procedure TWindowReticle.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) then begin
    ClearWindowProperties;
    fDragging := True;
    SetCapture(Handle);
    Screen.Cursor := crCross;
    Self.Repaint;
  end;
end;

function TWindowReticle.GetWndFromClientPoint(Pt: TPoint): HWND;
begin
  MapWindowPoints(Handle, GetDesktopWindow, Pt, 1);
  Result := WindowFromPoint(Pt);
end;

procedure TWindowReticle.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  wnd: HWnd;
  TextBuffer: array [0..255] of Char;
begin
  if not fDragging then begin
    exit;
  end;
  wnd := GetWndFromClientPoint(Point(X,Y));
  if wnd=fWindowHandle then begin
    exit;
  end;
  ClearWindowProperties;
  fWindowHandle := wnd;
  //- Get the window class name
  FillChar(TextBuffer,length(TextBuffer),0);
  GetClassName(fWindowHandle, TextBuffer, pred(length(TextBuffer)));
  fWindowClass := TextBuffer;
  //- Get window caption
  FillChar(TextBuffer,length(TextBuffer),0);
  GetWindowText(fWindowHandle,TextBuffer, pred(length(TextBuffer)));
  fWindowCaption := TextBuffer;
  if (GetWindowLong(fWindowHandle, GWL_STYLE) and WS_CHILD) = WS_CHILD then begin
      //- Get Ancestor window handle
      fAncestorHandle := GetAncestor(fWindowHandle, GA_ROOT);
      //- Get ancestor class name
      FillChar(TextBuffer,length(TextBuffer),0);
      GetClassName(fAncestorHandle, TextBuffer, pred(length(TextBuffer)));
      fAncestorClass := TextBuffer;
      //- Get ancestor caption
      FillChar(TextBuffer,length(TextBuffer),0);
      GetWindowText(fAncestorHandle,TextBuffer,pred(length(TextBuffer)));
      fAncestorCaption := TextBuffer;
  end;
  //- Call UI event handler
  if assigned(fOnWindowChange) then begin
    fOnWindowChange(Self);
  end;
end;

procedure TWindowReticle.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if not fDragging then begin
    exit;
  end;
  fDragging := False;
  ReleaseCapture;
  Screen.Cursor := crDefault;
  Self.Repaint;
end;

procedure TWindowReticle.Paint;
begin
  // Set brush and pen properties.
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := clRed;
  Canvas.Pen.Width := 2;
  // Draw circle
  Canvas.Ellipse( cQuaterSize, cQuaterSize, Width - cQuaterSize, Height - cQuaterSize );
  if not fDragging then begin
    Canvas.Pen.Color := clWhite;
    // Draw vertical line
    Canvas.MoveTo( cHalfSize, 0 );
    Canvas.LineTo( cHalfSize, Height );
    // Draw Horizontal line
    Canvas.MoveTo( 0, cHalfSize );
    Canvas.LineTo( Width, cHalfSize );
  end;
end;

end.

Conclusion

I hope you find this code useful. Please consider leaving a comment if you do.
Until next time, thanks for reading.