trayicon.pas

本例程是利用Windows API函数Shell_NotifyIcon()实现系统托盘图标功能,这个函数和其他处理Windows外壳的函数都包含在ShellAPI单元中 在窗口创建时在Windows

//xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
// 本例程是利用Windows API函数Shell_NotifyIcon()实现系统托盘图标功能,这个函数和其他处理Windows外壳
// 的函数都包含在ShellAPI单元中.
// 在窗口创建时在Windows任务栏的右下角创建一个托盘图标,图标由两个ICON交替出现,当窗口最小化时任务栏
// 中只有托盘图标,当左键单击托盘图标窗口恢复,图标停止交替.
//xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
unit TrayIcon;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, ShellAPI, Menus,
  Dialogs, ExtCtrls, ImgList;

const
  MY_TRAY_ICON_ID = 1;
  WM_MOUSE_EVENTS_MESSAGE = WM_USER+68;

type
  TControlIconType = (citCreate, citModify, citDelete);
  TSelectIco = 0..1;

  TfrmMain = class(TForm)
    ImageList1: TImageList;
    pmPopupMenu: TPopupMenu;
    popMenu_Exit: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure popMenu_ExitClick(Sender: TObject);
  private
    FTimer: TTimer;
    FAlternateTimer: TTimer;
    FIsMouseDblClicked: Boolean;                                      // 双击鼠标是否已经发生
    FIsMouseUp: Boolean;                                              // 鼠标松开是否已经发生

    procedure OnButtonTimer(Sender: TObject);
    procedure AlternateModifyICON(Sender: TObject);
    procedure TrayMouseEvents(var CustomMessage: TMessage); message WM_MOUSE_EVENTS_MESSAGE;
    procedure TrayIconMessage(var SystemMessage: TWMSysCommand); message WM_SYSCOMMAND;
    procedure ControlTrayIcon(Icon: TIcon; const SelType: TControlIconType=citModify);
    procedure ExecuteLMouseOnClick();
    procedure ExecuteRMouseOnClick();
  public
    MyIcon: array[0..1] of TIcon;                                     // 系统托盘交替显示的图标
    TrayData: TNotifyIconData;                                        // 存放系统托盘信息
    IsWinMinimize: Boolean;                                           // 窗口状态(False-正常化 True-最小化)
    vIconIndex: TSelectIco;
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

//xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
// 重载窗口最小化消息
//xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
procedure TfrmMain.TrayIconMessage(var SystemMessage: TWMSysCommand);
begin
  if(SystemMessage.CmdType=SC_MINIMIZE) then                          // 窗口最小化时
  begin
    FAlternateTimer.Enabled := True;                                  // 激活更换托盘图标
    SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
    ShowWindow(Application.Handle, SW_HIDE);                          // 主窗口要求最小化
    IsWinMinimize := True;                                            // 窗口状态(False-正常化 True-最小化)
  end else
  begin
    inherited;
  end;
end;

//xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
// 消息处理函数: 当窗口最小化到系统托盘后,在这里处理Windows系统给窗体发来的消息(检测用户鼠标消息)
//xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
procedure TfrmMain.TrayMouseEvents(var CustomMessage: TMessage);
var
  TrayCursorPos: TPoint;
begin
  case CustomMessage.LParam of
    WM_LBUTTONDOWN,                                                   // 按下鼠标左键
    WM_RBUTTONDOWN:                                                   // 按下鼠标右键
      begin
        FIsMouseUp := False;                                          // 鼠标尚未松开
        FIsMouseDblClicked := False;                                  // 双击尚未发生
        FTimer.Enabled := False;                                      // 结束上次延时
        FTimer.Enabled := True;                                       // 开始延时
      end;
    WM_LBUTTONUP:                                                     // 放开鼠标左键(按下鼠标左键=WM_LBUTTONDOWN)
      begin
        FIsMouseUp := True;                                           // 设置鼠标已经松开,便于Timer检查
      end;
    WM_RBUTTONUP:                                                     // 放开鼠标右键(=按下鼠标右键WM_RBUTTONDOWN)
      begin
        GetCursorPos(TrayCursorPos);                                  // 取得当前光标位置
        pmPopupMenu.Popup(TrayCursorPos.X, TrayCursorPos.Y);          // 将弹出式菜单弹开
      end;
    WM_LBUTTONDBLCLK:                                                 // 双击鼠标左键
      begin
        FIsMouseDblClicked := True;                                   // 设置双击已经发生的标志
        // 处理触发双击事件
      end;
    WM_RBUTTONDBLCLK:                                                 // 双击鼠标右键
      begin
      end;
  else
    CustomMessage.Result := DefWindowProc(FWindowHandle, CustomMessage.Msg, CustomMessage.wParam, CustomMessage.lParam);
  end;
end;

//xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
// 功能描述: 管理及控制系统托盘图标(添加/更改/删除托盘图标).
// 传递参数:
//   Icon   : 托盘需要显示的图标(注意: 如果SelType=citDelete方式时,可以传递nil);
//   SelType: 控制托盘方式(citCreate-创建托盘 citModify-更改图标 citDelete-删除托盘).
//
// 注意: 1.) 必须先调用ControlTrayIcon(MyIcon, citCreate)创建系统托盘;
//       2.) 之后才能调用ControlTrayIcon(MyIcon, citModify)更改托盘图标;
//       3.) 退出系统时必须调用ControlTrayIcon(nil, citDelete)释放系统托盘占用的系统资源.
//==================================================================================================
// 系统托盘使用到的重要数据类(TrayData: TNotifyIconData)各栏位说明如下:
//   1.) cbSize栏位(该结构的大小)
//       定义的TNotifyIconData类变量的大小,用SizeOf(TNotifyIconData)可以取得.
//   2.) Wnd栏位(接收通知消息的窗口句柄)
//       窗口句柄,托盘程序产生的消息有哪个窗体来处理就让Wnd指向那个窗体(例如: 准备在任务栏的托盘小
//       图标上单击时窗体在[显示]和[隐藏]之间切换,则把Wnd指向主窗体的窗口句柄).
//   3.) uID栏位(图标标识,可以添加多个图标)
//       如果你要创建多个托盘小程序,那么怎么区分它们呢?就是靠这个ID号来区分的.
//   4.) uFlags栏位(所创建的托盘程序具有哪些性质)
//       NIF_ICON   : 表示当前所设置的图标(即hIcon的值)是有效的;
//       NIF_MESSAGE: 表示当前所设置的系统消息(即uCallBackMessage的值)是有效的;
//       NIF_TIP    : 表示当前所设置的提示条(即szTip的值)是有效的.
//       *注: 如果需要设置三者都有效时将(uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP).
//   5.) uCallbackMessage栏位(程序定义的接收通知的回调消息)
//       这是7个部分里面最重要的一个,这里指定一个回调消息,也就是说这里定义一个消息名当你单击或者右
//       击托盘图标的时候就会向你在Wnd所指向的窗体发送一个在uCallBackMessage中定义的消息名,然后你
//       在程序中定义一个消息处理函数来处理这个消息,这样就把Windows关于消息的整套流程都处理好了.
//   6.) hIcon栏位(图标句柄)
//       托盘图标的句柄,根据这个句柄你就可以增加/修改/删除图标.
//   7.) szTip栏位(鼠标经过图标时显示的提示信息)
//       就是当你的鼠标放到任务栏托盘的小图标上的时候弹出来的提示信息(必须将NIF_ICON设置有效).
//xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
procedure TfrmMain.ControlTrayIcon(Icon: TIcon; const SelType: TControlIconType=citModify);
begin
  with TrayData do
  begin
    case SelType of                                                   // 控制托盘方式(citCreate-创建托盘 citModify-更改图标 citDelete-删除托盘)
      citCreate:
        begin
          //xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx//
          cbSize           := SizeOf(TNotifyIconData);                // 数据类变量的大小
          Wnd              := Self.Handle;                            // 指向主窗口的句柄
          uID              := MY_TRAY_ICON_ID;                        // 指向托盘程序的ID
          uFlags           := NIF_ICON or NIF_MESSAGE or NIF_TIP;     // 设置[图标/消息/提示]有效
          uCallBackMessage := WM_MOUSE_EVENTS_MESSAGE;                // 指向自定义的消息
          hIcon            := Icon.Handle;                            // 指向托盘图标句柄
          szTip            := '无线数据采集器(服務器端)';             // 系统托盘提示信息
          //xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx//
          Shell_NotifyIcon(NIM_ADD, @TrayData);                       // 添加系统托盘图标
          ShowWindow(Application.Handle, SW_HIDE);                    // 隐藏应用程序窗口
        end;
      citModify:
        begin
          hIcon := Icon.Handle;                                       // 更改托盘图标句柄
          Shell_NotifyIcon(NIM_MODIFY, @TrayData);                    // 更改系统托盘图标
        end;
      citDelete:
        Shell_NotifyIcon(NIM_DELETE, @TrayData);                      // 删除系统托盘图标
    end;
  end;
end;

procedure TfrmMain.ExecuteLMouseOnClick();
begin
  FAlternateTimer.Enabled := False;                                   // 停止更换托盘图标
  if(not IsWinMinimize) then                                          // 窗口状态(False-正常化 True-最小化)
  begin
    SendMessage(Self.Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);          // 发送消息到主窗口要求最小化主窗口
    IsWinMinimize := True;
  end else
  begin
    ShowWindow(Application.Handle, SW_RESTORE);                       // 自动化消息(SW_MAXIMIZE)
    SetForegroundWindow(Self.Handle);                                 // 将窗口置为最前端
    IsWinMinimize := False;
  end;
end;

procedure TfrmMain.ExecuteRMouseOnClick();
var
  TrayCursorPos: TPoint;
begin
  GetCursorPos(TrayCursorPos);                                        // 取得当前光标位置
  pmPopupMenu.Popup(TrayCursorPos.X, TrayCursorPos.Y);                // 将弹出式菜单弹开
end;

procedure TfrmMain.OnButtonTimer(Sender: TObject);
begin
  FTimer.Enabled := False;
  if((not FIsMouseDblClicked) and (FIsMouseUp)) then                  // 双击尚未发生且鼠标已松开
  begin
    ExecuteLMouseOnClick();
    // 触发单击事件；
    // 触发MouseUp事件；
  end;
end;

//xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
// 当最小化窗口后启动定时器,按1000ms时间间隔换图标(图标每1秒换一次)
//xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
procedure TfrmMain.AlternateModifyICON(Sender: TObject);
begin
  if(vIconIndex=0) then vIconIndex := 1
                   else vIconIndex := 0;
  ControlTrayIcon(MyIcon[vIconIndex], citModify);                     // 更换托盘图标
end;
//xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  vIconIndex := 0;
  IsWinMinimize := False;                                             // 窗口状态(False-正常化 True-最小化)
  MyIcon[0] := TIcon.Create;
  MyIcon[1] := TIcon.Create;
  ImageList1.GetIcon(0, MyIcon[0]);
  ImageList1.GetIcon(1, MyIcon[1]);
  //==================================================================//
  FIsMouseUp := False;                                                // 鼠标松开是否已经发生
  FIsMouseDblClicked := False;                                        // 双击鼠标是否已经发生
  FAlternateTimer := TTimer.Create(Self);
  with FAlternateTimer do
  begin
    Enabled  := False;
    Interval := 1000;                                                 // 设置交替更换图标间隔
    OnTimer  := AlternateModifyICON;                                  // 设置时钟超时响应过程
  end;
  FTimer := TTimer.Create(Self);
  with FTimer do
  begin
    Enabled  := False;
    Interval := GetDoubleClickTime();                                 // 时钟间隔设为双击的时间间隔
    OnTimer  := OnButtonTimer;                                        // 设置时钟超时响应过程
  end;
  ControlTrayIcon(MyIcon[vIconIndex], citCreate);                     // 创建托盘图标
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  try
    FTimer.Enabled := False;
    FAlternateTimer.Enabled := False;
    ControlTrayIcon(nil, citDelete);
  finally
    FAlternateTimer.Free;
    MyIcon[0].Free;
    MyIcon[1].Free;
    FTimer.Free;
  end;
end;

//==================================================================================================
// 按下弹出式菜单项
//==================================================================================================
procedure TfrmMain.popMenu_ExitClick(Sender: TObject);
begin
  Close;
end;

end.