如何将 class 方法传递给 SetWindowLongPtr()？

Question

我想处理 TComboBox 下拉列表中的 WM_MOUSEMOVE 消息，以显示项目感知提示。但我无法使 SetWindowLongPtr() 工作。

如果我不使用函数类型变量 (TWndProc)，编译器会因“参数不足”/“需要变量”错误而停止。

如果我传递变量的地址 (@ptrWndProc)，它会编译，但在下拉时立即崩溃。

我试图让prtWndProc成为一个全局变量，但是崩溃并没有消失。

有人可以让它工作吗？

方法指针TWndProc类型解决方案：

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.

正则函数TWndProc类型解决方案：

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.

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

Answer 1

首先，您挂钩的是 TComboBox 自己的 HWND，而不是其 drop-down 列表的 HWND。 VCL 已经为您挂钩 TComboBox 的 HWND，因此要处理直接发送到 TComboBox 本身的消息，您可以简单地：

从 TComboBox 导出新的 class 并覆盖虚拟 WndProc() method, or use a message handler.
挂钩现有对象（如您的示例所示），只需 class 它的 public WindowProc 属性.

无论如何，根本不需要处理SetWindowLongPtr()。

现在，既然你真的想挂钩 drop-down 列表（否则你为什么要检索它的 HWND？），那么你不能使用 non-static class 方法 作为 Win32 回调（至少，不是您尝试的方式）。它有一个隐藏的 Self 参数，API 在调用您的回调时将无法传回该参数。

此外，您将错误的内存地址传递给 SetWindowLongPtr()，这就是您崩溃的原因。您传递的是变量地址，而不是函数地址。

此外，当使用 SetWindowLongPtr() 子 class 一个 HWND 时，您不能直接调用旧的 window 过程，您必须使用 CallWindowProc() 代替。

话虽这么说，但您有 3 种方法可以让您的代码正常工作：

使用 static class 方法 （或独立函数）与 SetWindowLongPtr()。如果您需要从回调内部访问 TComboBox，您可以将 TComboBox 对象指针存储在 drop-down 列表的 HWND:

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
  TForm3 = class(TForm)
    ComboBox1: TComboBox;
    procedure ComboBox1DropDown(Sender: TObject);
    procedure ComboBox1CloseUp(Sender: TObject);
  private
    { Private declarations }
    fDropDownListHandle : HWND;
    fOldDropDownWndProc : TFNWndProc;
  protected
    class function SubClassProc(hwnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; static;
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

class function TForm3.SubClassProc(hwnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  cb: TComboBox;
begin
  case ( msg ) of
    WM_MOUSEMOVE:
      begin
        cb := TComboBox( GetProp( fDropDownListHandle, 'ComboBoxPtr' ) );
        // use cb as needed ...
      end;
    else
      Result := CallWindowProc( fOldDropDownWndProc, hwnd, msg, wParam, lParam );
  end;
end;

procedure TForm3.ComboBox1CloseUp(Sender: TObject);
begin
  if fDropDownListHandle <> 0 then
  begin
    SetWindowLongPtr( fDropDownListHandle, GWLP_WNDPROC, LONG_PTR( fOldDropDownWndProc ) );
    RemoveProp( fDropDownListHandle, 'ComboBoxPtr' );
    fDropDownListHandle := 0;
    fOldDropDownWndProc := nil;
  end;
end;

procedure TForm3.ComboBox1DropDown(Sender: TObject);
var
  cbi : TCOMBOBOXINFO;
begin
  cbi.cbSize := SizeOf(cbi);
  if GetComboBoxInfo( ComboBox1.Handle, cbi ) and ( cbi.hwndList <> 0 ) then
  begin
    fDropDownListHandle := cbi.hwndList;
    SetProp( fDropDownListHandle, 'ComboBoxPtr', THandle( ComboBox1 ) );
    fOldDropDownWndProc := TFNWndProc( SetWindowLongPtr( fDropDownListHandle, GWLP_WNDPROC, LONG_PTR( @SubClassProc ) ) );
  end;
end;

end.

使用 static class 方法（或独立函数）与 SetWindowSubclass()，它允许您传递一个 user-defined 值，例如 TComboBox 对象指针。无需将其存储在 subclassed HWND 本身中：

unit Unit3;

interface

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

type
  TForm3 = class(TForm)
    ComboBox1: TComboBox;
    procedure ComboBox1DropDown(Sender: TObject);
    procedure ComboBox1CloseUp(Sender: TObject);
  private
    { Private declarations }
    fDropDownListHandle : HWND;
  protected
    class function SubClassProc(hwnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall; static;
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

class function TForm3.SubClassProc(hwnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall;
var
  cb: TComboBox;
begin
  case ( msg ) of
    WM_MOUSEMOVE:
      begin
        cb := TComboBox( dwRefData );
        // use cb as needed ...
      end;
    else
      Result := DefSubclassProc( hwnd, msg, wParam, lParam );
  end;
end;

procedure TForm3.ComboBox1CloseUp(Sender: TObject);
begin
  if fDropDownListHandle <> 0 then
  begin
    RemoveWindowSubclass( fDropDownListHandle, @SubClassProc, 1 );
    fDropDownListHandle := 0;
  end;
end;

procedure TForm3.ComboBox1DropDown(Sender: TObject);
var
  cbi : TCOMBOBOXINFO;
begin
  cbi.cbSize := SizeOf(cbi);
  if GetComboBoxInfo( ComboBox1.Handle, cbi ) and ( cbi.hwndList <> 0 ) then
  begin
    fDropDownListHandle := cbi.hwndList;
    SetWindowSubclass( fDropDownListHandle, @SubClassProc, 1, DWORD_PTR( ComboBox1 ) );
  end;
end;

end.

使用 RTL 的 MakeObjectInstance() 函数创建一个 proxy stub 这样你就可以使用 non-static class 方法 与 SetWindowLongPtr() （不适用于 SetWindowSubclass()）：

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
  TForm3 = class(TForm)
    ComboBox1: TComboBox;
    procedure ComboBox1DropDown(Sender: TObject);
    procedure ComboBox1CloseUp(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    fDropDownListHandle : HWND;
    fOldDropDownWndProc : TFNWndProc;
    fNewDropDownWndProc: Pointer;
  protected
    procedure SubClassProc(var Message: TMessage);
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.FormCreate(Sender: TObject);
begin
  fNewDropDownWndProc := MakeObjectInstance( SubClassProc );
end;

procedure TForm3.FormDestroy(Sender: TObject);
begin
  FreeObjectInstance( fNewDropDownWndProc );
end;

procedure TForm3.SubClassProc(var TMessage: TMessage);
begin
  case ( Message.Msg ) of
    WM_MOUSEMOVE:
      begin
        // use ComboBox1 as needed ...
      end;
    else
      Message.Result := CallWindowProc( fOldDropDownWndProc, fDropDownListHandle, Message.Msg, Message.WParam, Message.LParam );
  end;
end;

procedure TForm3.ComboBox1CloseUp(Sender: TObject);
begin
  if fDropDownListHandle <> 0 then
  begin
    SetWindowLongPtr( fDropDownListHandle, GWLP_WNDPROC, LONG_PTR( fOldDropDownWndProc ) );
    fDropDownListHandle := 0;
    fOldDropDownWndProc := nil;
  end;
end;

procedure TForm3.ComboBox1DropDown(Sender: TObject);
var
  cbi : TCOMBOBOXINFO;
begin
  cbi.cbSize := SizeOf(cbi);
  if GetComboBoxInfo( ComboBox1.Handle, cbi ) and ( cbi.hwndList <> 0 ) then
  begin
    fDropDownListHandle := cbi.hwndList;
    fOldDropDownWndProc := TFNWndProc( SetWindowLongPtr( fDropDownListHandle, GWLP_WNDPROC, LONG_PTR( fNewDropDownWndProc ) ) );
  end;
end;

end.

如何将 class 方法传递给 SetWindowLongPtr()？

How to pass a class method to SetWindowLongPtr()?

delphi

winapi