Blue
Red
Green
Orange
Voilet
Slate
Dark

怎样把程序的图标做到系统托盘处(100分)

X

xlf

Unregistered / Unconfirmed
GUEST, unregistred user!
请问怎样把程序的图标做到系统托盘处,并支持鼠标左右键,就像金山词霸2000那样,显示主界面时,在任务栏显示,最小化时任务栏上就没有。请详
细解答谢谢!!!
 
D

dedman

Unregistered / Unconfirmed
GUEST, unregistred user!
我看过电脑报有一个用vc做的,不知有否 delphi的?
g
 
D

Dick

Unregistered / Unconfirmed
GUEST, unregistred user!
这个问题怎么又提出来了?好像论坛中讨论过很多次了。
另外深度历险上有这个例子,看看就明白了,也就是10多行
代码的事,不是什么高难技术。
 
W

wrench

Unregistered / Unconfirmed
GUEST, unregistred user!
windows 95 和 windows nt 4.0包含一个令人兴奋的特性:任务栏。这个通常位于区域任务条右面的区域能包含小的图标,这些图标能引出大的应用程序或者菜单。本篇文章主要讨论如何使用delphi建立这样的应用程序。
在开始之前,请看下面的需要的接口方面的内容:
从技术方面来说,一个任务栏应用程序非常象普通的应用程序,它有一个消息循环,相应windows的消息来完成相应的功能。
procedure runtrayapplication;
var msg : tmsg;
begin
createwindow;
addtrayicon;
while getmessage(msg,0,0,0)do
begin
translatemessage(msg);
dispatchmessage(msg);
end;
deletetrayicon;
end;
你能看到:所有需要做的工作是创建一个窗口,注册一个图标到任务栏,设置它的消息循环,最后关闭它。当然,必须还有增加其他代码完成相应的功能,但是,它是真的不需要担心。
让我们从窗口的创建开始。实际上,这个窗口是不是能在任务栏上能见到的窗口。相应的,这个窗口只是处理消息循环、其它父类的工作。任务窗口(windows 95 &
nt)句柄创建消息(例如鼠标单击等)和将消息发到我们的窗口。
procedure createwindow;
var
wc : twndclass;
w : hwnd;
begin
with wcdo
begin
style := 0;
lpfnwndproc := @wndproc;
cbclsextra := 0;
cbwndextra := 0;
hicon := 0;
hcursor := 0;
hbrbackground :=di2001.jpg;
lpszmenuname := nil;
lpszclassname := 'mytrayiconclass';
hinstance := system.hinstance;
end;
registerclass(wc);
w := windows.createwindow('mytrayiconclass', 'myveryowntrayiconwindow',
ws_overlappedwindow, 0, 0, 0, 0, 0, 0, hinstance, nil);
showwindow(w,sw_hide);
updatewindow(w);
mainwindow := w;
end;
 
这个窗口使用普通的窗口函数创建。注意这个窗口的类型是“ws_overlappedwindow”,但是这个尺寸是0,并且它是隐藏的,所有,它将不会显示出来。
下一步是加(注册)我们的图标。这将需要使用shell_notifyicon这个api函数,这个函数实际上可以完成三个功能,这里只需要它的增加的特性。
procedure addtrayicon;
var icondata : tnotifyicondata;
begin
with icondatado
begin
cbsize := sizeof(icondata);
wnd := mainwindow;
uid := 0;
uflags := nif_icon or nif_message or nif_tip;
ucallbackmessage := wm_mycallback;
hicon := loadicon(hinstance,'myicon');
strcopy(sztip,pchar(trayicontip));
end;
shell_notifyicon(nim_add,@icondata);
end;
 
这个最重要的事情是tnotifyicondata的数据结构,它是一个设置window句柄的数据结构,是一个记录参数,对我们来说,我们需要设置这个图标的窗口句柄(这将定义哪个窗口处理消息循环),回调消息号,图标,工具提示等。一旦这个数据设置了,我们就可以增加一个图标到任务栏上了。为了完成这个工作,使用nim_add程序。
现行我们已经加了我们的图标到任务栏,下面需要决定如何处理消息。
const
wm_mycallback = wm_user+1000;
cm_exit = 100;
{ we worry about... }
cm_about = 101;
{ ...these later }
 
这个实际的窗口处理过程也是相当普通。几个窗口消息(如wm_nccreate)必须处理。然而,对我们来说,更重要的事情是处理wm_mycallback和wm_command消息:
function wndproc (window : hwnd;
msg, wparam, lparam : integer): integer;
stdcall;
begin
result := 0;
case msg of
wm_nccreate : result := 1;
wm_destroy : postquitmessage(0);
wm_command : begin
{ a command was chosen from the popup menu }
if (wparam = cm_exit) then
postmessage(window,wm_destroy,0,0)
else
if (wparam = cm_about) then
messagebox(0,'shell test copyright ?'+
'jani j鋜vinen 1996.',
'about shell test',mb_ok)
else
opendesktopicon(wparam-cm_about);
end;
wm_mycallback : begin
{ our icon was clicked }
if (lparam = wm_lbuttondown) then
showiconpopupmenu
else
if (lparam = wm_rbuttondown) then
showaboutpopupmenu;
end;
else
result := defwindowproc(window,msg,wparam,lparam);
end;
end;
 
就象你看到的一样,当用户单击图标时,windows提示我们。注意我们不使用通常使用的wm_lbuttondown 消息,而使用wm_mycallback message,详细的消息信息存储在lparam参数中。
当用户单击鼠标右键,我们创建一个菜单在桌面上。
type
ticondata = array[1..100] of string;
var
icondata : ticondata;
procedure showiconpopupmenu;
var
shellfolder : ishellfolder;
enumidlist : ienumidlist;
result : hresult;
dummy : ulong;
itemidlist : titemidlist;
pntr : pitemidlist;
strret : tstrret;
popupmenu : hmenu;
itemid : integer;
pos : tpoint;
procedure addtomenu(item : string);
var s : string;
begin
icondata[itemid-cm_about] := item;
s := extractfilename(item);
if (system.pos('.',s) <> 0) then
setlength(s,system.pos('.',s)-1);
appendmenu(popupmenu,mf_enabled or mf_string,itemid,pchar(s));
inc(itemid);
end;
begin
popupmenu := createpopupmenu;
itemid := cm_about+1;
shgetdesktopfolder(shellfolder);
shellfolder.enumobjects(mainwindow,shcontf_nonfolders,enumidlist);
pntr := @itemidlist;
result := enumidlist.next(1,pntr,dummy);
while (result = noerror)do
begin
shellfolder.getdisplaynameof(pntr,shgdn_forparsing,@strret);
with strretdo
addtomenu(string(cstr));
result := enumidlist.next(1,pntr,dummy);
end;
enumidlist.release;
shellfolder.release;
getcursorpos(pos);
appendmenu(popupmenu,mf_separator,0,'');
appendmenu(popupmenu,mf_enabled or mf_string,cm_exit,'e&amp;xit');
setforegroundwindow(mainwindow);
trackpopupmenu(popupmenu,tpm_leftalign or tpm_leftbutton,
pos.x,pos.y,0,mainwindow,nil);
destroymenu(popupmenu);
end;
 
上面的程序看起来有点复杂,你可以将它分成两个部分来看:创建和显示菜单。
列举创建菜单是用windows的外壳接口完成的。首先,我们使用shgetdesktopforlder函数得到使用桌面的ishellfolder接口。使用这个接口,我们能得到另一个接口的实例:ienumidlist。这个接口通常实现实际的列举工作。我们简单的重复调用这个函数直到错误值返回(例如:所有的菜单被列举)。当我们得到一个菜单,我们使用addtomenu函数加它。
当所有的菜单被列举和创建后,现在我们需要运行这个菜单。我们将找到的菜单保存到一个全局的list变量中,每一个菜单都拥有它的菜单号。这确保我们能得到它的索引。
opendesktopicon(wparam-cm_about)
当然,wparam中储存了用户单击鼠标的菜单的菜单号(id)。
下面我们将处理运行用户选择的菜单。
procedure opendesktopicon(number : integer);
var
s : string;
i : integer;
begin
s := icondata[number];
i := shellexecute(0,nil,pchar(s),nil,nil,sw_shownormal);
if (i < 32) then
begin
s := 'could not open selected item "'+s+'". '+
'result was: '+inttostr(i)+'.';
messagebox(0,pchar(s),'shell test',mb_ok);
end;
end;
 
上面,win 32 api函数shellexecute做了所有的工作。
现在你应该能用delphi创建简单的任务栏的程序了。

 
W

wlq

Unregistered / Unconfirmed
GUEST, unregistred user!
用shellapi
function Shell_NotifyIcon(dwMessage,lpData):bool
可以完全满足您的要求。
我在论坛中问过这个问题:)
去深度历险,csdn,有很多源程序。
 
H

hzwdq

Unregistered / Unconfirmed
GUEST, unregistred user!
!送个控件给你,愿意的话还可以隐藏任务栏上图标,需要完整例程,请发Email,
从2000年2月5日起一周内可给以回应。
//杭州电子工业学院 计算机应用技术研究所
//hzwdq@netease.com
uses Windows, SysUtils, Messages, ShellAPI, Classes, Graphics, Forms, Menus,
StdCtrls, ExtCtrls;
type
ENotifyIconError = class(Exception);
TTrayNotifyIcon = class(TComponent)
private
FDefaultIcon: THandle;
FIcon: TIcon;
FHideTask: Boolean;
FHint: string;
FIconVisible: Boolean;
FPopupMenu: TPopupMenu;
FOnClick: TNotifyEvent;
FOnDblClick: TNotifyEvent;
FNoShowClick: Boolean;
FTimer: TTimer;
Tnd: TNotifyIconData;
procedure SetIcon(Value: TIcon);
procedure SetHideTask(Value: Boolean);
procedure SetHint(Value: string);
procedure SetIconVisible(Value: Boolean);
procedure SetPopupMenu(Value: TPopupMenu);
procedure SendTrayMessage(Msg: DWORD;
Flags: UINT);
function ActiveIconHandle: THandle;
procedure OnButtonTimer(Sender: TObject);
protected
procedure Loaded;
override;
procedure LoadDefaultIcon;
virtual;
procedure Notification(AComponent: TComponent;
Operation: TOperation);
override;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
published
property Icon: TIcon read FIcon write SetIcon;
property HideTask: Boolean read FHideTask write SetHideTask default False;
property Hint: String read FHint write SetHint;
property IconVisible: Boolean read FIconVisible write SetIconVisible default False;
property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
end;

procedure Register;

implementation
{ TIconManager }
{ This class creates a hidden window which handles and routes }
{ tray icon messages }
type
TIconManager = class
private
FHWindow: HWnd;
procedure TrayWndProc(var Message: TMessage);
public
constructor Create;
destructor Destroy;
override;
property HWindow: HWnd read FHWindow write FHWindow;
end;

var
IconMgr: TIconManager;
DDGM_TRAYICON: Cardinal;
constructor TIconManager.Create;
begin
FHWindow := AllocateHWnd(TrayWndProc);
end;

destructor TIconManager.Destroy;
begin
if FHWindow <> 0 then
DeallocateHWnd(FHWindow);
inherited Destroy;
end;

procedure TIconManager.TrayWndProc(var Message: TMessage);
{ This allows us to handle all tray callback messages }
{ from within the context of the component. }
var
Pt: TPoint;
TheIcon: TTrayNotifyIcon;
begin
with Messagedo
begin
{ if it's the tray callback message }
if (Msg = DDGM_TRAYICON) then
begin
TheIcon := TTrayNotifyIcon(WParam);
case lParam of
{ enable timer on first mousedo
wn. }
{ OnClick will be fired by OnTimer method, provided }
{do
uble click has not occurred. }
WM_LBUTTONDOWN: TheIcon.FTimer.Enabled := True;
{ Set no click flag ondo
uble click. This will supress }
{ the single click. }
WM_LBUTTONDBLCLK:
begin
TheIcon.FNoShowClick := True;
if Assigned(TheIcon.FOnDblClick) then
TheIcon.FOnDblClick(Self);
end;
WM_RBUTTONDOWN:
begin
if Assigned(TheIcon.FPopupMenu) then
begin
{ Call to SetForegroundWindow is required by API }
SetForegroundWindow(IconMgr.HWindow);
{ Popup local menu at the cursor position. }
GetCursorPos(Pt);
TheIcon.FPopupMenu.Popup(Pt.X, Pt.Y);
{ Message post required by API to force task switch }
PostMessage(IconMgr.HWindow, WM_USER, 0, 0);
end;
end;
end;
end
else
{ If it isn't a tray callback message, then
call DefWindowProc }
Result := DefWindowProc(FHWindow, Msg, wParam, lParam);
end;
end;

{ TTrayNotifyIcon }
constructor TTrayNotifyIcon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIcon := TIcon.Create;
FTimer := TTimer.Create(Self);
with FTimerdo
begin
Enabled := False;
Interval := GetDoubleClickTime;
OnTimer := OnButtonTimer;
end;
{ Keep default windows icon handy... }
LoadDefaultIcon;
end;

destructor TTrayNotifyIcon.Destroy;
begin
if FIconVisible then
SetIconVisible(False);
// destroy icon
FIcon.Free;
// free stuff
FTimer.Free;
inherited Destroy;
end;

function TTrayNotifyIcon.ActiveIconHandle: THandle;
{ Returns handle of active icon }
begin
{ If no icon is loaded, then
return default icon }
if (FIcon.Handle <> 0) then
Result := FIcon.Handle
else
Result := FDefaultIcon;
end;

procedure TTrayNotifyIcon.LoadDefaultIcon;
{ Loads default window icon to keep it handy. }
{ This will allow the component to use the windows logo }
{ icon as the default when no icon is selected in the }
{ Icon property. }
begin
FDefaultIcon := LoadIcon(0, IDI_WINLOGO);
end;

procedure TTrayNotifyIcon.Loaded;
{ Called after component is loaded from stream }
begin
inherited Loaded;
{ if icon is supposed to be visible, create it. }
if FIconVisible then
SendTrayMessage(NIM_ADD, NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;

procedure TTrayNotifyIcon.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = PopupMenu) then
PopupMenu := nil;
end;

procedure TTrayNotifyIcon.OnButtonTimer(Sender: TObject);
{ Timer used to keep track of time between two clicks of a }
{do
uble click. This delays the first click long enough to }
{ ensure that ado
uble click hasn't occurred. The whole }
{ point of these gymnastics is to allow the component to }
{ receive OnClicks and OnDblClicks independently. }
begin
{ Disable timer because we only want it to fire once. }
FTimer.Enabled := False;
{ ifdo
uble click has not occurred, then
fire single click. }
if (not FNoShowClick) and Assigned(FOnClick) then
FOnClick(Self);
FNoShowClick := False;
// reset flag
end;

procedure TTrayNotifyIcon.SendTrayMessage(Msg: DWORD;
Flags: UINT);
{ This method wraps up the call to the API's Shell_NotifyIcon }
begin
{ Fill up record with appropriate values }
with Tnddo
begin
cbSize := SizeOf(Tnd);
StrPLCopy(szTip, PChar(FHint), SizeOf(szTip));
uFlags := Flags;
uID := UINT(Self);
Wnd := IconMgr.HWindow;
uCallbackMessage := DDGM_TRAYICON;
hIcon := ActiveIconHandle;
end;
Shell_NotifyIcon(Msg, @Tnd);
end;

procedure TTrayNotifyIcon.SetHideTask(Value: Boolean);
{ Write method for HideTask property }
const
{ Flags to show application normally or hide it }
ShowArray: array[Boolean] of integer = (sw_ShowNormal, sw_Hide);
begin
if FHideTask <> Value then
begin
FHideTask := Value;
{do
n'tdo
anything in design mode }
if not (csDesigning in ComponentState) then
ShowWindow(Application.Handle, ShowArray[FHideTask]);
end;
end;

procedure TTrayNotifyIcon.SetHint(Value: string);
{ Set method for Hint property }
begin
if FHint <> Value then
begin
FHint := Value;
if FIconVisible then
{ Change hint on icon on tray notification area }
SendTrayMessage(NIM_MODIFY, NIF_TIP);
end;
end;

procedure TTrayNotifyIcon.SetIcon(Value: TIcon);
{ Write method for Icon property. }
begin
FIcon.Assign(Value);
// set new icon
{ Change icon on notification tray }
if FIconVisible then
SendTrayMessage(NIM_MODIFY, NIF_ICON);
end;

procedure TTrayNotifyIcon.SetIconVisible(Value: Boolean);
{ Write method for IconVisible property }
const
{ Flags to add or delete a tray notification icon }
MsgArray: array[Boolean] of DWORD = (NIM_DELETE, NIM_ADD);
begin
if FIconVisible <> Value then
begin
FIconVisible := Value;
{ Set icon as appropriate }
SendTrayMessage(MsgArray[Value], NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;
end;

procedure TTrayNotifyIcon.SetPopupMenu(Value: TPopupMenu);
{ Write method for PopupMenu property }
begin
FPopupMenu := Value;
if Value <> nil then
Value.FreeNotification(Self);
end;

const
{ String to identify registered window message }
TrayMsgStr = 'DDG.TrayNotifyIconMsg';
procedure Register;
begin
RegisterComponents('New Component', [TTrayNotifyIcon]);
end;

initialization
{ Get a unique windows message ID for tray callback }
DDGM_TRAYICON := RegisterWindowMessage(TrayMsgStr);
IconMgr := TIconManager.Create;
finalization
IconMgr.Free;
end.
 
B

beta

Unregistered / Unconfirmed
GUEST, unregistred user!
这样的控件很多嘛,何必自己劳神?
 
F

freeforever

Unregistered / Unconfirmed
GUEST, unregistred user!
http://jinhe.163.net/有关于此内容的文章
 
H

hsw

Unregistered / Unconfirmed
GUEST, unregistred user!
有给wrench抢先,
为什么每次又简单的问题,wrench总能……
 
S

sunyonghua

Unregistered / Unconfirmed
GUEST, unregistred user!
我在《Delphi Developer's Handbook》中的配套光盘发现此控件(附带源码)。
可发E_mail到你的邮箱。欢迎其他人索取此控件。
我的E_mail:sunyonghua@163.net
 
H

haoxg

Unregistered / Unconfirmed
GUEST, unregistred user!
这样的东东实在是太多了,到处都有。
我也写了一个这样的组件
下载地址:
http://person.zj.cninfo.net/~haohome/newsoft/systray.zip
或直接访问在下的主页: http://haoxg.yeah.net

 
Y

yang_pk

Unregistered / Unconfirmed
GUEST, unregistred user!
最简单就是用控件了,
如很有名的RxLib中就有.
 
X

xlf

Unregistered / Unconfirmed
GUEST, unregistred user!
我还想听更多的意见!
请问怎样做成窗体是透明的?
不是用 Form1.Brush.Style := bsClear
因为用 bsClear 后,透明的窗体就成了当前背景的图形,
并不是透明的背景.
 
X

xxniao

Unregistered / Unconfirmed
GUEST, unregistred user!
直接用shellAPI最简单,最方便。查一下help就可以用了,而且
别的语言也使用。如果想要例子的话,发信到xiaoxiaoniao@263.net
 
X

xlf

Unregistered / Unconfirmed
GUEST, unregistred user!
多人接受答案了。
 

Similar threads

D
回复
0
查看
682
DelphiTeacher的专栏
D
D
回复
0
查看
667
DelphiTeacher的专栏
D
D
回复
0
查看
621
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
顶部 底部