不多说了 直接上代码........有任何问题请给我邮件....

//  ***************************************************************************
//
// FMX.Win 平台下托盘
//
// 版本: 1.0
// 作者: 堕落恶魔
// 修改日期: 2015-06-26
// QQ: 17948876
// E-mail: lzl_17948876@hotmail.com
// 博客: http://www.cnblogs.com/lzl_17948876/
//
// !!! 若有修改,请通知作者,谢谢合作 !!!
//
// ---------------------------------------------------------------------------
//
// 说明:
// 1.默认图标为程序图标
// 2.需要使用动态图标时, 要先传入一个动态图标句柄数组
//
// *************************************************************************** unit FMX.Win.TrayIcon; interface uses
Winapi.Windows, Winapi.Messages, Winapi.ShellApi,
System.SysUtils, System.Classes, System.UITypes,
FMX.Forms, FMX.Types, FMX.Platform.Win, FMX.MultiResBitmap, FMX.Menus; const
WM_SYSTEM_TRAY_MESSAGE = WM_USER + $; type
TBalloonFlags = (bfNone = NIIF_NONE, bfInfo = NIIF_INFO,
bfWarning = NIIF_WARNING, bfError = NIIF_ERROR); [RootDesignerSerializerAttribute('', '', False)]
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
TTrayIcon = class(TComponent)
private
class var
RM_TaskbarCreated: DWORD;
private
FAnimate: Boolean;
FBalloonHint: string;
FBalloonTitle: string;
FBalloonFlags: TBalloonFlags;
FIsClicked: Boolean;
FData: TNotifyIconData;
FIcon: HICON;
FCurrentIconIndex: UInt8;
FAnimateIconList: TArray<HICON>;
FPopupMenu: TPopupMenu;
FTimer: TTimer;
FHint: String;
FVisible: Boolean;
FOnBalloonClick: TNotifyEvent;
FOnClick: TNotifyEvent;
FOnDblClick: TNotifyEvent;
FOnMouseDown: TMouseEvent;
FOnMouseMove: TMouseMoveEvent;
FOnMouseUp: TMouseEvent;
FOnAnimate: TNotifyEvent;
FDefaultIcon: HICON;
function GetData: TNotifyIconData;
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetHint(const Value: string);
function GetAnimateInterval: Cardinal;
procedure SetAnimateInterval(Value: Cardinal);
procedure SetAnimate(Value: Boolean);
procedure SetBalloonHint(const Value: string);
function GetBalloonTimeout: Integer;
procedure SetBalloonTimeout(Value: Integer);
procedure SetBalloonTitle(const Value: string);
procedure SetVisible(Value: Boolean); virtual;
procedure WindowProc(var Message: TMessage); virtual;
procedure DoOnAnimate(Sender: TObject); virtual;
property Data: TNotifyIconData read GetData;
function Refresh(Message: Integer): Boolean; overload;
public
constructor Create(Owner: TComponent); override;
destructor Destroy; override;
procedure Refresh; overload;
procedure SetDefaultIcon;
procedure ShowBalloonHint; virtual;
procedure SetAnimateIconList(AList: TArray<HICON>);
property DefaultIcon: HICON read FDefaultIcon write FDefaultIcon;
published
property Animate: Boolean read FAnimate write SetAnimate default False;
property AnimateInterval: Cardinal read GetAnimateInterval write SetAnimateInterval default ;
property Hint: string read FHint write SetHint;
property BalloonHint: string read FBalloonHint write SetBalloonHint;
property BalloonTitle: string read FBalloonTitle write SetBalloonTitle;
property BalloonTimeout: Integer read GetBalloonTimeout write SetBalloonTimeout default ;
property BalloonFlags: TBalloonFlags read FBalloonFlags write FBalloonFlags default bfNone;
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
property Visible: Boolean read FVisible write SetVisible default False;
property OnBalloonClick: TNotifyEvent read FOnBalloonClick write FOnBalloonClick;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnAnimate: TNotifyEvent read FOnAnimate write FOnAnimate;
end; procedure Register; implementation { TTrayIcon} constructor TTrayIcon.Create(Owner: TComponent);
begin
inherited;
FAnimate := False;
FBalloonFlags := bfNone;
BalloonTimeout := ;
FTimer := TTimer.Create(nil);
FVisible := False;
FIsClicked := False;
FTimer.Enabled := False;
FTimer.OnTimer := DoOnAnimate;
FTimer.Interval := ;
SetLength(FAnimateIconList, );
FCurrentIconIndex := ;
FDefaultIcon := LoadIcon(HInstance, PChar('MAINICON'));
FIcon := FDefaultIcon; if not (csDesigning in ComponentState) then
begin
FData.cbSize := FData.SizeOf;
FData.Wnd := AllocateHwnd(WindowProc);
StrPLCopy(FData.szTip, Application.Title, Length(FData.szTip) - );
FData.uID := FData.Wnd;
FData.uTimeout := ;
FData.hIcon := FDefaultIcon;
FData.uFlags := NIF_ICON or NIF_MESSAGE;
FData.uCallbackMessage := WM_SYSTEM_TRAY_MESSAGE;
if Length(Application.Title) > then
FData.uFlags := FData.uFlags or NIF_TIP;
Refresh;
end;
end; destructor TTrayIcon.Destroy;
begin
if not (csDesigning in ComponentState) then
begin
Refresh(NIM_DELETE);
DeallocateHWnd(FData.Wnd);
end;
FTimer.Free;
inherited;
end; procedure TTrayIcon.SetVisible(Value: Boolean);
begin
if FVisible <> Value then
begin
FVisible := Value;
if (not FAnimate) or (FAnimate and (Length(FAnimateIconList) = )) then
SetDefaultIcon; if not (csDesigning in ComponentState) then
begin
if FVisible then
Refresh(NIM_ADD)
else if not (csLoading in ComponentState) then
begin
if not Refresh(NIM_DELETE) then
raise EOutOfResources.Create('Cannot remove shell notification icon');
end;
if FAnimate then
FTimer.Enabled := Value;
end;
end;
end; procedure TTrayIcon.SetHint(const Value: string);
begin
if CompareStr(FHint, Value) <> then
begin
FHint := Value;
StrPLCopy(FData.szTip, Hint, Length(FData.szTip) - );
if Length(Hint) > then
FData.uFlags := FData.uFlags or NIF_TIP
else
FData.uFlags := FData.uFlags and not NIF_TIP;
Refresh;
end;
end; function TTrayIcon.GetAnimateInterval: Cardinal;
begin
Result := FTimer.Interval;
end; procedure TTrayIcon.SetAnimateIconList(AList: TArray<HICON>);
begin
Animate := False;
FAnimateIconList := AList;
end; procedure TTrayIcon.SetAnimateInterval(Value: Cardinal);
begin
FTimer.Interval := Value;
end; procedure TTrayIcon.SetAnimate(Value: Boolean);
begin
if FAnimate <> Value then
begin
FAnimate := Value;
if not (csDesigning in ComponentState) then
begin
if (Length(FAnimateIconList) > ) and Visible then
FTimer.Enabled := Value;
if (not FAnimate) and (Length(FAnimateIconList) <> ) then
FIcon := FAnimateIconList[FCurrentIconIndex];
end;
end;
end; { Message handler for the hidden shell notification window. Most messages
use WM_SYSTEM_TRAY_MESSAGE as the Message ID, with WParam as the ID of the
shell notify icon data. LParam is a message ID for the actual message, e.g.,
WM_MOUSEMOVE. Another important message is WM_ENDSESSION, telling the shell
notify icon to delete itself, so Windows can shut down. Send the usual events for the mouse messages. Also interpolate the OnClick
event when the user clicks the left button, and popup the menu, if there is
one, for right click events. } [SecurityPermission(SecurityAction.InheritanceDemand, UnmanagedCode=True)]
procedure TTrayIcon.WindowProc(var Message: TMessage); { Return the state of the shift keys. }
function ShiftState: TShiftState;
begin
Result := [];
if GetKeyState(VK_SHIFT) < then
Include(Result, ssShift);
if GetKeyState(VK_CONTROL) < then
Include(Result, ssCtrl);
if GetKeyState(VK_MENU) < then
Include(Result, ssAlt);
end; var
Point: TPoint;
Shift: TShiftState;
begin
case Message.Msg of
WM_QUERYENDSESSION: Message.Result := ;
WM_ENDSESSION:
if TWmEndSession(Message).EndSession then
Refresh(NIM_DELETE);
WM_SYSTEM_TRAY_MESSAGE:
begin
case Int64(Message.lParam) of
WM_MOUSEMOVE:
if Assigned(FOnMouseMove) then
begin
Shift := ShiftState;
GetCursorPos(Point);
FOnMouseMove(Self, Shift, Point.X, Point.Y);
end;
WM_LBUTTONDOWN:
begin
if Assigned(FOnMouseDown) then
begin
Shift := ShiftState + [ssLeft];
GetCursorPos(Point);
FOnMouseDown(Self, TMouseButton.mbLeft, Shift, Point.X, Point.Y);
end;
FIsClicked := True;
end;
WM_LBUTTONUP:
begin
Shift := ShiftState + [ssLeft];
GetCursorPos(Point);
if FIsClicked and Assigned(FOnClick) then
begin
FOnClick(Self);
FIsClicked := False;
end;
if Assigned(FOnMouseUp) then
FOnMouseUp(Self, TMouseButton.mbLeft, Shift, Point.X, Point.Y);
end;
WM_RBUTTONDOWN:
if Assigned(FOnMouseDown) then
begin
Shift := ShiftState + [ssRight];
GetCursorPos(Point);
FOnMouseDown(Self, TMouseButton.mbRight, Shift, Point.X, Point.Y);
end;
WM_RBUTTONUP:
begin
Shift := ShiftState + [ssRight];
GetCursorPos(Point);
if Assigned(FOnMouseUp) then
FOnMouseUp(Self, TMouseButton.mbRight, Shift, Point.X, Point.Y);
if Assigned(FPopupMenu) then
begin
SetForegroundWindow(FormToHWND(Application.MainForm));
Application.ProcessMessages;
FPopupMenu.PopupComponent := Owner;
FPopupMenu.Popup(Point.x, Point.y);
end;
end;
WM_LBUTTONDBLCLK, WM_MBUTTONDBLCLK, WM_RBUTTONDBLCLK:
if Assigned(FOnDblClick) then
FOnDblClick(Self);
WM_MBUTTONDOWN:
if Assigned(FOnMouseDown) then
begin
Shift := ShiftState + [ssMiddle];
GetCursorPos(Point);
FOnMouseDown(Self, TMouseButton.mbMiddle, Shift, Point.X, Point.Y);
end;
WM_MBUTTONUP:
if Assigned(FOnMouseUp) then
begin
Shift := ShiftState + [ssMiddle];
GetCursorPos(Point);
FOnMouseUp(Self, TMouseButton.mbMiddle, Shift, Point.X, Point.Y);
end;
NIN_BALLOONHIDE, NIN_BALLOONTIMEOUT:
FData.uFlags := FData.uFlags and not NIF_INFO;
NIN_BALLOONUSERCLICK:
if Assigned(FOnBalloonClick) then
FOnBalloonClick(Self);
end;
end;
else
if (Cardinal(Message.Msg) = RM_TaskBarCreated) and Visible then
Refresh(NIM_ADD);
end;
end; procedure TTrayIcon.Refresh;
begin
if not (csDesigning in ComponentState) then
begin
FData.hIcon := FIcon;
if Visible then
Refresh(NIM_MODIFY);
end;
end; function TTrayIcon.Refresh(Message: Integer): Boolean;
//var
// SavedTimeout: Integer;
begin
Result := Shell_NotifyIcon(Message, @FData);
{ if Result then
begin
SavedTimeout := FData.uTimeout;
FData.uTimeout := 4;
Result := Shell_NotifyIcon(NIM_SETVERSION, FData);
FData.uTimeout := SavedTimeout;
end;}
end; procedure TTrayIcon.DoOnAnimate(Sender: TObject);
var
nAnimateIconCount: UInt8;
begin
if Assigned(FOnAnimate) then
FOnAnimate(Self);
nAnimateIconCount := Length(FAnimateIconList);
if (nAnimateIconCount > ) and (FCurrentIconIndex < nAnimateIconCount - ) then
FCurrentIconIndex := FCurrentIconIndex +
else
FCurrentIconIndex := ;
FIcon := FAnimateIconList[FCurrentIconIndex];
Refresh;
end; procedure TTrayIcon.SetBalloonHint(const Value: string);
begin
if CompareStr(FBalloonHint, Value) <> then
begin
FBalloonHint := Value;
StrPLCopy(FData.szInfo, FBalloonHint, Length(FData.szInfo) - );
Refresh(NIM_MODIFY);
end;
end; procedure TTrayIcon.SetDefaultIcon;
begin
FIcon := FDefaultIcon;
Refresh;
end; procedure TTrayIcon.SetBalloonTimeout(Value: Integer);
begin
FData.uTimeout := Value;
end; function TTrayIcon.GetBalloonTimeout: Integer;
begin
Result := FData.uTimeout;
end; function TTrayIcon.GetData: TNotifyIconData;
begin
Result := FData;
end; procedure TTrayIcon.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (AComponent = FPopupMenu) and (Operation = opRemove) then
FPopupMenu := nil;
end; procedure TTrayIcon.ShowBalloonHint;
begin
FData.uFlags := FData.uFlags or NIF_INFO;
FData.dwInfoFlags := Cardinal(FBalloonFlags);
Refresh(NIM_MODIFY);
end; procedure TTrayIcon.SetBalloonTitle(const Value: string);
begin
if CompareStr(FBalloonTitle, Value) <> then
begin
FBalloonTitle := Value;
StrPLCopy(FData.szInfoTitle, FBalloonTitle, Length(FData.szInfoTitle) - );
Refresh(NIM_MODIFY);
end;
end; procedure Register;
begin
RegisterComponents('Others', [TTrayIcon]);
end; initialization
GroupDescendentsWith(TTrayIcon, FMX.Forms.TForm); end.

一个支持FMX.Win框架的托盘控件的更多相关文章

  1. 开源框架之TAB控件

    我的开源框架之TAB控件   需求 (1)支持iframe.html.json格式的tab内容远程请求 (2)支持动态添加tab (3)支持远程加载完成监听,支持tab激活事件监听 (4)支持relo ...

  2. 精通 WPF UI Virtualization (提升 OEA 框架中 TreeGrid 控件的性能)

    原文:精通 WPF UI Virtualization (提升 OEA 框架中 TreeGrid 控件的性能) 本篇博客主要说明如何使用 UI Virtualization(以下简称为 UIV) 来提 ...

  3. QT 创建一个具有复选功能的下拉列表控件

    最近研究了好多东西,前两天突然想做一个具有复选功能的下拉列表框.然后在网上"学习"了很久之后,终于发现了一个可以用的,特地发出来记录一下. 一.第一步肯定是先创建一个PROJECT ...

  4. Android 自定义支持快速搜索筛选的选择控件(一)

    Android 自定义支持快速搜索筛选的选择控件 项目中遇到选择控件选项过多,需要快速查找匹配的情况. 做了简单的Demo,效果图如下: 源码地址:https://github.com/whieenz ...

  5. 一个Demo让你掌握Android所有控件

    原文:一个Demo让你掌握Android所有控件 本文是转载收藏,侵删,出处:"安卓巴士"      下面给出实现各个组件的源代码: 1.下拉框实现--Spinner packag ...

  6. zui框架配置日期控件只显示年月

    zui框架配置日期控件datetimepicker只显示年月 <!DOCTYPE html> <head> <script src="~/Scripts/jqu ...

  7. C# Winform下一个热插拔的MIS/MRP/ERP框架(通用控件)

    一直对商业控件不感冒, 结合日常工作, 我写了几个常用控件. 一.下拉框控件(仿Access下拉框:F4下拉,自动输入,支持单/多列显示),可在Datagridview中使用. 1.常规: 2.Dat ...

  8. Nova PhoneGap框架 第九章 控件

    我们的框架中也提供了一些常用的控件,这些控件大多都依赖于我们的框架,也正是在我们的框架下才使得实现这些控件的变得更简单.但是我们的框架是不依赖与这些控件的,如果你用不上这些控件,你完全可以把相关的代码 ...

  9. 【JavaScript】EasyUI框架的Dialog控件根据浏览器分辨率自动调节宽高

    序: 如果单独一个或几个Dialog控件修改成根据浏览器可视界面自动调整高.宽很容易仅仅是一个量变的过程,但如果大量页面都引入了Dialog控件,修改起来是一个很消耗体力的工作.所以接到任务后第一想法 ...

随机推荐

  1. Mac 显示 Finder 隐藏文件

    显示Mac隐藏文件的命令:defaults write com.apple.finder AppleShowAllFiles -bool true 隐藏Mac隐藏文件的命令:defaults writ ...

  2. ArrayList和Vector以及synchronizedList

    ArrayList和Vector都是使用数组方式存储数据 区别大概就是Vector本身所有方法都是用synchronized修饰的,所以线程安全,而ArrayList没有 还有一个区别就是新增元素的时 ...

  3. three.js右手坐标系, 显示和线条

    1.右手坐标系 Threejs使用的是右手坐标系,这源于opengl默认情况下,也是右手坐标系.下面是右手坐标系的图例,如果对这个概念不理解,可以百度一下,我保证你伸出手比划的那一瞬间你就明白了,如果 ...

  4. Modify a Stored Procedure using SQL Server Management Studio

    In Object Explorer, connect to an instance of Database Engine and then expand that instance. Expand  ...

  5. BZOJ3868 : The only survival

    枚举每个点到$1$的距离,若$>k$则视为$k+1$,那么$d_1=1,d_n=k$. 对于$i$,如果$1\leq d_i\leq k$,则一定要存在一条边长度为$d_i-d_j$,且其他边长 ...

  6. 读书笔记:javascript高级技巧(二)

    四.惰性载入函数 因为浏览器兼容的原因,我们的javascript代码会有大量的if语句,将执行引导到正确的代码中,看如下函数: function createXHR(){ if (typeof XM ...

  7. CF 9D. How many trees?(dp)

    题目链接 以前做过类似的,USACO,2.3,开始数组开小了,导致数据乱了,然后超数据范围了,.. #include <cstdio> #include <iostream> ...

  8. linux ps指令

    ps axjf <==連同部分程序樹狀態

  9. PHP zendframework phpunit 深入

    安装包管理 curl -sS https://getcomposer.org/installer | /usr/local/php/bin/php 将证书安装到 ~$ mkdir ~/tools/ht ...

  10. PHP slim restfull框架nginx 配置

    http://docs.slimframework.com/ 下载地址这个东西很不错,照到官方的例子做 <?php require 'vendor/autoload.php'; $app = n ...