关于任务栏的菜单
一个偏方：
procedure TForm1.btn1Click(Sender: TObject);
var
P: PHandle;
begin
P := @Application.Handle;
P^ := Handle;
end;
---------------------------------------
{ 下面的属于Kingron原创，转载请注明出处，并保留版权信息 }
{ 本文未经许可，严禁转载 }
看了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 }
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 .