请问:怎样在一个程序执行时缩小为 Windows 任务栏右下方的一个小图标? ( 积分: 50 )

  • 主题发起人 chamstar
  • 开始时间
C

chamstar

Unregistered / Unconfirmed
GUEST, unregistred user!
各位高手请问:怎样在一个程序执行时缩小为 Windows 任务栏右下方的一个小图标?而不是作为一个窗口存在?当我双击任务栏右下方的小图标时,又可以恢复成为窗口显示?谢谢!!
 
A

ANiDelphi

Unregistered / Unconfirmed
GUEST, unregistred user!
S

songrun

Unregistered / Unconfirmed
GUEST, unregistred user!
TrayIcon ;windowstate屬性;
 
N

nicai_wgl

Unregistered / Unconfirmed
GUEST, unregistred user!
用现成的控件,或者用API函数自己做,以前的帖子很多。
 
H

hyxic

Unregistered / Unconfirmed
GUEST, unregistred user!
给你代码自己研究
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,shellapi;
const
wm_traynotify=wm_user+1000;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
my_tray_icon:tnotifyicondata;
procedure wmmytrayiconcallback(var msg:tmessage);
message wm_traynotify;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.wmmytrayiconcallback(var msg:tmessage);
var
cursorpos:tpoint;
begin
case msg.LParam of
WM_LBUTTONDBLCLK:self.show;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
with my_tray_icon do
begin
cbsize:=sizeof(tnotifyicondata);
wnd:=handle;
uid:=1;
uflags:=nif_message or nif_icon or nif_tip;
ucallbackmessage:=wm_traynotify;
hicon:=Application.Icon.Handle;
sztip:='wwwww';
end;
shell_notifyicon(nim_add,@my_tray_icon);
setwindowlong(application.handle,GWL_EXSTYLE,WS_EX_ToolWindow);
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
canclose:=false;
self.Hide;
end;

end.
 
S

sbzldlb

Unregistered / Unconfirmed
GUEST, unregistred user!
unit UShellNotifyIcon;

interface

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

var
WM_NotifyIcon: Cardinal;

type
TShellNotifyIcon=Class
private
FHwnd:THandle;
NotifyIcon: TNotifyIconData;
FHintStr:String;
FIcoMenu: TPopupMenu;
procedure setHwnd(const Value: THandle);
procedure setHintStr(const Value: String);
procedure setIcoMenu(const Value: TPopupMenu);
procedure WndProc(var Msg: TMessage);
protected

public
procedure LoadAppIcon;
procedure UnLoadIcon;
procedure ModifyIcon(IcoHandle:THandle);
procedure ModifyHint(Hint:String);
procedure ShowMainFrm(Show:Boolean);
property MHwnd:THandle read FHwnd write setHwnd;
property HintStr:String read FHintStr write setHintStr;
property IcoMenu:TPopupMenu read FIcoMenu write setIcoMenu;
end;

var
ShellNotifyIcon:TShellNotifyIcon;

implementation

{ TShellNotifyIcon }
{添加托盘}
procedure TShellNotifyIcon.LoadAppIcon;
var
s: string;
begin
with NotifyIcon do
begin
cbSize := SizeOf(TNotifyIconData);
Wnd := Classes.AllocateHWnd(WndProc);
uID := 1;
uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
uCallBackMessage := WM_NotifyIcon;
hIcon := Application.Icon.Handle;
s := HintStr;
StrLCopy(szTip, PAnsiChar(s), Length(s));
end;
Shell_NotifyIcon(NIM_ADD, @NotifyIcon);
end;

{窗口显示}
procedure TShellNotifyIcon.ShowMainFrm(Show:Boolean);
begin
if Show then
begin
ShowWindow(Application.Handle, SW_SHOW);
Application.Restore;
ShowWindow(MHwnd, SW_SHOW);
SetForegroundWindow(MHwnd);
end else
begin
ShowWindow(Application.Handle, SW_HIDE);
ShowWindow(MHwnd, SW_HIDE);
Application.Minimize;
end;
end;

{消息处理}
procedure TShellNotifyIcon.WndProc(var Msg: TMessage);
var
mp: TPoint;
begin
if Msg.Msg=WM_NotifyIcon then
begin
if Msg.LParam = WM_LBUTTONDBLCLK then
begin
ShowMainFrm(True);
end else if Msg.LParam = WM_RBUTTONUP then
begin
GetCursorPos(mp);
SetForegroundWindow(MHwnd); {解决弹出右键菜单后不操作不消失问题}
IcoMenu.Popup(mp.X, mp.Y);
end else Inherited;
end;
end;

{修改显示}
procedure TShellNotifyIcon.ModifyHint(Hint: String);
begin
StrLCopy(NotifyIcon.szTip,PChar(Hint),Length(Hint));
Shell_NotifyIcon(NIM_MODIFY, @NotifyIcon);
end;

{修改托盘}
procedure TShellNotifyIcon.ModifyIcon(IcoHandle:THandle);
begin
NotifyIcon.hIcon:=IcoHandle;
Shell_NotifyIcon(NIM_MODIFY, @NotifyIcon);
end;

{删除托盘}
procedure TShellNotifyIcon.UnLoadIcon;
begin
Shell_NotifyIcon(NIM_DELETE, @NotifyIcon);
end;

procedure TShellNotifyIcon.setHintStr(const Value: String);
begin
FHintStr := Value;
end;

procedure TShellNotifyIcon.setHwnd(const Value: THandle);
begin
FHwnd := Value;
end;
procedure TShellNotifyIcon.setIcoMenu(const Value: TPopupMenu);
begin
FIcoMenu := Value;
end;
{ NotifyIcon.hIcon := Application.Icon.Handle;
Shell_NotifyIcon(NIM_MODIFY, @NotifyIcon);}


initialization
WM_NotifyIcon := RegisterWindowMessage('NotifyIcon');

end.
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
886
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
顶部