如何將類方法傳遞給SetWindowLongPtr()？-有解無憂

我想處理下拉串列WM_MOUSEMOVE中的訊息，以顯示專案感知提示。TComboBox但我就是不能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

uj5u.com熱心網友回復：

首先，您連接的是TComboBox's own HWND，而不是HWND其下拉串列的 the 。VCL 已經為您掛鉤，因此要處理直接發送給自身TComboBox的訊息，您可以簡單地：HWNDTComboBox

從虛擬方法派生一個新類TComboBox并覆寫它WndProc()，或者使用message處理程式。
要掛鉤現有物件（如您的示例），只需將其公共WindowProc屬性子類化即可。

無論哪種方式，根本不需要處理SetWindowLongPtr()。

現在，既然您實際上想要掛鉤下拉串列（否則您為什么要檢索它HWND？），那么您不能使用非靜態類方法作為 Win32 回呼（至少，不是您嘗試的方式） . 它有一個隱藏Self引數，API 在呼叫回呼時無法將其傳回。

此外，您將錯誤的記憶體地址傳遞給SetWindowLongPtr()，這就是您崩潰的原因。您傳入的是變數的地址，而不是函式的地址。

另外，使用SetWindowLongPtr()子類化時HWND，不能直接呼叫舊的視窗程序，必須CallWindowProc()改用。

話雖如此，您有 3 種替代方法可以使您的代碼正常作業：

將static類方法（或獨立函式）與SetWindowLongPtr(). 如果您需要TComboBox從回呼內部訪問，您可以將TComboBox物件指標存盤在下拉串列中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類方法（或獨立函式）SetWindowSubclass()，它允許您傳遞用戶定義的值，例如TComboBox物件指標。無需將其存盤在子類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()函式創建代理存根，以便您可以使用非static類方法（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.

轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/424533.html

標籤：德尔福温纳皮

上一篇：如何僅突出顯示RichEdit中包含“MyString”的行？

下一篇：TObjectvsString在那里和回來