>>>>>>五十分献给最可爱的人（关于托盘问题，俄晕,快要不行了5555555）

Question

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ImgList,registry,shellapi, Menus;
  const PMsg=WM_USER+1;
type
  TForm1 = class(TForm)
    ImageList1: TImageList;
    PopupMenu1: TPopupMenu;
    fgdfgdfg1: TMenuItem;
    dfsdfs1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure PmMessagepc(var Msg: TMessage);message pmsg;
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  hotal_icon:NotifyIconData;
implementation{$R *.DFM}procedure TForm1.FormCreate(Sender: TObject);
var
icon:TIcon;           //拖盘图标
Reg:TRegistry;        //注册表操作对象
sSystemFolder:String; //Windows系统文件夹
sPath:String;
begin
     //创建托盘以及指定其弹出菜单
      icon:=TIcon.Create;
      ImageList1.GetIcon(0,icon);
      hotal_icon.cbSize:=sizeof(NotifyIconData);
      hotal_icon.Wnd:=handle;
      hotal_icon.hIcon:=icon.Handle;
      hotal_icon.uFlags:=NIF_MESSAGE OR NIF_ICON OR NIF_TIP ;
     // hotal_icon.uCallbackMessage:=PMsg;
      hotal_icon.hIcon:=icon.Handle;
      //hotal_icon.hIcon:=Form1.Icon.Handle;
      hotal_icon.szTip:='宾馆客房管理系统';
      shell_NotifyIcon(NIM_ADD,@hotal_icon);
      icon.Free;
end;
procedure TForm1.PmMessagepc(var Msg: TMessage);
var
 mouse_point:Tpoint; //鼠标位置;
begin
 inherited;
 MessageBox(9,'sfsdf','ooo',null);
 if Msg.LParam=WM_RBUTTONDOWN then   //鼠标右键;
 begin
 //获得鼠标点击位置
  GetCursorPos(mouse_point);
 // SetForeGroundWindow(handle);
  //在单击位置弹出
  PopupMenu1.Popup(mouse_point.x,mouse_point.y);
  //菜单弹出位置
  end;end;end.
上面的这段代码已调试通过，但在托盘上却不能触发左击，右击事件，为啥？在线等待

Answer 1

    With Message Do
        Begin
            If (Msg = Wm_TrayIconMessage) Then
                Begin
                    Case LParam Of
                        WM_RButtonDown:
                            Begin
                              GetCursorPos(mouse_point);
                              PopupMenu1.Popup(mouse_point.X, mouse_point.Y);
                            End;
                 End;
       end;

Answer 2

你好DUDUNONO
我加了
With Message Do
可是错误提示
Message为定义
那该怎么办？

Answer 3

http://www.waterpub.com.cn/Softdown/SoftView.asp?SoftID=2048《Delphi深度编程及其项目应用开发》源代码里面有一个托盘的源代码,在应用篇的服务器端程序中..你可以下载来看看的..代码挺简洁.我刚学Delphi,多多指教..:)

Answer 4

to  dudunono(靖) 
  GetCursorPos(mouse_point);
                              PopupMenu1.Popup(mouse_point.X, mouse_point.Y);
为什么要getcursorpos??
直接这样popupmenu1.popup(mouse.x,mouse.y)不就可以了？

Answer 5

<<D5开发人员指南>>深刻的探讨了这个问题。不但有原代码，更重要的是解决了菜单弹出，在失去焦点时不能马上消失的问题。

Answer 6

interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, Buttons, Grids, DBGrids,ShellAPI, Menus,
  ImgList, ScktComp;
const 
   mousemsg = wm_user + 1; //自定义消息，用于处理用户在图标上点击鼠标的事件
   iid = 100; //用户自定义数值，在TnotifyIconDataA类型全局变量ntida中使用type
  TFrmMain = class(TForm)
    StatusBar1: TStatusBar;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    GroupBox2: TGroupBox;
    Memo1: TMemo;
    ComboBox1: TComboBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    GroupBox3: TGroupBox;
    Label7: TLabel;
    Label8: TLabel;
    DateTimePicker1: TDateTimePicker;
    DateTimePicker2: TDateTimePicker;
    DBGrid1: TDBGrid;
    BitBtn3: TBitBtn;
    PopupMenu1: TPopupMenu;
    Exit1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    P1: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    C1: TMenuItem;
    N7: TMenuItem;
    A1: TMenuItem;
    ImageList1: TImageList;
    ServerSocket1: TServerSocket;
    procedure FormShow(Sender: TObject);
    procedure mousemessage(var message: tmessage); message mousemsg;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Exit1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    function ShutDownSystem(si:integer):BOOL;
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  FrmMain: TFrmMain;
  ntida: TNotifyIcondataA; //用于增加和删除系统状态图标
implementationuses ULogon;{$R *.dfm}procedure TFrmMain.FormShow(Sender: TObject);
begin
   FrmLogon.ShowModal;
end;
procedure TFrmMain.mousemessage(var message: tmessage);
var 
   mousept: TPoint; //鼠标点击位置
begin
   inherited;
   if message.LParam = wm_rbuttonup then //用鼠标右键点击图标
   begin
      getcursorpos(mousept); //获取光标位置
      popupmenu1.popup(mousept.x, mousept.y); //在光标位置弹出菜单
   end;
   if message.LParam = wm_lbuttonup then //用鼠标左键点击图标
   begin
   //显示应用程序窗口
      ShowWindow(Handle, SW_SHOW);
   //在任务栏上显示应用程序窗口
      ShowWindow(Application.handle, SW_SHOW);
      SetWindowLong(Application.Handle, GWL_EXSTYLE,
      not (GetWindowLong(Application.handle, GWL_EXSTYLE)
      or WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW));
   end;
   message.Result := 0;
end;
procedure TFrmMain.FormCreate(Sender: TObject);
begin
   SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW); //隐藏系统栏图标
   ntida.cbSize := sizeof(tnotifyicondataa); //指定ntida的长度
   ntida.Wnd := handle; //取应用程序主窗体的句柄
   ntida.uID := iid; //用户自定义的一个数值，在uCallbackMessage参数指定的消息中使用
   ntida.uFlags := nif_icon + nif_tip + nif_message;//指定在该结构中uCallbackMessage、hIcon、szTip参数都有效
   ntida.uCallbackMessage := mousemsg;//指定的窗口消息
   ntida.hIcon := Application.Icon.handle;//指定系统状态栏显示应用程序的图标句柄
   ntida.szTip := '网吧管理系统服务端'; //当鼠标停留在系统状态栏该图标上时，出现该提示信息
   shell_notifyicona(NIM_ADD, @ntida); //在系统状态栏增加一个新图标
end;procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Action := caNone; //不对窗体进行任何操作
   ShowWindow(Handle, SW_HIDE); //隐藏主窗体
   //隐藏应用程序窗口在任务栏上的显示
   ShowWindow(Application.Handle, SW_HIDE);
   SetWindowLong(Application.Handle, GWL_EXSTYLE,
   GetWindowLong(Application.handle, GWL_EXSTYLE)
   or WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW);
end;

Answer 7

好早前用的：
Uses ShellApi
const WM_MYTRAYICONCALLBACK=WM_USER+1000; //系统托盘图标
*****************
private
    //系统托盘图标
    MyTrayIcon:TNotifyIconData;
    procedure WMMyTrayIconCallback(var Msg:TMessage);
    Message WM_MYTRAYICONCALLBACK;
****************
//OnFormCreat
Application.ShowMainForm:=flase;
//以下系统托盘图标
  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:='MossLove之天方夜谭';
  Shell_NotifyIcon(NIM_ADD,@MyTrayIcon);
*******************
//处理点击托盘图标的事件
procedure TFormMoss.WMMyTrayIconCallback(var Msg:TMessage);
var CursorPos:TPoint;
begin
  case Msg.LParam of
    WM_LBUTTONDBLCLK: begin   //鼠标左键双击
                        cishu:=cishu+1;
                        Visible:= not Visible;
                        Application.ShowMainForm:=Visible;
                        SetForegroundWindow(Application.Handle);
                      end;
    WM_RBUTTONDOWN: begin  //单击鼠标右键
                      GetCursorPos(CursorPos);
                      if ODD(cishu) then N1.Caption:='我害羞了'
                        else N1.Caption:='我再想想';
                      PopupMenu1.Popup(CursorPos.X,CursorPos.Y);
                    end;
    WM_LBUTTONDOWN: begin  //单击鼠标左键
                      GetCursorPos(CursorPos);
                      if ODD(cishu) then N1.Caption:='我害羞了'
                        else N1.Caption:='我再想想';
                      PopupMenu1.Popup(CursorPos.X,CursorPos.Y);
                    end;
  end;
end;

Answer 8

unit TrayIcon;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics,
   Controls, Forms, Dialogs, ShellAPI, Menus, StdCtrls, ExtCtrls;type
  ENotifyIconError = class(Exception);  TTrayNotifyIcon = class(TComponent)
  private
    FDefaultIcon: THandle;
    FIcon: TIcon;
    FHideTask: Boolean;
    FHint: string;
    FIconVisible: Boolean;
    FPopupMenu: TPopupMenu;
    FOnClick: TNotifyEvent;
    FOnDblClick: TNotifyEvent;
    FNoShowClick: Boolean;
    FTimer: TTimer;
    Tnd: TNotifyIconData;
    procedure SetIcon(Value: TIcon);
    procedure SetHideTask(Value: Boolean);
    procedure SetHint(Value: string);
    procedure SetIconVisible(Value: Boolean);
    procedure SetPopupMenu(Value: TPopupMenu);
    procedure SendTrayMessage(Msg: DWORD; Flags: UINT);
    function ActiveIconHandle: THandle;
    procedure OnButtonTimer(Sender: TObject);
  protected
    procedure Loaded; override;
    procedure LoadDefaultIcon; virtual;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Icon: TIcon read FIcon write SetIcon;
    property HideTask: Boolean read FHideTask write SetHideTask default False;
    property Hint: String read FHint write SetHint;
    property IconVisible: Boolean read FIconVisible write SetIconVisible default False;
    property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
  end;procedure Register;implementation{ TIconManager }
{ 创建一个隐藏的窗口用于处理事务 }
type
  TIconManager = class
  private
    FHWindow: HWnd;
    procedure TrayWndProc(var Message: TMessage);
  public
    constructor Create;
    destructor Destroy; override;
    property HWindow: HWnd read FHWindow write FHWindow;
  end;var
  IconMgr: TIconManager;
  DDGM_TRAYICON: Cardinal;
constructor TIconManager.Create;
begin
  FHWindow := AllocateHWnd(TrayWndProc);
end;destructor TIconManager.Destroy;
begin
  if FHWindow <> 0 then DeallocateHWnd(FHWindow);
  inherited Destroy;
end;procedure TIconManager.TrayWndProc(var Message: TMessage);
{ 此进程用于处理所有托盘图表返回的消息 }
var
  Pt: TPoint;
  TheIcon: TTrayNotifyIcon;
begin
  with Message do
  begin
    { 如果是托盘图表返回的消息 }
    if (Msg = DDGM_TRAYICON) then
    begin
      TheIcon := TTrayNotifyIcon(WParam);
      case lParam of
        { enable timer on first mouse down. }
        { OnClick will be fired by OnTimer method, provided }
        { double click has not occurred. }
        WM_LBUTTONDOWN: TheIcon.FTimer.Enabled := True;
        { Set no click flag on double click.  This will supress }
        { the single click. }
        WM_LBUTTONDBLCLK:
          begin
            TheIcon.FNoShowClick := True;
            if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(Self);
          end;
        WM_RBUTTONDOWN:
          begin
            if Assigned(TheIcon.FPopupMenu) then
            begin
              { Call to SetForegroundWindow is required by API }
              SetForegroundWindow(IconMgr.HWindow);
              { Popup local menu at the cursor position. }
              GetCursorPos(Pt);
              TheIcon.FPopupMenu.Popup(Pt.X, Pt.Y);
              { Message post required by API to force task switch }
              PostMessage(IconMgr.HWindow, WM_USER, 0, 0);
            end;
          end;
      end;
    end
    else
      { If it isn't a tray callback message, then call DefWindowProc }
      Result := DefWindowProc(FHWindow, Msg, wParam, lParam);
  end;
end;{ TTrayNotifyIcon }constructor TTrayNotifyIcon.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIcon := TIcon.Create;
  FTimer := TTimer.Create(Self);
  with FTimer do
  begin
    Enabled := False;
    Interval := GetDoubleClickTime;
    OnTimer := OnButtonTimer;
  end;
  { Keep default windows icon handy... }
  LoadDefaultIcon;
end;destructor TTrayNotifyIcon.Destroy;
begin
  if FIconVisible then SetIconVisible(False);    // destroy icon
  FIcon.Free;                                    // free stuff
  FTimer.Free;
  inherited Destroy;
end;function TTrayNotifyIcon.ActiveIconHandle: THandle;
{ Returns handle of active icon }
begin
  { If no icon is loaded, then return default icon }
  if (FIcon.Handle <> 0) then
    Result := FIcon.Handle
  else
    Result := FDefaultIcon;
end;procedure TTrayNotifyIcon.LoadDefaultIcon;
{ Loads default window icon to keep it handy. }
{ This will allow the component to use the windows logo }
{ icon as the default when no icon is selected in the }
{ Icon property. }
begin
  FDefaultIcon := LoadIcon(0, IDI_WINLOGO);
end;procedure TTrayNotifyIcon.Loaded;
{ Called after component is loaded from stream }
begin
  inherited Loaded;
  { if icon is supposed to be visible, create it. }
  if FIconVisible then
    SendTrayMessage(NIM_ADD, NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;procedure TTrayNotifyIcon.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = PopupMenu) then
    PopupMenu := nil;
end;

Answer 9

procedure TTrayNotifyIcon.OnButtonTimer(Sender: TObject);
{ Timer used to keep track of time between two clicks of a }
{ double click. This delays the first click long enough to }
{ ensure that a double click hasn't occurred.  The whole   }
{ point of these gymnastics is to allow the component to   }
{ receive OnClicks and OnDblClicks independently. }
begin
  { Disable timer because we only want it to fire once. }
  FTimer.Enabled := False;
  { if double click has not occurred, then fire single click. }
  if (not FNoShowClick) and Assigned(FOnClick) then
    FOnClick(Self);
  FNoShowClick := False;   // reset flag
end;procedure TTrayNotifyIcon.SendTrayMessage(Msg: DWORD; Flags: UINT);
{ This method wraps up the call to the API's Shell_NotifyIcon }
begin
  { Fill up record with appropriate values }
  with Tnd do
  begin
    cbSize := SizeOf(Tnd);
    StrPLCopy(szTip, PChar(FHint), SizeOf(szTip));
    uFlags := Flags;
    uID := UINT(Self);
    Wnd := IconMgr.HWindow;
    uCallbackMessage := DDGM_TRAYICON;
    hIcon  := ActiveIconHandle;
  end;
  Shell_NotifyIcon(Msg, @Tnd);
end;procedure TTrayNotifyIcon.SetHideTask(Value: Boolean);
{ 修改是否在任务栏显示属性 }
const
  { 设置标志，用于确定任务栏显示状态 }
  ShowArray: array[Boolean] of integer = (sw_ShowNormal, sw_Hide);
begin
  if FHideTask <> Value then
  begin
    FHideTask := Value;
    { 在设计期不做任何修改 }
    if not (csDesigning in ComponentState) then
      ShowWindow(Application.Handle, ShowArray[FHideTask]);
  end;
end;procedure TTrayNotifyIcon.SetHint(Value: string);
{ 设置Hint属性 }
begin
  if FHint <> Value then
  begin
    FHint := Value;
    if FIconVisible then
      {修改图标的提示信息}
      SendTrayMessage(NIM_MODIFY, NIF_TIP);
  end;
end;procedure TTrayNotifyIcon.SetIcon(Value: TIcon);
{ Write method for Icon property. }
begin
  FIcon.Assign(Value);  // set new icon
  { Change icon on notification tray }
  if FIconVisible then SendTrayMessage(NIM_MODIFY, NIF_ICON);
end;procedure TTrayNotifyIcon.SetIconVisible(Value: Boolean);
{ 修改是否在任务栏显示属性 }
const
  { Flags to add or delete a tray notification icon }
  MsgArray: array[Boolean] of DWORD = (NIM_DELETE, NIM_ADD);
begin
  if FIconVisible <> Value then
  begin
    FIconVisible := Value;
    { Set icon as appropriate }
    SendTrayMessage(MsgArray[Value], NIF_MESSAGE or NIF_ICON or NIF_TIP);
  end;
end;procedure TTrayNotifyIcon.SetPopupMenu(Value: TPopupMenu);
{ Write method for PopupMenu property }
begin
  FPopupMenu := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;procedure Register;
begin
  RegisterComponents('ChenQ', [TTrayNotifyIcon]);
end;const
  { String to identify registered window message }
  TrayMsgStr = 'DDG.TrayNotifyIconMsg';initialization
  { Get a unique windows message ID for tray callback }
  DDGM_TRAYICON := RegisterWindowMessage(TrayMsgStr);
  IconMgr := TIconManager.Create;
finalization
  IconMgr.Free;
end.

Answer 10

不用这么多代码，
1,注释掉 MessageBox(0,'sfsdf','ooo',MB_Ok);
2,在procedure TForm1.FormDestroy(Sender: TObject);中
 hotal_icon.uCallbackMessage:=PMsg;3,添加procedure TForm1.FormDestroy(Sender: TObject);
begin
  shell_NotifyIcon(NIM_DELETE,@hotal_icon);
end;