看了N个关于任务栏菜单的贴子，例如，有一个网友问如何做出和Winamp3.0的任务栏类似的菜单，也有的网友问如何拦截任务栏菜单的弹出消息，实际上，这个问题很简单的。下面是Kingron的研究结果！
我们都知道，在Delphi Application中，有一个隐含的Window，就是TApplication，这是一个隐藏的窗口，他在后面默默处理这一切关于Application相关的东西，我们甚至可以使用ShowWindow(Application.Handle,SW_SHOW)来看到这个窗口！这些虽然是题外话，但是，我们下面要做的却和这个窗口相关，因此你如果要继续的话，最好先补习一下子类化、TApplication、WndProc、Windows的消息机制等等相关的知识。我们知道对于一个Form，可以很容易拦截System Menu的消息，例如我们只要拦截WM_SYSCOMMAND就可以得到窗口系统菜单的消息，那么要拦截菜单的弹出消息，我们只要拦截WM_INITMENU即可！我们可以做一个简单的实验，New一个Application，然后在主窗体里面添加类似代码：
private
{ Private declarations }
procedure wmtest(var msg:TMessage);message wm_initmenu;
..........
procedure TForm1.wmtest(var msg: TMessage);
begin
Caption:='InitMenu';
end;
然后运行程序，点击Sys Menu，你就会看到效果！到这里，我们已经发现，只要拦截WM_INITMENU消息，就可以知道系统菜单的弹出了！现在问题是，不过我怎么写代码，可是任务栏菜单的弹出对于WM_INITMENU的拦截没有任何反应！难道我们那里错了吗？难道还有其它的东西隐藏在后面？问题的关键在于我们拦截的窗口不对！对于任务栏的菜单而言，这个菜单就是Application窗口的System Menu！因此我们的关键在于要拦截Application窗口的WM_INITMENU消息！至此，我们已经前进了一大步！知道了这一点，就比较好办了，我们知道，Delphi中有一个TApplicationEvents控件，他有一个属性，就是OnMessage，因此我们只要把Application的消息都经过OnMessage处理不就可以了？看起来似乎是一个完美的方法，然而，但你在OnMessage添加类似的代码的时候，你会发现，根本没有任何作用：
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
if Msg.message = wm_initmenu then
Caption:='OK';
end;
那个地方出现了错误？没有，哪里都没有，问题是，Delphi在封装的时候，过滤掉了一些东西，Application的OnMessage并不能处理程序的每一个消息，有些东西被他丢掉了！看来此路不通，必须另外找一个方法！然而幸运的是，我们都知道，在Windows的每一个窗口中，都有一个WndProc过程，这个过程负责处理“所有”的消息，因此我们只要Hook这个WndProc即可，也就是说我们只要把TApplication窗口的WndProc过程让我们接管，我们处理之后，然后仍然交给原来的WndProc处理即可，这样就可以达到我们的目的！那么如何来Hook这个Application窗口的WndProc过程呢？很简单，只要两个函数和几句简单的代码就可以了。必须用到的函数是GetWindowLong、SetWindowLong、CallWindowProc，首先我们用GetWindowLong获取原来的WndPro过程：
OldWndProc := TFarProc(GetWindowLong(Application.Handle, GWL_WNDPROC));
其中OldWndProc就是用来保存原来的WndProc过程的，因为我们还需要他！
然后利用SetWindowLong来挂接我们的WndProc过程：
SetWindowLong(Application.Handle, GWL_WNDPROC,longint(@NewWndProc));
此处的NewWndProc就是我们自己的WndProc处理过程！类似下面：
function NewWndProc(hWndAppl: HWnd; Msg, wParam: Word; lParam: Longint): Longint; stdcall;
begin
NewWndProc := 0; { Default WndProc return value }
{ * * * Handle messages here; The message number is in Msg * * * }
case msg of
WM_INITMENU:MessageBox(0,'OK','Info',MB_OK+MB_ICONINFORMATION);
end;
NewWndProc := CallWindowProc(OldWndProc, hWndAppl, Msg, wParam, lParam);
end;
至此，问题已经解决了，如果想简单一点儿的话，我们可以做一个简单的控件即可。
unit TaskMenu;
{*************************************************************}
{* *}
{* TaskMenu Control,Copyright Kingron 2002 *}
{* All rights reserverd. *}
{* Bug Report : Kingron@163.net *}
{* WEB : http://kingron.myetang.com *}
{* Special Thank:ChongChong(http://www.lkgarden.com/lfpsoft) *)
{* *}
{*************************************************************}
interface
uses
Windows, Messages, SysUtils, Classes, Menus, Forms, Controls;
type
TTaskMenu = class(TPopupMenu)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
end;
procedure Register;
implementation
const
CM_POPUP_MENU = WM_USER + $500;
CM_APP_MENU = $0313;
var
OldWndProc : Pointer;
SysMenu : TPopupMenu;
procedure Register;
begin
RegisterComponents('Samples', [TTaskMenu]);
end;
{ TTaskMenu }
function NewWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): UINT; stdcall;
begin
Result := 0;
case Msg of
{ Not use SendMessage }
CM_APP_MENU: PostMessage(HWND, CM_POPUP_MENU, 0, 0);
CM_POPUP_MENU: SysMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
else
Result := CallWindowProc(OldWndProc, hWnd, Msg, wParam, lParam);
end;
end;
constructor TTaskMenu.Create(AOwner: TComponent);
begin
inherited;
SysMenu := Self;
OldWndProc := Pointer(GetWindowLong(Application.Handle, GWL_WNDPROC));
if not (csDesigning in ComponentState) then
SetWindowLong(Application.Handle, GWL_WNDPROC, longint(@NewWndProc));
end;
destructor TTaskMenu.Destroy;
begin
SetWindowLong(Application.Handle, GWL_WNDPROC, longint(OldWndProc));
inherited;
end;
end.
大家注意，上面有一个全局变量，这个是不符合OO要求的，但是我们使用SetWindowLoing中的第三个参数，又不能是Object的方法，那么怎么办呢？可以利用指针来做：
在TTaskMenu中，设立一个Pointer:MyProc;
然后修改Create代码：
OldWndProc := Pointer(GetWindowLong(Application.Handle, GWL_WNDPROC));
MyProc:=Classes.MakeObjectInstance(Hooked);
SetWindowLong(Application.Handle, GWL_WNDPROC, longint(MyProc))
而Hooked就是一个Wndproc过程，这样，就可以实现OO的思想了。
最后，别忘记在需要的时候，使用FreeObjectInstance(MyProc)释放掉资源。
最后修改如下：
unit TaskMenu;
{*************************************************************}
{* *}
{* TaskMenu Control,Copyright Kingron 2002 *}
{* All rights reserverd. *}
{* Bug Report : Kingron@163.net *}
{* WEB : http://kingron.myetang.com *}
{* Special Thank:ChongChong(http://www.lkgarden.com/lfpsoft) *)
{* *}
{*************************************************************}
interface
uses
Windows, Messages, SysUtils, Classes, Menus, Forms, Controls;
type
TTaskMenu = class(TPopupMenu)
private
{ Private declarations }
OldWndProc: Pointer;
NewWndProc: Pointer;
protected
{ Protected declarations }
procedure HookWin;
procedure UnHookWin;
procedure Hooked(var Msg: TMessage);
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
end;
procedure Register;
implementation
const
CM_POPUP_MENU = WM_USER + $500;
CM_APP_MENU = $0313;
procedure Register;
begin
RegisterComponents('Samples', [TTaskMenu]);
end;
{ TTaskMenu }
procedure TTaskMenu.Hooked(var Msg: TMessage);
begin
case Msg.Msg of
CM_APP_MENU: PostMessage(Application.Handle, CM_POPUP_MENU, 0, 0);
CM_POPUP_MENU: Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
else
Msg.Result := CallWindowProc(OldWndProc, Application.Handle, Msg.Msg, Msg.wParam, Msg.lParam);
end;
end;
constructor TTaskMenu.Create(AOwner: TComponent);
begin
inherited;
HookWin;
end;
destructor TTaskMenu.Destroy;
begin
UnHookWin;
inherited;
end;
procedure TTaskMenu.HookWin;
begin
OldWndProc := Pointer(GetWindowLong(Application.Handle, GWL_WNDPROC));
NewWndProc := Classes.MakeObjectInstance(Hooked);
if not (csDesigning in ComponentState) then
SetWindowLong(Application.Handle, GWL_WNDPROC, longint(NewWndProc));
end;
procedure TTaskMenu.UnHookWin;
begin
SetWindowLong(Application.Handle, GWL_WNDPROC, longint(OldWndProc));
if Assigned(NewWndProc) then Classes.FreeObjectInstance(NewWndProc);
NewWndProc := nil;
end;
end.
此文章由 http://www.ositren.com 收集整理 ,地址为:
http://www.ositren.com/htmls/68124.html