请教：Dephi 中将程序最小化为任务栏中的图标，但我不知道如何加入图标右（或左）键菜单，请高手指点！

Question

uses ShellAPI;const
  WM_RestoreWin   = Wm_User +$0102;
...
  private
    procedure WinTrayIcon(Sender: Tobject);
    procedure DummyWindowProc(var Msg: Tmsg; var Handled: Boolean);
    proceDure WmRestoreWin(var m:TMessage);message Wm_RestoreWin;
....
var
  TrayIcon:TNotifyIconData;
  TrayIcon_Show :TIcon;
.....
procedure TFormMain.DummyWindowProc(var Msg: Tmsg; var Handled: Boolean);
begin
  if Msg.message = WM_COMMAND then
  begin
    case Msg.wParam of
    Ord ('E'): Close;
    end;
  end;
end;procedure TFormMain.WinTrayIcon(Sender: Tobject);
begin
  with TrayIcon do
  begin
    cbSize :=Sizeof(TrayIcon);
    Wnd :=Handle;
    uID :=0;
    uFlags :=NIF_ICON or NIF_MESSAGE or NIF_TIP ;
    uCallbackMessage := WM_RestoreWin;
    try
      ImageList1.GetIcon(0,TrayIcon_Show);
    except
    end;
    hIcon :=TrayIcon_Show.Handle;
    szTip :='Icon';
  end;
  Shell_NotifyIcon(NIM_ADD,@TrayIcon);
  ShowWindow(Application.Handle,SW_HIDE);
  inherited;
end;procedure TFormMain.FormCreate(Sender: TObject);
begin
  TrayIcon_Show :=TIcon.Create;
  Application.OnMinimize :=WinTrayIcon;
end;procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Shell_NotifyIcon(NIM_DELETE, @TrayIcon);
  Action :=caFree;
end;procedure TFormMain.WmRestoreWin(var m: TMessage);
var
  Pt:TPoint;
  Pm:HMenu;
  DC:HDC;
begin
  if m.lParam = wm_RButtonDown then
  begin
    if ConnectCount > 0 then Exit;
    GetCursorPos ( Pt );
    pm := CreatePopupMenu;
    AppendMenu (pm, 0, Ord ('E'), 'Exit');
    SetForegroundWindow (Handle);
    dc := GetDC (0);
    if TrackPopupMenu (pm, tpm_BottomAlign or tpm_RightAlign, pt.x,GetDeviceCaps(dc,HORZRES){pt.y}, 0, Handle , Nil) then
                 SetForegroundWindow (Handle );
    DestroyMenu (pm);
  end;
end;

Answer 1

uses ShellAPI;const
  WM_RestoreWin   = Wm_User +$0102;
...
  private
    procedure WinTrayIcon(Sender: Tobject);
    procedure DummyWindowProc(var Msg: Tmsg; var Handled: Boolean);
    proceDure WmRestoreWin(var m:TMessage);message Wm_RestoreWin;
....
var
  TrayIcon:TNotifyIconData;
  TrayIcon_Show :TIcon;
.....
procedure TFormMain.DummyWindowProc(var Msg: Tmsg; var Handled: Boolean);
begin
  if Msg.message = WM_COMMAND then
  begin
    case Msg.wParam of
    Ord ('E'): Close;
    end;
  end;
end;procedure TFormMain.WinTrayIcon(Sender: Tobject);
begin
  with TrayIcon do
  begin
    cbSize :=Sizeof(TrayIcon);
    Wnd :=Handle;
    uID :=0;
    uFlags :=NIF_ICON or NIF_MESSAGE or NIF_TIP ;
    uCallbackMessage := WM_RestoreWin;
    try
      ImageList1.GetIcon(0,TrayIcon_Show);
    except
    end;
    hIcon :=TrayIcon_Show.Handle;
    szTip :='Icon';
  end;
  Shell_NotifyIcon(NIM_ADD,@TrayIcon);
  ShowWindow(Application.Handle,SW_HIDE);
  inherited;
end;procedure TFormMain.FormCreate(Sender: TObject);
begin
  TrayIcon_Show :=TIcon.Create;
  Application.OnMinimize :=WinTrayIcon;
end;procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Shell_NotifyIcon(NIM_DELETE, @TrayIcon);
  Action :=caFree;
end;procedure TFormMain.WmRestoreWin(var m: TMessage);
var
  Pt:TPoint;
  Pm:HMenu;
  DC:HDC;
begin
  if m.lParam = wm_RButtonDown then
  begin
    if ConnectCount > 0 then Exit;
    GetCursorPos ( Pt );
    pm := CreatePopupMenu;
    AppendMenu (pm, 0, Ord ('E'), 'Exit');
    SetForegroundWindow (Handle);
    dc := GetDC (0);
    if TrackPopupMenu (pm, tpm_BottomAlign or tpm_RightAlign, pt.x,GetDeviceCaps(dc,HORZRES){pt.y}, 0, Handle , Nil) then
                 SetForegroundWindow (Handle );
    DestroyMenu (pm);
  end;
end;

Answer 2

忘了在Formcreate 中加上
  Application.OnMessage  :=DummyWindowProc;

Answer 3

const
  WM_MYTRAYICONCALLBACK=WM_USER+100;
  private
    { Private declarations }
    MyTrayIcon: TNotifyIconData;
    procedure WMMyTrayIconCallback(var Msg: TMessage);
    message WM_MYTRAYICONCALLBACK;procedure TManProForm.FormCreate(Sender: TObject);
begin
  try
    MyTrayIcon.cbSize := SizeOf(TNotifyIconData);
    MyTrayIcon.Wnd    := Handle;
    MyTrayIcon.uID    := 1;
    MyTrayIcon.uFlags :=NIF_ICON OR NIF_TIP OR NIF_MESSAGE;
    MyTrayIcon.uCallbackMessage :=WM_MYTRAYICONCALLBACK;
    MyTrayIcon.hIcon  := Application.Icon.Handle;
    MyTrayIcon.szTip  := '软件工程管理系统[版本V1.01]';
    Shell_NotifyIcon(NIM_ADD, @MyTrayIcon);
  finally
  end;
end;
procedure TManProForm.WMMyTrayIconCallback(var Msg:TMessage);
var
  CursorPos: TPoint;
begin
  case Msg.LParam of
    WM_LBUTTONDBLCLK  :
      begin
      end;
    WM_RBUTTONDOWN  :
      begin
        GetCursorPos(CursorPos);
        PMTray.Popup(CursorPos.X,CursorPos.Y);
      end;
{
    WM_LBUTTONDOWN  :
    WM_LBUTTONUP
    WM_MBUTTONDBLCLK
    WM_MBUTTONDOWN
    WM_MBUTTONUP
    WM_MOUSEMOVE
    WM_MOUSEWHEEL
    WM_RBUTTONDBLCLK
    WM_RBUTTONDOWN
    WM_RBUTTONUP
}
  else
  end;
end;procedure TManProForm.FormDestroy(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_DELETE,@MyTrayIcon);
end;

Answer 4

处理该消息,在该参数的x,y调用TPopupMenu.Popup方法即可