使用API如何写出稳定的系统托盘程序？

Question

我想要写一个系统托盘程序，只需要显示一个小图标，然后如果用右键点击一下就弹出一个菜单，找到了一段这样的代码，我试验过后发现这样确实可以实现我想要的功能，但是程序运行一、两个小时后右键菜单就显示不出来了，在显示不出右键菜单时TrackPopupMenu函数虽然返回True，但是我通过GetLastError函数发现有错误ERROR_INVALID_HANDLE，而前面CreatePopupMenu却没有任何错误。代码中的MyDll.dll只需要LoadLibrary就会开启两个线程用TextOutA函数在屏幕上不断的输出文字。
program Shell;uses
  Windows,ShellAPI,Messages,SysUtils;{$R ShellCPU.res}
const
  ClassName='myownclassname';var
  msg:TMsg;
  WndClass:TWndClassA;
  hWnd,hPop:THandle;
  hMap:THandle;
  pBool:Pointer;
  ShowUsage:BOOL;
  WM_TASKBARCREATED:Cardinal;
  PopText:PChar;
  NotifyData: NOTIFYICONDATA;
  bInit:BOOL;
procedure Shell_AddICON(Add:Boolean=True);
begin
  with NotifyData do
  begin
    cbSize:=SizeOf(NotifyData);
    Wnd:=hWnd;
    uID:= 0;
    uFlags:=NIF_MESSAGE or NIF_ICON;
    uCallbackMessage:=WM_USER+888;
  end;
  if Add then
    Shell_NotifyIcon(NIM_ADD,@NotifyData)
  else
    Shell_NotifyIcon(NIM_DELETE,@NotifyData);
end;
procedure InitShare;
begin
  hMap:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(Bool),'myinformation');
  pBool:=MapViewOfFile(hMap,FILE_MAP_ALL_ACCESS,0,0,0);
  CopyMemory(pBool,@ShowUsage,SizeOf(BOOL));
end;procedure WriteShare;
begin
  CopyMemory(pBool,@ShowUsage,SizeOf(BOOL));
end;  function MainWndProc(HWin: THandle; MsgID: UINT; wParam, lParam: Integer): LRESULT; stdcall;
var
  iButton:Integer;
  hdcS:HDC;
  dwErr:DWORD;
  tpCurrentPoint:TPoint;
begin
  case MsgID of
    WM_CREATE:
    begin
      WM_TASKBARCREATED:=RegisterWindowMessage('TaskbarCreated');
    end;  
    WM_CLOSE:
    begin
      UnmapViewOfFile(pBool);
      CloseHandle(hMap);
      DestroyWindow(hWnd);
    end;
    WM_DESTROY:
    begin
      PostQuitMessage(0);
    end;
    WM_USER+888:
    begin      if ((wParam=0) and (lParam=$201)) then
      begin
        ShowUsage:=not ShowUsage;
        WriteShare;
      end;
      if ((wParam=0) and (lParam=$205)) then//在图标上按了右键
      begin
        hPop:=CreatePopupMenu;
        AppendMenu(hPop,MF_STRING,1,'退出');
        AppendMenu(hPop,MF_SEPARATOR,9,nil);
        SetForegroundWindow(HWin);
        GetCursorPos(tpCurrentPoint);
        if ShowUsage=True then
          PopText:=PChar('不显示')
        else
          PopText:=PChar('显示');
        AppendMenu(hPop,MF_CHANGE or MF_STRING,2,PopText);
        iButton:=Integer(TrackPopupMenu(hPop,
                         TPM_LEFTALIGN  or TPM_LEFTBUTTON,
                         tpCurrentPoint.X,
                         tpCurrentPoint.y,
                         0,
                         hWnd,
                         nil));
        DestroyMenu(hPop);
      end;
    end;
  end;
  if MsgID= WM_COMMAND then
  begin
    iButton:=wParam;
    if iButton=1 then
    begin
      Shell_AddICON(False);
      ExitProcess(0);
    end
    else if iButton=2 then
    begin
      ShowUsage:=not ShowUsage;
      WriteShare;
      if ShowUsage then
        NotifyData.hIcon:=LoadIcon(HInstance,'TRAYH')
      else
        NotifyData.hIcon:=LoadIcon(HInstance,'TRAYS');
    end;
    Shell_NotifyIcon(NIM_MODIFY,@NotifyData);
  end;
  if MsgID=WM_TASKBARCREATED then
  begin
    Shell_AddICON;
  end;  
  Result:=DefWindowProc(HWin,MsgID,wParam,lParam);
end;begin
  if ParamStr(1)='f' then
  begin
    ShowUsage:=False;
    NotifyData.hIcon:=LoadIcon(HInstance,'TRAYS');
  end  else
  begin
    ShowUsage:=True;
    NotifyData.hIcon:=LoadIcon(HInstance,'TRAYH');
  end;    with WndClass do
  begin
    style:=CS_HREDRAW or CS_VREDRAW;
    lpfnWndProc:=@MainWndProc;
    hInstance:= sysinit.HInstance;
    hIcon:=LoadIcon(0,PChar(IDI_APPLICATION));
    hCursor:=LoadCursor(0,IDC_ARROW);
    hbrBackground:=GetStockObject(WHITE_BRUSH);
    lpszClassName:=ClassName;
  end;
  if RegisterClass(WndClass)=0 then
    ExitProcess(0);
  hWnd:=CreateWindowEx(0,PChar(ClassName),'Shell',WS_OVERLAPPED,0,0,100,100,0,0,hInstance,nil);
  if hWnd=0 then
  begin
    MessageBox(0,'无法创建窗口！','错误',0);
    ExitProcess(0);
  end;
  InitShare;
  Shell_AddICON;
  LoadLibrary('MyDll.dll');
  while GetMessage(msg,0,0,0) do
  begin
    TranslateMessage(msg);
    DispatchMessage(msg);
  end;
end.  

Answer 1

CoolTrayIcon VCL组件源码是公开的，可以下载一个看一下。

Answer 2

  Fnid : PNotifyIconDataA; 
New(Fnid);
  with Fnid^ do
  begin
    Wnd := Handle;
    uID := 0;
    uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
    hIcon := Application.Icon.Handle;
    uCallbackMessage := MY_MESSAGE;
    StrPCopy(szTip,Application.Title);
    szTip :='程序标题';
  end;
  Shell_NotifyIcon(NIM_ADD, Fnid);
最后程序结束时要记得释放
  Shell_NotifyIcon(NIM_DELETE, Fnid);
至于弹出菜单
 声明   procedure TaskIcoMsgDo(var Msg : TMessage);Message MY_MESSAGE;procedure TForm1.TaskIcoMsgDo(var Msg: TMessage);
Var P:TPoint;
begin
  if not IsWindowEnabled(Handle) then
     Exit;  if Msg.LParam = WM_RBUTTONUP then
  begin    GetCursorPos(P);
    PopupMenu1.Popup(P.x, P.y);
 //    if Msg.LParam = WM_RBUTTONUP then  end;
  if msg.LParam=wm_lbuttonup then
  begin
  form1.Show;
  end;end;

Answer 3

to lynmison：我下了CoolTrayIcon，但不知道为什么看不到源码（没有pas），而且我对Delphi的面向对象编程知之甚少，估计拿到源码也看不出个所以然
to brightyang:您的代码是用了控件的吧，我想看看纯API实现的

Answer 4

我的代码中用的就是TrackPopupMenu啊

Answer 5

终于找出问题所在了：真正的问题竟是出在那个DLL文件上，我找到写DLL的人，看了源码后发现DLL文件中一个函数通过CreateFont获得了一个HFONT，但是函数结束时没有DeleteObject，而这个函数是循环调用的，所以一段时间后GDI句柄用光了（通过Process Explorer可以看到），所以菜单无法绘制出来，但是在相应的位置上点击去仍然有效