打入消息循环的另类方法

正常打入消息循环的方法:
如果要监视 WM_CONTEXTMENU 消息来实现菜单的右键菜单,一般做法是通过子类化 (subclass) Menus.PopupList.WndProc 的方法来处理窗口消息。简单讲就是:打入消息循环,完成我的处理,再把消息交还给原先的消息处理函数。当不需要监视消息的时候再退出消息处理(un-subclass)。这样做的好处是:不打破控件的结构。

procedure TMyMenuMessagesHandler.SubclassWndProc;
begin
  FDefMenuProc := Pointer(GetWindowLongA(PopupList.Window, GWL_WNDPROC));
  FObjInstance := Classes.MakeObjectInstance(CustomMenuWndProc);
  SetWindowLongA(PopupList.Window, GWL_WNDPROC, Longint(FObjInstance));
end;

procedure TMyMenuMessagesHandler.UnSubclassWndProc;
begin
  
if Assigned(FDefMenuProc) then
    SetWindowLongA(PopupList.Window, GWL_WNDPROC, Longint(FDefMenuProc));
  
if Assigned(FObjInstance) then
    Classes.FreeObjectInstance(FObjInstance);
end;

procedure TMyMenuMessagesHandler.CustomMenuWndProc(var Message: TMessage);
var
  CancelPopupContextMenu: Boolean;
begin
  
if Message.Msg = WM_CONTEXTMENU then
  
begin
    
// My own code ....
    Message.Result := 
1;
    Exit;
  
end;

  
// Send message to default message handler
  
with Message do
    Result := CallWindowProcA(FDefMenuProc, PopupList.Window, Msg, wParam, lParam);
end


问题的提出
但是这样做有个隐藏问题如果你接管的消息窗口提前释放了那么消息处理链就断了这个时候程序可能会崩溃。如果我们可以直接修改Menus.PopupList.WndProc,那么就不用通过 subclass 来实现消息接管了。幸运的是,对于 Menus.PopupList 这个特殊的全局变量来说,这个是可以做到的。

实现原理:
PopupList 的类型是 TPopupList,我们可以在自己的程序里面定义一个继承类,名为TPopupListEx。因为这是个特殊的全局变量,它是在 Menus.pas 的初始化部分就创建的,我们可以在它创建之后,立刻释放它,然后以 TPopupListEx的形式重新创建。只要声明部分没有任何变化,这种方法可以 “骗过” 任何调用者,它们以为还是在调用TPopupList。

具体代码:
把上面的代码替换成如下代码即可

//PATCH-BEGIN
type
  TPopupListEx = 
class(TPopupList)
  
private
    FOnCustomWndProc: TWndMethod;
  
public
    
property OnCustomWndProc: TWndMethod read FOnCustomWndProc write FOnCustomWndProc;
  
protected
    
procedure WndProc(var Message: TMessage); override;
  
end;

procedure TPopupListEx.WndProc(var Message: TMessage);
begin
  
if Assigned(OnCustomWndProc) then
  
begin
    OnCustomWndProc(Message);
    
if Message.Result = 1 then
      Exit;
  
end;
  
inherited;
end;
//PATCH-END

procedure TMyMenuMessagesHandler.SubclassWndProc;
begin
  
if Assigned(PopupList) then
    TPopupListEx(PopupList).OnCustomWndProc := CustomMenuWndProc;
end;

procedure TMyMenuMessagesHandler.UnSubclassWndProc;
begin
  
if Assigned(PopupList) then
    TPopupListEx(PopupList).OnCustomWndProc := 
nil;
end;

procedure TMyMenuMessagesHandler.CustomMenuWndProc(var Message: TMessage);
var
  CancelPopupContextMenu: Boolean;
begin
  
if Message.Msg = WM_CONTEXTMENU then
  
begin
    
// My own code ....
    Message.Result := 
1;
  
end;
end


initialization
  FreeAndNil(PopupList);
  PopupList := TPopupListEx.Create;

finalization
//FreeAndNil(PopupList); //NOTE: will be freed by finalization section of Menus.pas
end.

 

说明
但是我还不清楚为什么用 subclass 方法的时候,一旦消息窗口释放,程序会崩溃。目前也只能先用这个方法了。

©️2020 CSDN 皮肤主题: 大白 设计师: CSDN官方博客 返回首页
实付0元
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值