托盘图标的现实(利用类)

来源:互联网 发布:chrome js调用本地exe 编辑:程序博客网 时间:2024/05/20 16:40
 

unit Unit_TrayIcon;

interface

uses
  Windows, SysUtils, Messages, ShellAPI, Classes, Graphics, Forms, Menus,
  StdCtrls, ExtCtrls;

type

  TTrayNotifyIcon = class
  private
    Tray: TNotifyIconData;
    FHWindow: HWND;
    ActiveIcon: THandle;
    Fimage: TImage;
    FPopMenu: TPopupMenu;
    FTitle: string;
  public
    constructor Create(AOwer: TComponent);
    destructor Destroy; override;
    procedure TrayShow;
    procedure TrayWndProc(var Msg: TMessage);
    procedure SetImage(Value: TImage);
    property Image: TImage read FImage write SetImage;
    property PopMenu: TPopupMenu read FPopMenu write FPopMenu;
    property Title: string read FTitle write FTitle;
  end;

 

implementation

{ TTrayNotifyIcon }

constructor TTrayNotifyIcon.Create(AOwer: TComponent);
begin
  // 为TrayWndProc消息处理方法指定一个隐藏的窗口句柄
  FHWindow := AllocateHWnd(TrayWndProc);
  ActiveIcon := Application.Icon.Handle;
  TrayShow;
  Shell_NotifyIcon(NIM_ADD, @Tray);
end;

destructor TTrayNotifyIcon.Destroy;
begin
  // 为TrayWndProc消息处理方法指定一个隐藏的窗口句柄
  DeallocateHWnd(FHWindow);
  Shell_NotifyIcon(NIM_DELETE, @Tray);
  inherited Destroy;
end;

// 通过Image属性更改托盘图标当前所显示的图标
procedure TTrayNotifyIcon.SetImage(Value: TImage);
begin
  if Assigned(Value) then
    if Value <> Fimage then
    begin
      Fimage := Value;
      ActiveIcon := Fimage.Picture.Icon.Handle;
      TrayShow;
      Shell_NotifyIcon(NIM_MODIFY, @Tray);
    end;
end;

// 配置托盘图标所使用的结构信息
procedure TTrayNotifyIcon.TrayShow;
begin
  Tray.cbSize := SizeOf(Tray);
  Tray.Wnd := FHWindow;
  Tray.uID := 100;
  Tray.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  Tray.uCallbackMessage := WM_USER + 1000;
  StrPCopy(Tray.szTip, Title);
  // Tray.szTip := Title;
  Tray.hIcon := ActiveIcon;
end;

// 消息处理方法: 用于获取对托盘的鼠标事件
procedure TTrayNotifyIcon.TrayWndProc(var Msg: TMessage);
var
  P: TPoint;
begin
  case Msg.LParam of
    WM_LBUTTONDOWN:
      begin
        //单击
      end;
    WM_LBUTTONDBLCLK:
      begin
        //双击
      end;
    WM_RBUTTONDOWN:
      begin
        if Assigned(PopMenu) then
        begin
          GetCursorPos(p);
          PopMenu.Popup(p.X, p.Y);
        end;
      end;
  end;
end;

end.

 

 

主窗体中的调用方法:

procedure TFrmServer.FormCreate(Sender: TObject);
begin
  NotifIco:=TTrayNotifyIcon.Create(Self);
  NotifIco.PopMenu := PopupMenu1;
end;

procedure TFrmServer.FormDestroy(Sender: TObject);
begin
  NotifIco.Free;
end;

procedure TFrmServer.N1Click(Sender: TObject);
begin
  Close;
end;