|
在网上看到不少系统托盘的控件，有的写的东西太多，用不上，但大家似乎都没有解决一个问题，那就是单击和双击怎么处理的问题，所以自己也写了一个贴出来。希望大家能多提意见，如果哪个地方有不对的地方请指出，但千万别骂。
这个控件很简单，可以用 Show 的方法显示图标，用 Hide 的方法来隐藏图标，可以处理单击和双击的事件，还有一个 Popup 菜单（在点击右键的时候弹出）。你也可以用Icon的属性更改图标，可以用Tip属性更改提示。
这个控件的 OnClick 和 OnDblClick 处理的方法是这样的，如果只设置 OnClick 则是立即响应，如果这两者同时定义，则双击时只会响应 OnDblClick 而不会像普通控件那样，两者都响应。
{*******************************************************
Borland Delphi 可视化组件库 系统托盘 Ver 1.0
作者 ： 黄涛 Hunter@Shentong.com.cn
2004年5月31日
*******************************************************}
unit NotifyIcon;
interface
uses
Messages, Windows, SysUtils, Classes, shellapi,StrUtils,
Forms, Menus, Graphics;
const NotifyMsg = WM_USER+1; //托盘自定义消息
type
TNotifyIcon = class(TComponent) //自TComponent 派生
private
FData: TnotifyIconData; //系统托盘所需的数据
FEnabled: Bool;
FOnClick: TNotifyEvent;
FOnDblClick: TNotifyEvent;
FPopupMenu: TPopupMenu;
FIcon: TIcon; //托盘图标
FTimer: Bool;
FDblClickTime: Cardinal ;
procedure SetEnabled(Flag: Bool);
procedure SetIcon(h: TICON);
procedure SetTip(s: string);
function GetTip: string;
procedure WndProc(var Msg: TMessage);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Show; //显标图标
procedure Hide; //隐藏图标
published
property Handle: HWND read FData.Wnd; //托盘的句柄
property Enabled : Bool read FEnabled Write SetEnabled default False; //显示或隐藏
property OnClick : TNotifyEvent read FOnClick Write FOnClick; //单击左键时响应
property OnDblClick : TNotifyEvent read FOnDblClick Write FOnDblClick; //双击左键时响应
property PopupMenu : TPopupMenu read FPopupMenu Write FPopupMenu; //单击右键时响应，弹出菜单
property Icon : TICON read FIcon Write SetIcon; // 图标
property Tip : String read GetTip write settip ; //提示
end;
procedure Register;
implementation
constructor TNotifyIcon.Create(AOwner: TComponent); //构造函数，初始化变量
begin
inherited Create(AOwner);
FTimer := False;
FDblClickTime := GetDoubleClickTime; //获取双击时间间隔
FEnabled := False;
FData.Wnd := Classes.AllocateHWnd(WndProc); // 设置回调函数
FData.cbSize := sizeof(TNotifyIconData);
FData.uCallbackMessage :=NotifyMsg;
FData.szTip := '''''''';
FData.uID := UINT(self);
FData.uFlags := nif_icon + nif_tip + nif_message;
Icon := application.Icon ; //默认初始化图标为主程序图标
end;
destructor TNotifyIcon.Destroy; //析构函数
begin
if FEnabled then Enabled :=false;
Classes.DeallocateHWnd(FData.Wnd);
inherited Destroy;
end;
procedure TNotifyIcon.SetIcon(h:TICON) ; //设置图标
begin
FIcon := h;
FData.hIcon := FIcon.Handle ;
if Enabled then Shell_NotifyIcon(NIM_MODIFY,@FData);
end;
procedure TNotifyIcon.SetTip(s:string); //设置提示语
begin
if length(s)>63 then s:=midstr(s,1,63); //最长为64字节，所以超过63字节需要截断
strcopy(Fdata.szTip ,pchar(s));
if Enabled then Shell_NotifyIcon(NIM_MODIFY,@FData);
end;
function TNotifyIcon.GetTip :string; //获取提示语
begin
Result := Fdata.sztip;
end;
procedure TNotifyIcon.Show ; //在托盘显示图标
begin
Enabled :=True;
end;
procedure TNotifyIcon.Hide ; //隐藏图标
begin
Enabled :=False;
end;
procedure TNotifyIcon.SetEnabled(Flag:Bool) ; //显示或隐藏图标
begin
if Flag = Fenabled then exit;
if Flag then shell_notifyicon(NIM_ADD,@FData)
else shell_notifyicon(NIM_Delete,@FData);
FEnabled := not FEnabled;
end;
procedure TNotifyIcon.WndProc(var Msg: TMessage) ; //回调函数
var p: TPoint;
begin
if Msg.Msg = NotifyMsg then begin
case msg.LParam of
WM_LBUTTONUP:begin //左键弹起，如果只定义OnClick 则立即响应
if assigned(FOn [1] [2] 下一页
没有相关教程
| 
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
