系统托盘(80分)

  • 主题发起人 主题发起人 zhong_gd
  • 开始时间 开始时间
Z

zhong_gd

Unregistered / Unconfirmed
GUEST, unregistred user!
我的一个窗口要用系统托盘实现。我已经可以实现了系统托盘的大部分功能,但每次Form Show后,都需要点击最小化才能最小化到托盘那。我想一运行进程后,就最小化!如何实现?
 
打开dpr文件(即工程文件),找到Application.Run这句,在其上面加一句Application.ShowMainForm := False;
即可。可参考现有的已经很成熟的任务托盘控件,如TCoolTrayIcon(www.2ccc.com上有下载).
 
在窗口的onshow事件中发送消息
SendMessage(hwnd,WM_COMMAND,SC_ICON,0); //如果不对,修改 sc_icon ,查查资料
(当然你是在WM_COMMAND 下的 SC_ICON 消息下注册的系统拖盘)
可能是这个吧!你可以试一下,这种方法绝对可行的!我的程序就是这样实现的!!
 
SendMessage(hwnd,WM_COMMAND,SC_ICON,0);
报错呀!
[Error] Unit1.pas(217): '(' expected but ',' found
[Error] Unit1.pas(217): Statement expected, but expression of type 'Integer' found
 
zqw0117: 可以实现不显示窗口,但没有最小化到托盘上!
 
Application.ShowMainForm := False 前面朋友说的这个就可以了。
 
[red]可参考现有的已经很成熟的任务托盘控件,如TCoolTrayIcon(www.2ccc.com上有下载).[/red]
 
我已经写大部分代码了。不想再去下载控件!以下是我的代码,我想在点击窗口标题的‘X’按钮时,不关闭窗口,而最小化窗口。怎么搞呀?

unit Unit1;

interface

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

const
ICON_ID = 100; //ICON的ID标志 (随便定义)
{自定义消息,当小图标捕捉到鼠标事件时Windows向回调函数发送此消息}
MY_ICONEVENT = WM_USER + 100;//自定义ICON事件消息

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
Edit1: TEdit;
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
private
{ Private declarations }

NormalIcon,DisabledIcon:TIcon; //正常和失效两种情况下图标
Status:Boolean;//定义标志是“允许使用”还是“禁止使用”
Procedure InstallIcon;//声明过程InstallIcon用来在托盘中安装图标
Procedure ChangeIcon(s:Boolean);//声明过程ChangeIcon用于改变本程序以托盘中的图标
Procedure UnInstallIcon;//声明过程UnInstallIcon用于卸载托盘中的图标
//捕捉自定义消息MY_ICONEVENT的过程IconOnClick的声明
Procedure IconOnClick(var Msg:Tmessage);message MY_ICONEVENT;

procedure OnMin(var msg : TMessage);message WM_SYSCOMMAND;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button2Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
UnInstallIcon;
//NormalIcon.Free;
//DisabledIcon.Free;
Release;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage('系统托盘程序!');
//SendMessage(Edit1.Handle,EM_LINESCROLL,5,1);
end;

Procedure TForm1.ChangeIcon(s:Boolean);//过程ChangeIcon用于改变本程序以托盘中的图标
var
IconData:TNotifyIconData;
begin
IconData.cbSize := SizeOf(IconData);
IconData.Wnd := Handle;
IconData.uID := ICON_ID;
if s=False then //禁止使用
begin
IconData.hIcon := DisabledIcon.Handle;
Status := False;
end
else
begin
IconData.hIcon := Normalicon.Handle;
Status := True;
end;
IconData.uFlags := NIF_ICON;
Shell_NotifyIcon(NIM_MODIFY,@IconData);
end;


//处理鼠标在托盘中对应的图标上的单击事件
Procedure TForm1.IconOnClick(var Msg:Tmessage);
var
p:TPoint;
begin
if ((Msg.lParam=WM_LBUTTONDOWN) and (Status=True)) then
//如果按下的是鼠标左键,并且允许显示,则显示窗体
begin
Form1.Visible := True;
SetForegroundWindow(Handle);
end;
if (Msg.lParam=WM_RBUTTONDOWN) then
//如果按下的是鼠标右键,则显示弹出菜单
begin

GetCursorPos(p);
PopupMenu1.Popup(p.x,p.y);
//ShowWindow(Application.Handle,SW_SHOWNORMAL );

end;
end;


//过程InstallIcon用来在托盘中安装图标
Procedure TForm1.InstallIcon;
var
IconData:TNotifyIconData;
begin
NormalIcon := TIcon.Create;
DisabledIcon := TIcon.Create;
//允许状态下的图标
//NormalIcon := application.Icon;
NormalIcon.LoadFromFile('pictureg.ico');
//禁止状态下的图标
DisabledIcon.LoadFromFile('pictureg.ico');
//DisabledIcon := application.Icon;
IconData.cbSize := SizeOf(IconData);
IconData.Wnd := Handle;
IconData.UID := ICON_ID;
IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
IconData.uCallBackMessage := MY_ICONEVENT;
//IconData.hIcon := NormalIcon.Handle;
IconData.hIcon := application.Icon.Handle;
//鼠标悬在托盘中对应的图标上时的提示信息
IConData.szTip := '测试';
Shell_NotifyIcon(NIM_ADD,@IconData);
end;

//过程UnInstallIcon用于卸载托盘中的图标
Procedure TForm1.UnInstallIcon;
var
Icondata : TNotifyIconData;
begin

IconData.cbSize := SizeOf(IconData);
IconData.Wnd := Handle;
IconData.uID := ICON_ID;
Shell_NotifyIcon(NIM_DELETE,@IconData);
end;

procedure TForm1.OnMin(var msg: TMessage);
begin
if (msg.WParam = SC_MINIMIZE) then
begin
Status := True;
//安装图标
InstallIcon;
//改变图标为Normal状态
//ChangeIcon(true);
//隐藏主窗体
ShowWindow(Application.Handle,SW_HIDE);
//在托盘中不显示程序图标
SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
Form1.Visible := False;
end;
inherited;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
//Form1.width := 0;
//Form1.Height := 0;
//ShowWindow(Application.Handle,SW_HIDE);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Status := True;
//安装图标
InstallIcon;
//改变图标为Normal状态
//ChangeIcon(true);
//隐藏主窗体
ShowWindow(Application.Handle,SW_HIDE);
//在托盘中不显示程序图标
SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
Form1.Visible := False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//Form1 := TForm1.CreateParented(GetDesktopWindow);
//form1.Brush.Style:=bsclear;

end;

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

procedure TForm1.N2Click(Sender: TObject);
begin
Form1.Visible := true;
//ShowWindow(Application.Handle,SW_RESTORE);
SetForegroundWindow(Handle);
end;

end.
 
用TNotifyIconData
 
大家帮我看看代码,怎么修改代码 才能实现:1、一运行应用时,就实现最小化到托盘上
2、点击窗口标题的‘X’按钮时,不关闭窗口,而最小化窗口
 
1。那你就发送 SC_MINIMIZE消息不就可以了吗?
Sendmessage(hwnd,WM_SYSCOMMAND,SC_MINIMIZE,0);
2。截获 SC_Close 消息 最小化拖盘就行了!
onmin中
if (msg.WParam = SC_MINIMIZE ) 改为
if ((msg.wParam=SC_MINIMIZE) or (msg.wParma=SC_CLOSE)) 不就OK了!?
 
你可以参考一下这个:
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := false;
if not CanClose then
begin
Hide;
end;
end;
 
if (msg.WParam = SC_MINIMIZE ) 改为
if ((msg.wParam=SC_MINIMIZE) or (msg.wParma=SC_CLOSE))

还不行呀! 之前我也改过,都不行!
 
piaosiy: 你的方法在关闭时能实现最小化,但我的应用永远无法关闭了
 
if (msg.WParam = SC_MINIMIZE ) 改为
if ((msg.wParam=SC_MINIMIZE) or (msg.wParma=SC_CLOSE)) 后,经过调试可以进入代码,但仍然关闭了应用!
 
procedure TAWTrayIcon.HandleHookAppProc(var Message: TMessage);
begin
case Message.Msg of
WM_SIZE:
if Message.wParam = SIZE_MINIMIZED then
begin
if (fActive) and (fMinimizeToTray) then
begin
if (Owner as TForm) = Application.MainForm then
ShowWindow(Application.Handle, SW_HIDE);
end;
end;
end; { end of "case..." }
with Message do
Result := CallWindowProc(FOldAppProc, Application.Handle,
Msg, wParam, lParam);
end;

procedure TAWTrayIcon.HandleHookFormProc(var Message: TMessage);
begin
case Message.Msg of
WM_SYSCOMMAND:
begin
case Message.WParam and $FFF0 of // WParam = uCmdType
SC_MINIMIZE:
if (FActive) and (FMinimizeToTray) then
begin
(Owner as TForm).Hide;
if (Owner as TForm) = Application.MainForm then
ShowWindow(Application.Handle, SW_HIDE);
if AnimateFromTray(False) then
begin
Message.Result := 0; // if processes this message, must return 0
Exit;
end;
end;
SC_CLOSE:
if (FActive) and (FCloseToTray) then
begin
(Owner as TForm).Hide;
if (Owner as TForm) = Application.MainForm then
ShowWindow(Application.Handle, SW_HIDE);
if AnimateFromTray(False) then
begin
Message.Result := 0; // if processes this message, must return 0
Exit;
end;
end;
SC_RESTORE:
begin
if FActive then
if fAlwaysHideTrayButton then
ShowWindow(Application.Handle, SW_HIDE)
else
ShowWindow(Application.Handle, SW_SHOW);
end;
end; { end of case }
end;
WM_SHOWWINDOW:
begin
if (Boolean(Message.WParam)) and (Message.LParam = 0) then
if FActive then
begin
if fAlwaysHideTrayButton then
ShowWindow(Application.Handle, SW_HIDE)
else
ShowWindow(Application.Handle, SW_SHOW);
if (fAnimateTrayStyle <> tsNone) and
((FCloseToTray) or (FMinimizeToTray)) then
AnimateFromTray(True);
end;
end;
end; { end of "case..." }
with Message do
Result := CallWindowProc(FOldWndProc, (Owner as TWinControl).Handle,
Msg, wParam, lParam);
end;
这是我自己写的TrayIcon控件的部分代码,仅供参考。
 
问题解决:
onmin 中 inherited; 注释就行了
 
晕,我只是给你一个例子,我在上面是为了方便起见就写了个 CanClose := false;说了给你参考,具体方法你通过一个全局变量控制即可。当CanClose:=true时就可以关闭了。
 
现在出现新的问题了:我想在运行应用前,先判断程序是否已经运行。如果已运行,则直接到托盘那提取。
我的代码如下,但编译后没有反应,不知何解?:

program Project1;
。。。。。

myhwnd := FindWindow(nil, '系统托盘测试'); // 查找窗口
if myhwnd=0 then // 没有发现,继续运行
begin
Application.Initialize;
Application.Title := '系统托盘测试';
Application.CreateForm(TForm1, Form1);
ShowWindow(Application.Handle,SW_HIDE);
//在托盘中不显示程序图标
SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
Application.ShowMainForm := False;
Application.Run;
end
else //发现窗口,发送鼠标单击系统托盘区消息以激活窗口
postmessage(myhwnd,WM_MOUSELAST,0,wm_lbuttondown);
 
用raize 的 RzTrayIcon 控件,省事好用,完全能满足要求!
 
后退
顶部