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