Subclassing a window

What is it?

Subclassing a window is the process of intercepting all calls to the window procedure of a given window. When you subclass a window, you can get hand on every message sent/posted to the window you’ve subclassed.

Why subclass?

Why would you want to subclass a window ? For example if a windows does almost everything you want, but you need a few more features, you can change or add features to the original control by subclassing it.

I my case, I had the need from another window to know when a specific window was disabled and enabled again. This is easy to do using subclassing because when a window is enabled or disabled, it receives a WM_ENABLE message. Al I had to do was to subclass the target window, check for WM_ENABLE message to do what I have to do and pass long everything to the original window procedure.

My real application is a little bit complex to explain. This is why in this article I will show you how to do using a very simple demo program. A Delphi form will subclass itself to trap the WM_ENABLE message. Using the exact same technic, you can subclass any window, being a form or a control or even a non-Delphi window.

How to subclass?

Every window has a so called “window procedure”. This is a procedure that window call whenever a message has to be processed by the window. For example, when a window needs to be painted, Windows send WM_PAINT message. When you move the mouse over the window, Windows send WM_MOUSEMOVE and so on.

The window procedure is fixed when creating the window. For an existing window, you can get or set the window procedure using Windows API function GetWindowLong and SetWindowLong using the constant GWL_WNDPROC to specify what to get or set.

        // Get the existing window procedure (his address)
        FWndProcPrevious     := TFNWndProc(GetWindowLong(Handle, GWL_WNDPROC));
       // Set back the saved window procedure
        SetWindowlong(Handle, GWL_WNDPROC, NativeInt(FWndProcPrevious));

To set a new window procedure, you must first create that procedure in your code. Using Delphi, you add the following declaration in your form:

    procedure WndProcSubClassed(var Msg: TMessage);

An example implementation trapping WM_ENABLE message would be:

procedure TForm1.WndProcSubClassed(var Msg: TMessage);
begin
    if Msg.Msg = WM_ENABLE then
         Memo1.Lines.Add('WM_ENABLE ' + IntToStr(Ord(TWMEnable(Msg).Enabled)));
    Msg.Result := CallWindowProc(FWndProcPrevious, Handle, Msg.Msg, Msg.WParam, Msg.LParam);
end;

In this implementation, a call if made to CallWindowProc to pass along everything to the original window procedure.

We cannot pass WndProcSubClassed directly to SetWindowLong because it is not a simple procedure but a method of object which is not exactly the same. Windows API doesn’t know at all Delphi objects!

Delphi runtime has a function called MakeObjectInstance which does the required work to stub an object method and return a simple procedure suitable for Windows API. Since MakeObjectInstance allocate memory on the fly, it must be freed later by calling FreeObjectInstance.

Know those details; we can now create two procedures to subclass and unsubclass a given window:

procedure TForm1.SubClass;
begin
    if FWndProcPrevious <> nil then
        ShowMessage('Already subclassed')
    else begin
        FWndProcPrevious     := TFNWndProc(GetWindowLong(Handle, GWL_WNDPROC));
        FWndProcInstanceStub := MakeObjectInstance(WndProcSubClassed);
        SetWindowlong(Handle, GWL_WNDPROC, NativeInt(FWndProcInstanceStub));
    end;
end;

procedure TForm1.UnsubClass;
begin
    if FWndProcPrevious <> nil then begin
        SetWindowlong(Handle, GWL_WNDPROC, NativeInt(FWndProcPrevious));
        FreeObjectInstance(FWndProcInstanceStub);
        FWndProcPrevious     := nil;
        FWndProcInstanceStub := nil;
    end;
end;

You can call SubClass from the FormShow event handler, or from a button click or whatever fits your needs. Don’t forget to call UnsubClass whenever you don’t need subclassing anymore, for example from a button OnClick handler or simply from FormDestroy.

The demo I wrote (see complete code below) applies this. There I a form with 3 buttons and a memo. Two buttons are used for subclassing and unsubclassing the form. The third button is used to call ShowMessage which is modal and as such disable the window, making a WM_ENABLE message to be sent before and after the modal dialog box is show. The demo display this is the memo.

Complete demo

Here is the source code:

unit SubClassingMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    SubClassButton: TButton;
    Memo1: TMemo;
    UnsubClassButton: TButton;
    Button3: TButton;
    procedure SubClassButtonClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure UnsubClassButtonClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    FWndProcPrevious     : TFNWndProc;
    FWndProcInstanceStub : Pointer;
    procedure WndProcSubClassed(var Msg: TMessage);
    procedure UnsubClass;
    procedure SubClass;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SubClassButtonClick(Sender: TObject);
begin
    SubClass;
end;

procedure TForm1.UnsubClassButtonClick(Sender: TObject);
begin
    UnsubClass;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
    ShowMessage('Hello');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    UnsubClass;
end;

procedure TForm1.SubClass;
begin
    if FWndProcPrevious <> nil then
        ShowMessage('Already subclassed')
    else begin
        FWndProcPrevious     := TFNWndProc(GetWindowLong(Handle, GWL_WNDPROC));
        FWndProcInstanceStub := MakeObjectInstance(WndProcSubClassed);
        SetWindowlong(Handle, GWL_WNDPROC, NativeInt(FWndProcInstanceStub));
    end;
end;

procedure TForm1.UnsubClass;
begin
    if FWndProcPrevious <> nil then begin
        SetWindowlong(Handle, GWL_WNDPROC, NativeInt(FWndProcPrevious));
        FreeObjectInstance(FWndProcInstanceStub);
        FWndProcPrevious     := nil;
        FWndProcInstanceStub := nil;
    end;
end;

procedure TForm1.WndProcSubClassed(var Msg: TMessage);
begin
    if Msg.Msg = WM_ENABLE then
         Memo1.Lines.Add('WM_ENABLE ' + IntToStr(Ord(TWMEnable(Msg).Enabled)));
    Msg.Result := CallWindowProc(FWndProcPrevious, Handle, Msg.Msg, Msg.WParam, Msg.LParam);
end;

end.

Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
This article is available from http://francois-piette.blogspot.be/2013/03/subclassing-a-window.html