trayicon.pas

vpn网上邻居搜索器 工作组 未打开的工作组 正在搜索的工作组 已打开的工作组 无法打开的工作组 主机 未打开的主机 正在搜索的主机 打开的主机（无须登录） 打开的主机（以gues

{*******************************************************************************
 (c) 2003 zw84611
  Tray Icon Unit
  
  This is not a vcl component, it's just a unit, needn't install.
*******************************************************************************}

unit TrayIcon;

interface

uses
  Windows, Messages, SysUtils, Classes, {Graphics, }Controls, Forms, Dialogs,
  {StdCtrls, }Menus,ShellApi;

const
  WM_ZW_TRAYICON = WM_USER+1;

type
  //----------------------------------------------------------------------
  PNotifyIconData = ^TNotifyIconDataA;
    TNotifyIconDataA = record
    cbSize : DWORD;
    Wnd : HWND;
    uID : UINT;
    uFlags : UINT;
    uCallbackMessage : UINT;
    hIcon : HICON;
    szTip : array [0..63] of AnsiChar;
  end;

  //----------------------------------------------------------------------
  TTrayIcon = class(TComponent)
  private
    { Private declarations }
    //FHandle: HWND;
    //-------------------------------------------------------------
    IconData: TNotifyIconData;
    //procedure ShowIcon;
    procedure IconOnClick(var mesg:TMessage); //message WM_ZW_TRAYICON;
    Procedure WMSysCommand(Var mesg: TMessage);
    //-------------------------------------------------------------

  public
    { Public declarations }
    FOriginalWndProc: TWndMethod;
    App: TApplication;PopupMenu: TPopupMenu; FormHandle: HWND;
    do_trayicon: boolean;

    procedure WndProc(var Mesg: TMessage);
    
    procedure ShowIcon;
    procedure RemoveIcon;

    constructor Create(AOwner: TForm; Applic: TApplication; Popup: TPopupMenu; Handle: HWND; ShowIconOnCreate: boolean); //override;
    destructor Destroy; override;
  end;

implementation

//----------------------------------------------------
procedure TTrayIcon.ShowIcon;
begin
  Shell_NotifyIcon( NIM_ADD, @IconData );
  ShowWindow(App.Handle,SW_HIDE)
end;

procedure TTrayIcon.RemoveIcon;
begin
  Shell_NotifyIcon( NIM_DELETE, @IconData );
  ShowWindow(App.Handle,SW_SHOW)
end;
//----------------------------------------------------

constructor TTrayIcon.Create(AOwner: TForm; Applic: TApplication; Popup: TPopupMenu; Handle: HWND; ShowIconOnCreate: boolean);
begin
  Inherited Create(AOwner);
  FormHandle := Handle;
  App := Applic;
  PopupMenu := Popup;
  FOriginalWndProc := AOwner.WindowProc; // you see this is another way instead of AllocateHWnd(WndProc)
  AOwner.WindowProc := WndProc;
  //FHandle := AllocateHWnd(WndProc);  //attention here.

  IconData.cbSize := SizeOf( IconData );
  IconData.Wnd := FormHandle;//FHandle; // attention here
  IconData.uID := 1;
  IconData.uFlags := NIF_ICON  or NIF_MESSAGE or NIF_TIP;
  IconData.uCallBackMessage := WM_ZW_TRAYICON;
  IconData.hIcon := App.Icon.Handle;
  IconData.szTip := 'LAN Explorer';

  if ShowIconOnCreate then
  begin
    do_trayicon := true;
    Shell_NotifyIcon( NIM_ADD, @IconData );
    ShowWindow(FormHandle, SW_HIDE);
  end
  else do_trayicon := false;
end;

destructor TTrayIcon.Destroy;
begin
  Shell_NotifyIcon( NIM_DELETE, @IconData );
  //DeallocateHWnd(FHandle);
  inherited Destroy;
end;

procedure TTrayIcon.WndProc(var Mesg: TMessage);
begin

    //Form1.ListBox1.Items.Add(inttostr(Mesg.Msg));
    if not do_trayicon then
    begin
        FOriginalWndProc(Mesg);
        exit;
    end;

    with Mesg do
    if Msg = WM_ZW_TRAYICON then
    begin
      IconOnClick(mesg);
      //ShowMessage('her');
    end
    else if Msg = WM_SYSCOMMAND then  WMSysCommand(mesg)
    else if Msg = WM_SHOWWINDOW then  ShowWindow(App.Handle,SW_HIDE)
    else FOriginalWndProc(Mesg); //Result := DefWindowProc(FHandle, Msg, wParam, lParam);

end;

procedure TTrayIcon.IconOnClick( var mesg: Tmessage);
var p : TPoint;
begin
 if (mesg.lParam = WM_LBUTTONDOWN) then
 begin

   if not App.MainForm.Visible then
   begin
     ShowWindow(FormHandle, SW_SHOW );
     App.MainForm.Visible := true;
     App.BringToFront;
   end
   else
   begin
     ShowWindow(FormHandle, SW_HIDE );
     App.MainForm.Visible := false;
   end;
   
 end;
 
 if (mesg.lParam = WM_RBUTTONDOWN) then
 begin
   GetCursorPos(p);
   SetForegroundWindow (App.Handle); //<-------------------avoid a little bug.
   App.ProcessMessages;
   PopupMenu.Popup( p.x ,p.y );
 end;
end;

Procedure TTrayIcon.WMSysCommand(var mesg: TMessage) ;
begin

  if (mesg.WParam = SC_MINIMIZE) then
  begin
    Shell_NotifyIcon( NIM_ADD, @IconData );
    ShowWindow(FormHandle, SW_HIDE);
    App.MainForm.Visible := false;
  end
  else
     FOriginalWndProc(Mesg);//Inherited;

end;

end.