请大侠仗义给我看看一个托盘程序的源码,这个程序我看不懂,不知道每段代码该放到什么地方,请指示,我应该怎么利用这段代码(200分)

  • 主题发起人 主题发起人 bloodbird
  • 开始时间 开始时间
B

bloodbird

Unregistered / Unconfirmed
GUEST, unregistred user!
建立简单的任务栏应用程序



从技术方面来说,一个任务栏应用程序非常象普通的应用程序,它有一个消息循环,

相应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 WC do Begin

Style := 0;

lpfnWndProc := @WndProc;

cbClsExtra := 0;

cbWndExtra := 0;

hIcon := 0;

hCursor := 0;

hbrBackground := 0;

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 IconData do 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 StrRet do 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&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创建简单的任务栏的程序了。



实际上,有一些免费的元件可以供您直接使用,不过,因为使用VCL,文件的大小

将比较大,如果使用上面的方法,文件的大小将只要20K。当然,现在文件的大小已经

不是我们该十分关注的问题了。
 
老弟,他的方法好象在95下实现的,在98下我用不成的
 
给你一个简单的吧 get me you email.
 
你不可以整理一下再发吗?
这叫人怎样看?
搜索一下,相关的帖子很多。并且比这个好看多了!
 
dingbaosheng: 我的email是kisskiller@163.net
 
其实就只是调用一个API而已,不用搞得那么复杂,当然还可以用现成的控件
unit Unit1;

interface

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

const
; WM_TRAYICON = WM_APP + 0;
type
; TForm1 = class(TForm)
; ; PopupMenu: TPopupMenu;
; ; Hello1: TMenuItem;
; ; Exit1: TMenuItem;
; ; N1: TMenuItem;
; ; There1: TMenuItem;
; ; Label1: TLabel;
; ; procedure FormClose(Sender: TObject; var Action: TCloseAction);
; ; procedure FormCreate(Sender: TObject);
; ; procedure Exit1Click(Sender: TObject);
; private
; ; procedure WMTrayIcon(var message: TMessage); message WM_TRAYICON;
; ; procedure ModifyTrayIcon(Action: DWORD);
; public
; end;
;
var
; Form1: TForm1;
;
implementation

{$R *.DFM}

procedure TForm1.ModifyTrayIcon(Action: DWORD);
var
; NIData: TNotifyIconData;
begin
; with NIData do
; begin
; ; cbSize := sizeof(TNotifyIconData);
; ; UID := 0;
; ; uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
; ; Wnd := Handle;
; ; uCallBackMessage := WM_TRAYICON;
; ; HICON := Application.Icon.Handle;
; ; StrPCopy(szTip, Application.Title);
; end;
; Shell_NotifyIcon(Action, @NIData);
end;

procedure TForm1.WMTrayIcon(var message: TMessage);
var
; MousePos: TPoint;
begin
; if message.LPARAM = WM_RBUTTONDOWN then
; begin
; ; SetActiveWindow(Handle);
; ; GetCursorPos(MousePos);
; ; PopupMenu.Popup(MousePos.X, MousePos.Y);
; end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
; ModifyTrayIcon(NIM_DELETE);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
; ModifyTrayIcon(NIM_ADD);
end;

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

end.
 
2 xianjun : ;我将你的程序拷贝过去, 怎么没有任何反应啊 , 我创建了popupmenu和lable
但是运行时没有任何反应? 我不知道怎样 把图标贴近来啊?
 
例子已经发出请查收
对了 我是用delphi6编译的
源码和可执行文件 都在压缩包内
 
感谢大家帮助
 
多人接受答案了。
 

Similar threads

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