打入消息循环的另类方法

正常打入消息循环的方法：
如果要监视 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 方法的时候，一旦消息窗口释放，程序会崩溃。目前也只能先用这个方法了。