一个关于系统托盘的问题

lllyb 2003-08-30 09:59:49
请问各位高手怎么样才能把程序的工具栏图标缩小到系统托盘中,象瑞星等杀毒软件中那样
...全文
85 11 打赏 收藏 转发到动态 举报
写回复
用AI写文章
11 条回复
切换为时间正序
请发表友善的回复…
发表回复
bluespy 2003-09-02
  • 打赏
  • 举报
回复
unit Unit1;

interface

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

type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
Timer1: TTimer;
open1: TMenuItem;
exit1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure open1Click(Sender: TObject);
procedure exit1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
private
procedure wndproc(var msg:tmessage);override;
{ Private declarations }
public
icondata:tnotifyicondata;
iconcount:integer;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure tform1.wndproc(var msg:tmessage);
var
p:tpoint;
begin
case msg.msg of
wm_user+1:
case msg.LParam of
wm_rbuttondown:
begin
getcursorpos(p);
popupmenu1.Popup(p.X,p.Y);
end;
WM_LBUTTONDBLCLK:
begin
form1.Show;
showwindow(application.Handle ,sw_hide);
end;
end;
end;
inherited;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
bordericons:=[bisystemmenu];
iconcount:=0;
icondata.cbSize :=sizeof(icondata);
icondata.Wnd :=handle;
icondata.uID:=100;
icondata.uFlags :=nif_message+nif_icon+nif_tip;
icondata.uCallbackMessage :=wm_user+1;
icondata.hIcon :=application.Icon.Handle ;
strpcopy(icondata.szTip,application.Title );
shell_notifyicon(nim_add,@icondata);
timer1.Interval :=1000;
timer1.Enabled :=true;
end;

procedure TForm1.open1Click(Sender: TObject);
begin
form1.Show;
showwindow(application.Handle ,sw_hide);
end;

procedure TForm1.exit1Click(Sender: TObject);
begin
shell_notifyicon(nim_delete,@icondata);
application.ProcessMessages ;
application.Terminate ;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=canone;
form1.Hide ;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
case (iconcount) of
0: icondata.hIcon :=loadicon(0, idi_application);
1: icondata.hIcon :=loadicon(0, idi_asterisk);
2: icondata.hIcon :=loadicon(0, idi_exclamation);
3: icondata.hIcon :=loadicon(0, idi_hand);
4: icondata.hIcon :=loadicon(0, idi_question);
5: icondata.hIcon :=application.Icon.Handle ;
end;
inc(iconcount);
if iconcount>5 then
iconcount:=0;
application.Title :=timetostr(now);
strpcopy(icondata.szTip ,application.Title );
shell_notifyicon(nim_modify,@icondata);
end;

end.
xxl8101 2003-09-02
  • 打赏
  • 举报
回复
到51delphi找个控件吧,
td427 2003-09-02
  • 打赏
  • 举报
回复
找个控件,轻松搞定
dawnming 2003-09-02
  • 打赏
  • 举报
回复
帮你up 一下
上海老李 2003-09-02
  • 打赏
  • 举报
回复
nit TrayBarIcon;



interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Menus, ShellApi, extctrls;

const
//自定义用户信息
WM_TRAYNOTIFY = WM_USER + 1024;
IconID = 1;

type
TCycleEvent = procedure(Sender: TObject; Current: Integer) of object;
TMainFormMinimizeEvent = procedure(Sender: TObject; var GotoTray: Boolean) of object;

TTrayIcon = class(TComponent)
private
FEnabled: Boolean;
FIcon: TIcon;
FIconVisible: Boolean;
FHint: String;
FShowHint: Boolean;
FPopupMenu: TPopupMenu;
FLeftPopup: Boolean;
FOnClick,
FOnDblClick: TNotifyEvent;
FOnCycle: TCycleEvent;
FOnMouseDown,
FOnMouseUp: TMouseEvent;
FOnMouseMove: TMouseMoveEvent;
FStartMinimized: Boolean;
FMinimizeToTray: Boolean;
HasShown: Boolean;
FClicked: Boolean;
CycleTimer: TTimer; // 图标变换
FDesignPreview: Boolean;
SettingPreview: Boolean;
FIconList: TImageList;
FCycleIcons: Boolean;
FCycleInterval: Cardinal;
IconIndex: Integer; // 当前图标索引
OldAppProc, NewAppProc: Pointer; // 过程变量
procedure SetCycleIcons(Value: Boolean);
procedure SetDesignPreview(Value: Boolean);
procedure SetCycleInterval(Value: Cardinal);
procedure TimerCycle(Sender: TObject);
procedure HandleIconMessage(var Msg: TMessage);
function InitIcon: Boolean;
procedure SetIcon(Value: TIcon);
procedure SetIconVisible(Value: Boolean);
procedure SetHint(Value: String);
procedure SetShowHint(Value: Boolean);
procedure PopupAtCursor;
procedure HookApp;
procedure UnhookApp;
procedure HookAppProc(var Message: TMessage);
protected
IconData: TNotifyIconData; // 系统托盘图标的数据结构
procedure Loaded; override;
function ShowIcon: Boolean; virtual;
function HideIcon: Boolean; virtual;
function ModifyIcon: Boolean; virtual;
procedure Click; dynamic;
procedure DblClick; dynamic;
procedure CycleIcon; dynamic;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); dynamic;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); dynamic;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
procedure DoMinimizeToTray; dynamic;
procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
public
property Handle: HWND read IconData.wnd;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ShowMainForm;
procedure HideMainForm;
procedure Refresh;
published
// 属性操作:
property DesignPreview: Boolean read FDesignPreview
write SetDesignPreview default False;
property IconList: TImageList read FIconList write FIconList;
property CycleIcons: Boolean read FCycleIcons write SetCycleIcons
default False;
property CycleInterval: Cardinal read FCycleInterval
write SetCycleInterval;
property Enabled: Boolean read FEnabled write FEnabled default True;
property Hint: String read FHint write SetHint;
property ShowHint: Boolean read FShowHint write SetShowHint;
property Icon: TIcon read FIcon write SetIcon stored True;
property IconVisible: Boolean read FIconVisible write SetIconVisible
default True;
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
property LeftPopup: Boolean read FLeftPopup write FLeftPopup
default False;
property StartMinimized: Boolean read FStartMinimized write FStartMinimized
default False; // 程序开始运行时最小化?
property MinimizeToTray: Boolean read FMinimizeToTray write FMinimizeToTray
default False; // 程序最小化时是否自动显示图标?
// 方法:
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnCycle: TCycleEvent read FOnCycle write FOnCycle;
end;

procedure Register;

implementation

constructor TTrayIcon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIconVisible := True;
FEnabled := True;
HasShown := False;
SettingPreview := False;

FIcon := TIcon.Create;
IconData.cbSize := SizeOf(TNotifyIconData);
// 设置托盘图标回调函数
IconData.wnd := AllocateHWnd(HandleIconMessage);
// 设置图标ID
IconData.uId := IconID;
// 设置 图标,消息句柄,提示
IconData.uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
// 当鼠标在图标上有动作时发出的消息
IconData.uCallbackMessage := WM_TRAYNOTIFY;

CycleTimer := TTimer.Create(Self);
CycleTimer.Enabled := False;
CycleTimer.Interval := FCycleInterval;
CycleTimer.OnTimer := TimerCycle;

if not (csDesigning in ComponentState) then
HookApp;
end;






上海老李 2003-09-02
  • 打赏
  • 举报
回复
nit TrayBarIcon;



interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Menus, ShellApi, extctrls;

const
//自定义用户信息
WM_TRAYNOTIFY = WM_USER + 1024;
IconID = 1;

type
TCycleEvent = procedure(Sender: TObject; Current: Integer) of object;
TMainFormMinimizeEvent = procedure(Sender: TObject; var GotoTray: Boolean) of object;

TTrayIcon = class(TComponent)
private
FEnabled: Boolean;
FIcon: TIcon;
FIconVisible: Boolean;
FHint: String;
FShowHint: Boolean;
FPopupMenu: TPopupMenu;
FLeftPopup: Boolean;
FOnClick,
FOnDblClick: TNotifyEvent;
FOnCycle: TCycleEvent;
FOnMouseDown,
FOnMouseUp: TMouseEvent;
FOnMouseMove: TMouseMoveEvent;
FStartMinimized: Boolean;
FMinimizeToTray: Boolean;
HasShown: Boolean;
FClicked: Boolean;
CycleTimer: TTimer; // 图标变换
FDesignPreview: Boolean;
SettingPreview: Boolean;
FIconList: TImageList;
FCycleIcons: Boolean;
FCycleInterval: Cardinal;
IconIndex: Integer; // 当前图标索引
OldAppProc, NewAppProc: Pointer; // 过程变量
procedure SetCycleIcons(Value: Boolean);
procedure SetDesignPreview(Value: Boolean);
procedure SetCycleInterval(Value: Cardinal);
procedure TimerCycle(Sender: TObject);
procedure HandleIconMessage(var Msg: TMessage);
function InitIcon: Boolean;
procedure SetIcon(Value: TIcon);
procedure SetIconVisible(Value: Boolean);
procedure SetHint(Value: String);
procedure SetShowHint(Value: Boolean);
procedure PopupAtCursor;
procedure HookApp;
procedure UnhookApp;
procedure HookAppProc(var Message: TMessage);
protected
IconData: TNotifyIconData; // 系统托盘图标的数据结构
procedure Loaded; override;
function ShowIcon: Boolean; virtual;
function HideIcon: Boolean; virtual;
function ModifyIcon: Boolean; virtual;
procedure Click; dynamic;
procedure DblClick; dynamic;
procedure CycleIcon; dynamic;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); dynamic;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); dynamic;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
procedure DoMinimizeToTray; dynamic;
procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
public
property Handle: HWND read IconData.wnd;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ShowMainForm;
procedure HideMainForm;
procedure Refresh;
published
// 属性操作:
property DesignPreview: Boolean read FDesignPreview
write SetDesignPreview default False;
property IconList: TImageList read FIconList write FIconList;
property CycleIcons: Boolean read FCycleIcons write SetCycleIcons
default False;
property CycleInterval: Cardinal read FCycleInterval
write SetCycleInterval;
property Enabled: Boolean read FEnabled write FEnabled default True;
property Hint: String read FHint write SetHint;
property ShowHint: Boolean read FShowHint write SetShowHint;
property Icon: TIcon read FIcon write SetIcon stored True;
property IconVisible: Boolean read FIconVisible write SetIconVisible
default True;
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
property LeftPopup: Boolean read FLeftPopup write FLeftPopup
default False;
property StartMinimized: Boolean read FStartMinimized write FStartMinimized
default False; // 程序开始运行时最小化?
property MinimizeToTray: Boolean read FMinimizeToTray write FMinimizeToTray
default False; // 程序最小化时是否自动显示图标?
// 方法:
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnCycle: TCycleEvent read FOnCycle write FOnCycle;
end;

procedure Register;

implementation

constructor TTrayIcon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIconVisible := True;
FEnabled := True;
HasShown := False;
SettingPreview := False;

FIcon := TIcon.Create;
IconData.cbSize := SizeOf(TNotifyIconData);
// 设置托盘图标回调函数
IconData.wnd := AllocateHWnd(HandleIconMessage);
// 设置图标ID
IconData.uId := IconID;
// 设置 图标,消息句柄,提示
IconData.uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
// 当鼠标在图标上有动作时发出的消息
IconData.uCallbackMessage := WM_TRAYNOTIFY;

CycleTimer := TTimer.Create(Self);
CycleTimer.Enabled := False;
CycleTimer.Interval := FCycleInterval;
CycleTimer.OnTimer := TimerCycle;

if not (csDesigning in ComponentState) then
HookApp;
end;






sundayzhao 2003-09-02
  • 打赏
  • 举报
回复
最近用控件
lllyb 2003-09-02
  • 打赏
  • 举报
回复
结帖了
songqianyong 2003-08-30
  • 打赏
  • 举报
回复
我只知道把应用程序放在下面
uses
。。。 shellapi。。。。;
private
{ Private declarations }
lpData:PNotifyIconData;

procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
procedure WMBarIcon(var Message: TMessage) ;message WM_BARICON;
function adoconnected(Sender: TObject):boolean;

procedure Tjs_server.WMSysCommand(var Message: TMessage);

begin
if (Message.WParam =SC_MINIMIZE) or (Message.WParam =SC_CLOSE ) then
begin
lpData := new(PNotifyIconDataA);
lpData.cbSize := 88;
lpData.Wnd := self.Handle;
lpData.hIcon := application.icon.Handle;
lpData.uCallbackMessage := WM_BARICON;
lpData.uID :=0;
lpData.szTip := '¹ÜÀíϵͳ·þÎñÆ÷¶Ë';
lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Shell_NotifyIcon(NIM_ADD,lpData);
hide;
end;



end;
procedure Tjs_server.WMBarIcon(var Message: TMessage);
begin
{ if (Message.LParam = WM_LBUTTONDOWN) then
begin
if InputBox('µÇ¼', 'ÇëÊäÈë¿ÚÁî ', '')<>'12345' then exit ;
Shell_NotifyIcon(NIM_DELETE,lpData);
dispose(lpData);
show;
end;}
if (Message.LParam = WM_LBUTTONDOWN) then
begin
Shell_NotifyIcon(NIM_DELETE,lpData);
dispose(lpData);
show;
end;
if (Message.LParam = WM_RBUTTONDOWN) then
begin
PopupMenu1.Popup(Mouse.CursorPos.X,Mouse.CursorPos.Y);
end;
end;

程序上考下来的,自己加个PopupMenu1就可以象那样超做了
tiexinliu 2003-08-30
  • 打赏
  • 举报
回复
又一个实现系统托盘图表的源码的例子,很简单的,down下来看看就明白了,这个问题被问过N次了:
http://www.8860.net/delphicode/dispdoc.asp?id=64
huojiehai 2003-08-30
  • 打赏
  • 举报
回复
http://www.hongen.com/pc/program/apitutor/api0012/api01.htm

5,379

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧