FireMonkey TrayIcon组件

其实说实在的, 这个很好做, 只是调用了一个api而以, 没有其它的, 封装为控件也是不很麻烦,,,麻烦点主要在于消息的接收, 具体都可参考vcl的trayicon控件来做,

我也懒得多说什么了,直接贴代码了, 其中Balloon部分参考了vcl的

前段时间发现一个bug,如 BorderIcons被取消, 或者BorderStyle设置不为bsSizeable, 启动时托盘会消失问题, 这个办法可以通过动态在OnShow事件中创建组件来解决

{ *************************************************************************** }
{                                                                             }
{ 功能：FMX平台win托盘图标                                                    }
{ 名称：FMX.ZYJ.TrayIcon.pas                                                  }
{ 版本：1.1                                                                   }
{ 环境：Win8.1                                                                }
{ 工具：Delphi XE3 AppMethod DelphiXE6                                        }
{ 日期：2014/3/12 20:27:56                                                    }
{ 作者：ying32                                                                }
{ QQ  ：1444386932                                                             }
{ E-mail：[email protected]                                              }
{ 版权所有 (C) 2014-2014 ying32 All Rights Reserved                           }
{                                                                             }
{ --------------------------------------------------------------------------- }
{                                                                             }
{ 备注： 需要以资源形式打包一个ico图标,然后指定资源名称即可                   }
{                                                                             }
{                                                                             }
{                                                                             }
{ *************************************************************************** }
unit FMX.ZYJ.TrayIcon;

interface

{$I 'ZYJFmx.inc'}

uses
  Winapi.Windows,
  Winapi.Messages,
  Winapi.ShellApi,
  System.SysUtils,
  System.Classes,
  FMX.Forms,
  FMX.Types,
  FMX.Platform.Win;

type
  TBalloonFlags = (bfNone = NIIF_NONE, bfInfo = NIIF_INFO, bfWarning = NIIF_WARNING, bfError = NIIF_ERROR);

  TZYJTrayIcon = class(TFmxObject)
  public const
    WM_TRAYICON_MESSAGE = WM_USER + $128;
  private
    FIcon: string;
    FHandle: HWND;
    FData: TNotifyIconData;
    FHint: string;
    FVisible: Boolean;
    FOnLClick: TNotifyEvent;
    FOnRClick: TNotifyEvent;
    FOnDbLClick: TNotifyEvent;
    FOldWndProc : Pointer;
    FBalloonHint: string;
    FBalloonTitle: string;
    FBalloonFlags: TBalloonFlags;
    FBalloonTimeout: Integer;
    procedure SetTray(AId: Cardinal);
    procedure SetIcon(Value: string);
    procedure SetHint(Value: string);
    procedure SetVisible(Value: Boolean);
    procedure UpdateShow;
    procedure SetBalloonHint(const Value: string);
    procedure SetBalloonTitle(const Value: string);
    procedure SetBalloonTimeout(const Value: Integer);
    function GetBalloonTimeout: Integer;
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ShowBalloonHint;
  published
    property Hint: string read FHint write SetHint;
    property Visible: Boolean read FVisible write SetVisible;
    property Icon: string read FIcon write SetIcon;

    property BalloonHint: string read FBalloonHint write SetBalloonHint;
    property BalloonTitle: string  read FBalloonTitle write SetBalloonTitle;
    property BalloonFlags: TBalloonFlags  read FBalloonFlags write FBalloonFlags;
    property BalloonTimeout: Integer  read GetBalloonTimeout write SetBalloonTimeout;

    property OnLClick: TNotifyEvent read FOnLClick write FOnLClick;
    property OnRClick: TNotifyEvent read FOnRClick write FOnRClick;
    property OnDbLClick: TNotifyEvent read FOnDbLClick write FOnDbLClick;
  end;

implementation

var
  uTrayIconClass : TZYJTrayIcon = nil;

function NewWinProc(hWd: HWND; uMsg: UINT; wParam: wParam; lParam: lParam)
    : LRESULT; stdcall;
begin
  case uMsg of
    TZYJTrayIcon.WM_TRAYICON_MESSAGE:
      begin
        case lParam of
          WM_LBUTTONDOWN:
            if Assigned(uTrayIconClass.FOnLClick) then uTrayIconClass.FOnLClick(uTrayIconClass);
          WM_RBUTTONDOWN:
            if Assigned(uTrayIconClass.FOnRClick) then uTrayIconClass.FOnRClick(uTrayIconClass);
          WM_LBUTTONDBLCLK:
            if Assigned(uTrayIconClass.FOnDbLClick) then uTrayIconClass.FOnDbLClick(uTrayIconClass);
        end;
        Exit(1);
      end;
  end;
  Result := CallWindowProc(uTrayIconClass.FOldWndProc, hWd, uMsg, wParam, lParam);
end;

constructor TZYJTrayIcon.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHandle := 0;
  if AOwner is TCustomForm then
  {$IFDEF DELPHIXE3UP}
    FHandle := FormToHWND(TCustomForm(AOwner));
  {$ELSE}
    FHandle := FmxHandleToHWND(TCustomForm(AOwner).Handle);
  {$ENDIF}
  FBalloonHint := '';
  FBalloonTitle := '';
  FBalloonFlags := bfNone;
  FBalloonTimeout := 5000;

  FHint := '';
  FVisible := False;
  FIcon := 'MAINICON';
  FData.cbSize := Sizeof(FData);
  FData.Wnd := FHandle;
  FData.hIcon := LoadIcon(HInstance, PChar(FIcon));
  FData.uid := FData.Wnd;
  FData.uTimeout := FBalloonTimeout;
  FData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  FData.ucallbackmessage := WM_TRAYICON_MESSAGE;
end;

destructor TZYJTrayIcon.Destroy;
begin
  if not(csDesigning in ComponentState) then
  begin
    SetTray(NIM_DELETE);
    if (uTrayIconClass <> nil) then
    begin
      if IsWindow(FHandle) and (FOldWndProc <> nil) then
        SetWindowLong(FHandle, GWL_WNDPROC, Integer(FOldWndProc));
    end;
  end;
  inherited;
end;

function TZYJTrayIcon.GetBalloonTimeout: Integer;
begin
   Result := FData.uTimeout;
end;

procedure TZYJTrayIcon.Loaded;
begin
  inherited;
  if not(csDesigning in ComponentState) then
  begin
    if uTrayIconClass = nil then
    begin
      uTrayIconClass := Self;
      if IsWindow(FHandle) then
        FOldWndProc := Pointer(SetWindowLong(FHandle, GWL_WNDPROC, Integer(@NewWinProc)));
    end;
  end;
end;

procedure TZYJTrayIcon.SetVisible(Value: Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    if not(csDesigning in ComponentState) then
    begin
      if FVisible then
        SetTray(NIM_ADD)
      else
        SetTray(NIM_DELETE);
    end;
  end;
end;

procedure TZYJTrayIcon.ShowBalloonHint;
begin
  FData.uFlags := FData.uFlags or NIF_INFO;
  FData.dwInfoFlags := Cardinal(FBalloonFlags);
  UpdateShow;
end;

procedure TZYJTrayIcon.SetBalloonHint(const Value: string);
begin
  if CompareStr(FBalloonHint, Value) <> 0 then
  begin
    FBalloonHint := Value;
    StrPLCopy(FData.szInfo, FBalloonHint, Length(FData.szInfo) - 1);
    UpdateShow;
  end;
end;

procedure TZYJTrayIcon.SetBalloonTitle(const Value: string);
begin
  if CompareStr(FBalloonTitle, Value) <> 0 then
  begin
    FBalloonTitle := Value;
    StrPLCopy(FData.szInfoTitle, FBalloonTitle, Length(FData.szInfoTitle) - 1);
    UpdateShow;
  end;
end;

procedure TZYJTrayIcon.SetBalloonTimeout(const Value: Integer);
begin
  FData.uTimeout := Value;
end;

procedure TZYJTrayIcon.SetHint(Value: string);
begin
  if CompareStr(FHint, Value) <> 0  then
  begin
    FHint := Value;
    StrPLCopy(FData.szTip, FHint, Length(FData.szTip) - 1);
    UpdateShow;
  end;
end;

procedure TZYJTrayIcon.SetIcon(Value: string);
begin
  if CompareStr(FIcon, Value) <> 0 then
  begin
    if CompareStr(FIcon, '') = 0 then
      FIcon := 'MAINICON';
    FIcon := Value;
    UpdateShow;
  end;
end;

procedure TZYJTrayIcon.SetTray(AId: Cardinal);
begin
    Shell_NotifyIcon(AId, @FData);
end;

procedure TZYJTrayIcon.UpdateShow;
begin
  if not (csDesigning in ComponentState) then
  begin
    FData.HICON := LoadIcon(HInstance, PChar(FIcon));
    if FVisible then
      SetTray(NIM_MODIFY);
  end;
end;

initialization
  RegisterClasses([TZYJTrayIcon]);


end.