Hooking MS windows messages on Wx Perl.

Sometimes you may need to catch a Windows message that is not already handled by wxWidgets, so there is no Wx::Event for it. With a bit of help from the WIN32::API modules it is possible to hook into the WndProc chain for a wxWindow and watch for the message you are interested in.

The magic is in the SetWindowLong function. When used with the GWL_WNDPROC flag it causes a new WndProc to be set for the window, and returns the old one. This lets you write a function in Perl that can get first crack at all the Windows messages being sent to the window, and if you are not interested in them then pass them on to the original wxWidgets WndProc.

#!/usr/bin/env perl
use strict;
use Win32::API;
use Win32::API::Callback;
use Wx;

# Perl port of Python Code: http://wiki.wxpython.org/HookingTheWndProc

{

    package MyFrame;
    use base 'Wx::Frame';

    use constant GWL_WNDPROC => -4;

    # LONG  SetWindowLong(HWND hWnd, int nIndex, LONG dwNewLong);
    Win32::API->Import('user32', 'SetWindowLongW', 'NIK', 'N');
    # LRESULT CallWindowProc(WNDPROC lpPrevWndFunc, HWND hWnd, UINT Msg, WPARAM wParam, LPARAM lParam);
    Win32::API->Import('user32', 'CallWindowProcW', 'NNIII', 'N');

    sub new {
        my $ref = shift;
        my $self = $ref->SUPER::new( undef,           # parent window
            -1,              # ID -1 means any
            'wxPerl rules',  # title
            [-1, -1],        # default position
            [150, 100],      # size
        );
        # controls should not be placed directly inside
        # a frame, use a Wx::Panel instead
        my $panel = Wx::Panel->new( $self,            # parent window
            -1,               # ID
        );
        # create a button
        my $button = Wx::Button->new( $panel,         # parent window
            -1,             # ID
            'Click me!',    # label
            [30, 20],       # position
            [-1, -1],       # default size
        );
        $self->{newWndProc} = Win32::API::Callback->new(sub { $self->_MyWndProc(@_) }, 'NIII', 'N');
        $self->{oldWndProc} = SetWindowLongW( $self->GetHandle(), GWL_WNDPROC, $self->{newWndProc} );

        return $self;
    }
    
    sub _MyWndProc {
        my ($self, $hWnd, $msg, $wParam, $lParam) = @_;
        # You can process MS Windows messages here.
        print join (',',@_),"\n";
        CallWindowProcW($self->{oldWndProc}, $hWnd, $msg, $wParam, $lParam);
    }

}

{

    package MyApp;
    use base 'Wx::App';

    sub OnInit {
        my $frame = MyFrame->new;
        $frame->Show( 1 );
    }

}

my $app = MyApp->new;
$app->MainLoop;