I want to handle WM_MOUSEMOVE
messages in a TComboBox
drop-down list, to show item-aware hints. But I just can't make SetWindowLongPtr()
work.
If I don't use a functional type variable (TWndProc
), the compiler stops with "Not enough parameter" / "Variable required" errors.
If I pass the variable's address (@ptrWndProc
), it compiles, but instantly crashes on drop-down.
I tried to make prtWndProc
a global variable, but the crash does not disappear.
Could somebody make it work?
Method pointer TWndProc
type solution:
unit Unit3;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
PWndProc = ^TWndProc;
TWndProc = function (hwnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT of object; stdcall;
TForm3 = class(TForm)
ComboBox1: TComboBox;
procedure ComboBox1DropDown(Sender: TObject);
procedure ComboBox1CloseUp(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
fDropDownListHandle : THandle;
fOldDropDownWndProc : TWndProc;
protected
function SubClassProc(hwnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
public
{ Public declarations }
end;
var
Form3: TForm3;
implementation
{$R *.dfm}
function TForm3.SubClassProc(hwnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
case ( msg ) of
WM_MOUSEMOVE:
;
else
result := fOldDropDownWndProc( hwnd, msg, wParam, lParam );
end;
end;
procedure TForm3.ComboBox1CloseUp(Sender: TObject);
var
ptrWndProc : TWndProc;
begin
ptrWndProc := SubClassProc;
fOldDropDownWndProc := PWndProc( SetWindowLongPtr( ComboBox1.Handle, GWLP_WNDPROC, LONG_PTR( @ptrWndProc ) ) )^;
end;
procedure TForm3.ComboBox1DropDown(Sender: TObject);
begin
SetWindowLongPtr( ComboBox1.Handle, GWLP_WNDPROC, LONG_PTR( @fOldDropDownWndProc ) );
end;
procedure TForm3.FormCreate(Sender: TObject);
var
cbi : TCOMBOBOXINFO;
begin
GETCOMBOBOXINFO( ComboBox1.Handle, cbi );
fDropDownListHandle := cbi.hwndList;
end;
end.
Regular function TWndProc
type solution:
unit Unit3;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
PWndProc = ^TWndProc;
TWndProc = function (hwnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
TForm3 = class(TForm)
ComboBox1: TComboBox;
procedure ComboBox1DropDown(Sender: TObject);
procedure ComboBox1CloseUp(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
fDropDownListHandle : THandle;
public
{ Public declarations }
end;
var
Form3: TForm3;
implementation
{$R *.dfm}
var
GLOBAL_ptrWndProc : TWndProc;
GLOBAL_OldDropDownWndProc : TWndProc;
function SubClassProc(hwnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
case ( msg ) of
WM_MOUSEMOVE:
;
else
result := GLOBAL_OldDropDownWndProc( hwnd, msg, wParam, lParam );
end;
end;
procedure TForm3.ComboBox1CloseUp(Sender: TObject);
begin
GLOBAL_ptrWndProc := SubClassProc;
GLOBAL_OldDropDownWndProc := PWndProc( SetWindowLongPtr( ComboBox1.Handle, GWLP_WNDPROC, LONG_PTR( @GLOBAL_ptrWndProc ) ) )^;
end;
procedure TForm3.ComboBox1DropDown(Sender: TObject);
begin
SetWindowLongPtr( ComboBox1.Handle, GWLP_WNDPROC, LONG_PTR( @GLOBAL_OldDropDownWndProc ) );
end;
procedure TForm3.FormCreate(Sender: TObject);
var
cbi : TCOMBOBOXINFO;
begin
GETCOMBOBOXINFO( ComboBox1.Handle, cbi );
fDropDownListHandle := cbi.hwndList;
end;
end.
The DFM:
object Form3: TForm3
Left = 0
Top = 0
Caption = 'Form3'
ClientHeight = 411
ClientWidth = 852
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object ComboBox1: TComboBox
Left = 192
Top = 96
Width = 145
Height = 21
TabOrder = 0
Text = 'ComboBox1'
OnCloseUp = ComboBox1CloseUp
OnDropDown = ComboBox1DropDown
end
end
TForm3.SubClassProc
is a method. It has a hiddenSelf
parameter, which you certainly don't want here!