如何使用Delphi2.01編寫一個Desktop Menu |
|
|
|
jackkcg
站務副站長  發表：891 回覆：1050 積分：848 註冊：2002-03-23 發送簡訊給我 |
此為轉貼資料 如何使用Delphi2.01編寫一個Desktop Menu 內容簡介
第一步﹕建立Project
第二步﹕建立Desktop Popup Menu
第三步﹕獲得Desktop items
(一)使用FindFirst/FinNext收集Desktop items
1)獲得Desktop的物理路徑
2)向DesktopMenu中填充Desktop items
(二)使用FindFirst/FinNext帶來的問題
(三)使用IShellFolder收集Desktop items
1)獲得IShellFolder對象(object)
2)用IShellFolder來填充DesktopMenu的items
第四步﹕運行得到的item
(一)使用ShellExecuteEx運行item的基礎知識
(二)存儲PItemIDList和FileInfo
(三)完善FillMenuItemsFromShellFolder
(四)運行
第五步﹕在Tray Icon中添加Icon
第六步﹕處理WM_TRAYICON和WM_SHOWMENU消息
第七步﹕隱藏MainForm
作者的話
內容簡介﹕
本文采用 Step by step 方式, 通俗易懂地敘述了一個"Desktop Menu"應用程序
的編寫過程。所謂的"Desktop Menu"是在windows95 taskbar上的 Notify Tray
中放上一個ICON, 在用mouse點按時可以Popup出包括所有 desktop Items 的menu,
并能運行這些Items的應用程序。其中不僅涉及到關于Windows95 shell API的應用,
Delphi Component 的動態建立等編程技術, 還闡明了一些結构化編程的觀點。
多說無益, 直接進入正題. 第一步﹕建立Project
從Delphi主菜單中選擇 File | New Application, 讓Delphi生成一個新Project
在 Object Inspector 窗口中將 Form1 的 Name porperty 中寫入 MainForm
然后選擇 File Save As 保存 Project, 當 Save As Dialog 出現后, 輸入
UntMain 做為主單元文件名, 按Save保存。
Tip: 在做AP時, 為所有的From, unit起一個有意義的名字, 可提高程序的可讀性。 第二步﹕建立Desktop Popup Menu
在Delphi Component Palette 的Standard Tabset中選擇PopupMenu Icon并將其
放入MainForm中, 在MainForm中用mouse點取新放入的PopupMenu component并在
Object Inspector 窗口中將其更名為DesktopMenu為了能夠自動顯示它, 將其指
定給 MainForm 的 PopupMenu property。
Tip:
1)在Delphi Component Palette 的icon上雙擊mouse左鍵可以直接將所選
component放入當前的Form中。
2)在點選Palette icon時按住shift, Delphi進入一种連續place component狀態,
此時每當在Form上按mouse左鍵時, 都會在Form上添加一個新component。
要取消這种狀態可以用mouse左鍵按Palette左側的Arrow Icon。 第三步﹕獲得Desktop items
接下來我們要考慮的是如何將Windows 95桌面上的項目收集到我們的DesktopMenu中!
這也是本篇文章中我們需要討論的關鍵問題之一。 (一)使用FindFirst/FinNext收集Desktop items
通常我們會想到采用FindFirst/FindNext這兩個Pascal函數, 將Win95\Desktop
子目錄下的文件找出來。
好, 我們現在就來試一下。 1)獲得Desktop的物理路徑
首先我們遇到的問題是“如何取得Desktop所在的子目錄”,很明顯,所有細心的人
都會注意到它處在 Windows 95 所在目錄下的Desktop子目錄中。但事情有時不象
我們所預期的那樣。請注意,這只是通常的情況,假設某位“高手”修改了系統的
配置, 將其另易其地或Microsoft在未來的Windows版本中不再采用Desktop這個
子目錄, 那又會發生什么?有一點可以肯定,得到的并不是我們想要的。寫程序時
應盡可能采取最通用的處理方法,這樣可使程序獲得較好的适應性并大幅度地降低
程序的維護量,是一舉多得的做法。從Windows 95 的Registry中,可以得到Desktop
子目錄的路徑, 在Delphi 2.01的ShlObj單元中定義了
REGSTR_PATH_SPECIAL_FOLDERS 的常量, 這正是我們所要的﹗ 既然存取Windows 95的 Registry 就要用到 Registry Unit 在uses段中加入 Registry, ShellApi, ShlObj
其中ShellApi由于以后的編程中需要用到所以一起加入。 接下來為MainForm添加一個新的private方法 procedure FillMenuItemsFromFileList;
Tip:在代碼中善用一些注釋。 procedure TMainForm.FillMenuItemsFromFileList;
var
Reg: TRegistry;
DesktopPath: string;
begin
DesktopPath := '';
with TRegistry.Create do
try
//打開REGSTR_PATH_SPECIAL_FOLDERS Key 并讀取其值
if OpenKey(REGSTR_PATH_SPECIAL_FOLDERS, False) then
DesktopPath:= ReadString('Desktop')
else
Application.MessageBox('無法打開KEY:' REGSTR_PATH_SPECIAL_FOLDERS,
'Open Registry Key Error', MB_ICONSTOP or MB_OK);
finally
//确保釋放TRegistry.Create所分配的內存
Free;
end;
//失敗, MainForm.Caption 保持不變
if DesktopPath = '' then Exit;
Caption := DesktopPath;
end; 在MainForm的OnCreate Event 中寫入下列代碼: procedure TMainForm.FormCreate(Sender: TObject);
begin
FillMenuItemsFromFileList;
end; 然后運行Project, Ohhhh! Have a Error! MessageBox出現了! 同時我們注意到
MessageBox所報告的鍵串為
'Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\Shell Folders'
不難得出結論問題出在'\\'上, 串的一部分是C的語法, 這可以說是Delphi 2.01
的一個Bug! 在ShlObj中定義的REGSTR_PATH_SPECIAL_FOLDERS為
REGSTR_PATH_EXPLORER '\Shell Folders' 而REGSTR_PATH_EXPLORER定義在
RegStr.pas Unit中, 用Delphi IDE打開RegStr.Pas(位于Source\RTL\WIN下),
發現REGSTR_PATH_等串的定義是依照C語法實現的(Borland 可能忽略了這個問題)。
解決的方法有兩個, 一個是修改RegStr.Pas中的內容并重新編譯Delphi的Lib,
另一個就是自己定義。為了避免其它類似的程序也可能遇到相同的問題我采取了
前面的做法。(PS:Delphi 2.01 的 Shlobj 中還存在一些其它BUG! 但 Delphi3
中都進行了糾正, 請參考WEB上的相關討論) 打開位于 Source\RTL\WIN 下的 Regstr.pas , 使用 '\' 替換所有的 '\\',
從Component Menu下選擇Install..., 在Search path中添加上述路徑和
'Source\VCL'路徑, click "OK" 按鈕以重新編譯整個VCL。編譯完成后,
將在上述路徑中生成的'DCU'文件移到'Lib'目錄下, 覆蓋原有的同名'DCU'文件,
最后將Search path中的新添加部分刪除, 以避免在Project每次Build All時
對這些文件的重复編譯并可避免在Debug時誤入其中。 重新運行Project, OK, 一切正常, MainForm的Caption 變為Desktop的路徑。 2)向DesktopMenu中填充Desktop items 接下來開始將文件名放入MenuItem中,
將FillMenuItemsFromFileList procedure 中鍵入下列代碼
(位于Caption := DesktopPath;語句之后) //查找除VolumeID之外的所有文件
ItemsAttr:= faAnyFile xor faVolumeID;
//查找第一個匹配文件
Result := FindFirst(DesktopPath '\*.*', ItemsAttr, SearchRec);
//繼續找到所有文件
while Result = 0 do
begin
//建立新的MenuItem
ThisMenuItem := TMenuItem.Create(DesktopMenu);
ThisMenuItem.Caption := SearchRec.Name;
DesktopMenu.Items.Add(ThisMenuItem);
//查找下一個匹配文件
Result := FindNext(SearchRec);
end;
//關閉查找操作
FindClose(SearchRec); 并在var段中加入 ItemsAttr: Integer;
SearchRec: TSearchRec;
Result: Integer;
ThisMenuItem: TMenuItem; 運行Project, 當MainForm出現后在其客戶區按 mouse 右鍵, Desktop Menu
出現了, 一切如我們所預期的那樣。 Tip: 函數和變量的命名要盡量采用一些有意義的單詞, 可提高程序的可讀性。 (二)使用FindFirst/FinNext帶來的問題
但隨后的問題出現了, 對于系統級的My Computer, Recycle Bin等并未出現在
Win95\Desktop子目錄下, 該如何做﹖
采用Windows 95的Explorer瀏覽Win95\Desktop子目錄, 同樣不包括系統級的
Item, 但當用其瀏覽最頂層的Desktop時, 顯示出的Items与桌面上所看到的相同
看來, 看來若要實現一個真正的Desktop Menu必須要從Windows 95 的 Shell
入手。查閱相關文檔, 得知 Windows 95 提供了一种被稱為"Name space"的新
概念, 其中有一個IShellFolder的Ole對象(可以理解為一個虛擬的Folder),
最頂層的 Desktop 就是這個Ole對象(Object)。
Tip:透過現象看本質。 (三)使用IShellFolder收集Desktop items 1)獲得IShellFolder對象(object)
這個IShellFolder Ole對象要如何取得呢? 在ShlObj Unit中有一個函數
SHGetDesktopFolder可以取得Desktop的IShellFolder對象(對于其它Shell Folder
則要費些周折)。現在我們就來將它取回: 首先為TMainForm添加一個新函數 procedure FillMenuItemsFromShellFolder;
并增加几個 private 變量
isfDesktopFolder: IShellFolder;
imShellAllocator: IMalloc; 在uses段中添加ole2 unit procedure TMainForm.FillMenuItemsFromShellFolder;
begin
//獲得Task allocator
if SHGetMalloc(imShellAllocator) <> NOERROR then
begin
Application.MessageBox('無法取得 IMalloc',
'運行錯誤', MB_ICONSTOP or MB_OK);
Exit;
end;
//取回DesktopFolder對象
if SHGetDesktopFolder(isfDesktopFolder) <> NOERROR then
begin
Application.MessageBox('無法取得IShellFolder Object',
'運行錯誤', MB_ICONSTOP or MB_OK);
//釋放shell task Allocator
imShellAllocator.Release;
Exit;
end;
Caption := 'IShellFolfer';
//釋放DesktopFolder Object
isfDesktopFolder.Release;
//釋放shell task Allocator
imShellAllocator.Release;
end; 你可能會注意到, 這里用到了一個叫 SHGetMalloc 的Shell API函數,
其目的是, 對于所有 Shell Object 的編程, 要先分配一個Task allocator,
确切地講是memory allocator詳見下面的描述(摘自ShlObj.Pas), 雖然現在
不是編寫一個Shell extensions, 但后面我們會用到 PITEMIDLIST, 其所占用
的內存是由Shell對象(object)分配后再將指針交給我們, 對于這些存儲塊的
釋放是采用Task allocator提供的Free成員函數來實現的。(筆者層跟蹤過一些
類似的AP, 發現此方面大多被忽略, 表現在每次更新Menu的Items后, 總會在
memory中殘留一些未被釋放的空間,其后果也就不言而寓了) Tip:若想編寫一個健壯的程序, 需要多留意各种文檔中的細節, 并把它反映
到程序的代碼中來--最好的編程指南是Online help和代碼本身所提供的注釋。 All the shell extensions MUST use the task allocator (see OLE 2.0
programming guild for its definition) when they allocate or free
memory objects (mostly ITEMIDLIST) that are returned across any
shell interfaces. There are two ways to access the task allocator
from a shell extension depending on whether or not it is linked with
OLE32.DLL or not (virtual; stdcall; abstractly for efficiency). 2)用IShellFolder來填充DesktopMenu的items
ShellFolder找到了, 接下來的工作該是填滿我們的DesktopMenu了, 這也是我們
編程中最有意思的地方。參考Online Help, IShellFolder Object 有一個
EnumObjects 的方法(Enumerates the objects in the folder), 這又是一個
Object -- IEnumIDList。從某些方面講這個 IEnumIDList 与Delphi 中的 TList
有些類似, 只是遍歷的方法不同。 在TMainForm中的private段中添入
FRetrieveItemFlag: UINT;
FEnumItemFlag: DWord;
ieDesktopItemsObj: IEnumIDList; 并在OnCreate事件中加入
FRetrieveItemFlag := SHGFI_DISPLAYNAME or SHGFI_PIDL;
FEnumItemFlag := SHCONTF_NONFOLDERS or SHCONTF_FOLDERS; Tip: 使用上述變量可使程序具有較大的靈活性并易于維護, 設想一下如果我們需要
從SHGetFileInfo中獲得其它信息, 而程序中又不只一次地使用了SHGetFileInfo
我們就可從中收益(代碼只更改了一處)。或者程序中有一個option可以按用戶的
需求進行定制, 同樣我們可以在初始化時接收用戶的請求并一次設置好這些參數。
其實, 最理想的做法是將所有可能變動全局變量和常量全放到一個公用的unit中。
對于通用的procedure也是一樣(最好按功能進行分組--我個人的一點建議)。 并將FillMenuItemsFromShellFolder修改為下列代碼, procedure TMainForm.FillMenuItemsFromShellFolder;
var
pceltFetched: ULONG;
tmpItemID: PItemIDList;
tmpItemInfo: TSHFileInfo;
ThisMenuItem: TMenuItem;
tmpMenuNo : Integer;
pItem: PMenuItemType;
tmpMenuItemInfo: TMENUITEMINFO;
begin //取回DesktopFolder對象
if SHGetDesktopFolder(isfDesktopFolder) <> NOERROR then
begin
Application.MessageBox('無法取得IShellFolder Object',
'運行錯誤', MB_ICONSTOP or MB_OK);
Exit;
end;
Caption := 'IShellFolder'; tmpMenuNo := 0;
//枚舉DesktopFolder中的Items
if isfDesktopFolder.EnumObjects (Application.Handle,
FEnumItemFlag,
ieDesktopItemsObj) <> NOERROR then
Application.MessageBox('無法EnumObject',
'運行錯誤', MB_ICONSTOP or MB_OK)
else
//第一次指向第一個PItemList, 每次取一個item
while NOERROR = ieDesktopItemsObj.Next(1, tmpItemID, pceltFetched) do
begin
//取得Item的有關信息
SHGetFileInfo( PChar(tmpItemID), 0, tmpItemInfo,
SizeOf(TSHFileInfo),
FRetrieveItemFlag);
New(pItem);
pItem^.ID := tmpItemID;
pItem^.Info := tmpItemInfo;
FMenuItemList.Add(pItem);
//建立這個MenuItem
ThisMenuItem:= TMenuItem.Create(DesktopMenu);
//填充MenuItem
with ThisMenuItem do
begin
//采用MenuItem序列號為其命名
Name := 'DesktopMenu_' IntToStr(tmpMenuNo);
Caption := StrPas(tmpItemInfo.szDisplayName);
//連接OnClick事件
OnClick := OnDesktopMenuClick;
end;
//添加到DesktopMenu中, 此為必須
DesktopMenu.Items.Add(ThisMenuItem);
Inc(tmpMenuNo);
end;
//釋放Desktop EnumObject
ieDesktopItemsObj.Release;
//釋放DesktopFolder Object
isfDesktopFolder.Release; end; 運行Project, 在Form中按Mouse右鍵, 我們就會看到Desktop Items 的Menu了。
當然這只邁出了第一步, 單純的顯示沒有任何實際意義, 還要想辦法運行它。 第四步﹕運行得到的item Windows 95 提供了很多運行程序的方法, 如 WinExec, CreateProcess,
ShellExecute, ShellExecuteEx 等。 WinExec和ShellExecute使用起來最簡便
CreateProcess功能非常強大, 但它們都是与文件名打交道, 對于那些不具備
物理文件名的Items就無能為力了, 所以我們采用ShellExecuteEx這個API。
這也是本篇文章中的另一個關鍵所在。 (一)使用ShellExecuteEx運行item的基礎知識 ShellExecuteEx是windows95中新增的API函數, 在使用之前我們有必要對其進行一下
了解，現在我們對其進行詳細討論 Online Help 中的聲明如下﹕
WINSHELLAPI BOOL WINAPI ShellExecuteEx(
LPSHELLEXECUTEINFO lpExecInfo // pointer to SHELLEXECUTEINFO structure
);
這是一個C style的描述(Online Help中對于Win32 API的說明是從Microsoft SDK中
直接照搬下來的, 沒有使用Pascal style的語法說明), 為便于理解, 從ShellApi.Pas
中取出其Pascal style的描述 function ShellExecuteEx(lpExecInfo: PShellExecuteInfo):BOOL; stdcall; PShellExecuteInfoA = ^TShellExecuteInfoA;
PShellExecuteInfo = PShellExecuteInfoA;
TShellExecuteInfoA = record
cbSize: DWORD;
fMask: ULONG;
Wnd: HWND;
lpVerb: PAnsiChar;
lpFile: PAnsiChar;
lpParameters: PAnsiChar;
lpDirectory: PAnsiChar;
nShow: Integer;
hInstApp: HINST;
{ Optional fields }
lpIDList: Pointer;
lpClass: PAnsiChar;
hkeyClass: HKEY;
dwHotKey: DWORD;
hIcon: THandle;
hProcess: THandle;
end;
TShellExecuteInfo = TShellExecuteInfoA; 這個結构中包括了15個成員(在此我們只討論相關的几個) cbSize: DWORD
指明此結构的尺寸(bytes), 可以使用SizeOf(TShellExecuteInfo)取得。 fMask: ULONG;
指明其它成員的意義及有效性的標志, 可以是很多值的組合, 請詳見Online Help
和SDK有關文檔, 前面我們已經可以成功地取得 PItemIDList 并通過它取回了
Items的Display name, 因而我們感興趣的是 SEE_MASK_IDLIST 和
SEE_MASK_INVOKEIDLIST 這兩個Mask, Windows 95 Desktop 中的Items或稱為
Object 從行式上基本可分為兩類, 其一是文件夾類(Folder), 從Explorer中看
就是可以顯示在左側TreeView中的東西﹔剩下的就是文件類了, 不論是Application
還是Document還有等等其它的。我們采用 SEE_MASK_IDLIST 處理文件夾﹔
SEE_MASK_INVOKEIDLIST 來打開文件。另外還有一個SEE_MASK_FLAG_NO_UI,
可以在出現錯誤時禁止顯示MessageBox。 Wnd: HWND;
指明Parent的窗口Handle, 可以是Application.Handle或MainForm.Handle
(Delphi的Application是一個隱含的窗口，當然最終的MainForm也要被隱含－
對于這個Application它沒有任何顯示的必要) lpVerb: PAnsiChar;
已串的形式指明Application所執行的動作, 如 'open', 'explorer'等,
可采用默認值, 簡單的賦值為nil即可, 對其它無關的類似參數我們也采用
同樣的做法 lpFile, lpParameters, lpDirectory
這几個參數的意義從名稱上已經非常明确了, 同ShellExecute是一樣的,
因我們的程序中采用PItemIDList, 只是簡單的將其指向nil。 lpIDList: Pointer;
這是我們所取得的 PItemIDList 最終將要落腳的地方 既然用到了 PItemIDList 我們就需要將其暫存起來。同時由于運行Folder和
其它文件的不同, 還需要保存SHGetFileInfo所取回的信息。 (二)存儲PItemIDList和FileInfo 在Delphi中, 實現這一功能的方法有很多。但最根本的方法是先定義一個結构, type
PMenuItemType = ^TMenuItemType;
TMenuItemType = record
ID : PItemIDList;
Info : TSHFileInfo;
end; 然后可根据個人的偏好采用數組(陣列), 鏈表或干脆直接分配一大塊memory
對其直接采用指針定位(我偏愛在DOS下采用此方法)等等。
在這我采用Delphi提供的TList這個Object, 這是一個不很起眼但非常好用
的Object。 (PS:作完程序之后, 突然發現我忽略了一個更簡便的方法﹕將這個記錄(record)
指針通過強制類型轉換, 放到Tag這個property中可不用維護這個TList了--
寫完了就懶得改了, 記得很久以前在Apple II 上寫6502 ASM時可沒那麼輕松,
為了節省几個字節和几個時鐘周期,遇到這种事情是不能輕易讓它過去的; 現在
則不同啦, 是在用大量的資源和高速的CPU來換取開發的速度和更好的界面,
优化代碼﹖誰管呢﹖記得有一個叫 John C. Dvorak 的外國人在一篇名為
『我的机器人在哪儿﹖』的文章中寫到“令人奇怪的是，快的處理器總是傾向于
產生膨脹的代碼，而不是好的應用－當然有人會說﹕處理器快一些才能運行高端
的圖形和多媒体應用。......很快我的台式机上就會有一個每秒能運行几十億條
指令的處理器了，但用它來干什麼﹖運行Word﹖下載一個WEB頁﹖玩
Duke Nukem 8D﹖我的机器人在哪里呢﹖”, 不過如果時間允許
的話我們還是應該盡可能地优化我們的代碼, 真的很想念以前的那段時光) (三)完善FillMenuItemsFromShellFolder
好了, 現在增加一個叫FMenuItemList的private TList型變量, 在MainForm
的OnCreate事件中加入 FMenuItemList := TList.Create;
//獲得Task allocator
if SHGetMalloc(imShellAllocator) <> NOERROR then
begin
Application.MessageBox('無法取得 IMalloc',
'運行錯誤', MB_ICONSTOP or MB_OK);
Exit;
end; 將FRetrieveItemFlag改為SHGFI_DISPLAYNAME or SHGFI_PIDL or SHGFI_ATTRIBUTES;
因為我們需要用Attributes來确定Item的類型。 在OnClose事件中加入
//從FillMenuItemsFromShellFolder中移到此處
imShellAllocator.Release;
FMenuItemList.Free; 按下列代碼修改FillMenuItemsFromShellFolder函數 procedure TMainForm.FillMenuItemsFromShellFolder;
var
pceltFetched: ULONG;
tmpItemID: PItemIDList;
tmpItemInfo: TSHFileInfo;
ThisMenuItem: TMenuItem;
tmpMenuNo : Integer;
pItem: PMenuItemType;
tmpMenuItemInfo: TMENUITEMINFO;
begin //取回DesktopFolder對象
if SHGetDesktopFolder(isfDesktopFolder) <> NOERROR then
begin
Application.MessageBox('無法取得IShellFolder Object',
'運行錯誤', MB_ICONSTOP or MB_OK);
Exit;
end;
Caption := 'IShellFolder'; tmpMenuNo := 0;
//枚舉DesktopFolder中的Items
if isfDesktopFolder.EnumObjects (Application.Handle,
FEnumItemFlag,
ieDesktopItemsObj) <> NOERROR then
Application.MessageBox('無法EnumObject',
'運行錯誤', MB_ICONSTOP or MB_OK)
else
//第一次指向第一個PItemList, 每次取一個item
while NOERROR = ieDesktopItemsObj.Next(1, tmpItemID, pceltFetched) do
begin
//取得Item的有關信息
SHGetFileInfo( PChar(tmpItemID), 0, tmpItemInfo,
SizeOf(TSHFileInfo),
FRetrieveItemFlag);
New(pItem);
pItem^.ID := tmpItemID;
pItem^.Info := tmpItemInfo;
FMenuItemList.Add(pItem);
//建立這個MenuItem
ThisMenuItem:= TMenuItem.Create(DesktopMenu);
//填充MenuItem
with ThisMenuItem do
begin
//采用MenuItem序列號為其命名
Name := 'DesktopMenu_' IntToStr(tmpMenuNo);
Caption := StrPas(tmpItemInfo.szDisplayName);
//連接OnClick事件
OnClick := OnDesktopMenuClick;
end;
//添加到DesktopMenu中, 此為必須
DesktopMenu.Items.Add(ThisMenuItem);
Inc(tmpMenuNo);
end;
//釋放Desktop EnumObject
ieDesktopItemsObj.Release;
//釋放DesktopFolder Object
isfDesktopFolder.Release; end; 你可能會注意到imShellAllocator.Free(tmpItemID)被取消了, 這是由于在以后
我們需要它作為ShellExecuteEx的參數, 這樣我們就需要一個新方法(method)
procedure ReleaseShellFolderMenuItems來釋放它, 其在OnClose中執行 procedure TMainForm.ReleaseShellFolderMenuItems;
var
pItem: PMenuItemType;
tmpMenuItemInfo: TMENUITEMINFO;
begin
//釋放FMenuItemList
while FMenuItemList.Count > 0 do
begin
pItem := FMenuItemList.Items[0];
//釋放PItemIDList占用的memory
imShellAllocator.Free(pItem^.ID);
FMenuItemList.Delete(0);
end;
//Empty DesktopMenu, PItemIDList沒了MenuItem也就失去了存在的价值
while DesktopMenu.Items.Count > 0 do
DesktopMenu.Items.Delete(0);
end; (四)運行
為接收OnClick事件定義一個OnDesktopMenuClick(Sender: TObject)的方法,
我采用了從MenuItem的Name property中提取Item序列號的做法來确定是哪個
MwnuItem触發的事件, 并以其作為索引取出相應MenuItemType記錄。 procedure TMainForm.OnDesktopMenuClick(Sender: TObject);
var
i : Integer;
s : string;
pItem: PMenuItemType;
tmpMenuItemInfo: TMENUITEMINFO;
ExecItemInfo: TSHELLEXECUTEINFO;
begin
with (Sender as TMenuItem) do
begin
//取出序列號
s := Name;
System.Delete(s, 1, Pos('_', s));
i := StrToInt(s);
//取出record指針，若采用Tag此處就應為pItem := PMenuItemType(Tag);啦
pItem := FMenuItemList.Items[i];
//填充ShellExecuteEx
with ExecItemInfo do
begin
//struct size
cbSize := SizeOf(TSHELLEXECUTEINFO);
//Execute Folder and Execute File are both differents
if Bool(pItem^.Info.dwAttributes and SFGAO_FOLDER) then
//為Folder類型使用SEE_MASK_IDLIST mask
fMask := SEE_MASK_IDLIST or SEE_MASK_FLAG_NO_UI
else
//其它采用SEE_MASK_INVOKEIDLIST mask
fMask := SEE_MASK_INVOKEIDLIST or SEE_MASK_FLAG_NO_UI;
//parent window
Wnd := Application.Handle;
//Execute method
lpVerb := nil;
//Execute Filename
lpFile := nil;
lpParameters := nil;
lpDirectory := nil;
//Show command
nShow := SW_SHOWNORMAL;
//Application Instance
hInstApp := hInstance;
//將PItemIDList賦值給lpIDList成員，是我們此行的主要目的
lpIDList := pItem^.ID;
hkeyClass := 0;
dwHotKey := 0;
hIcon := 0;
hProcess := 0;
end;
//Call ShellExecuteEx method to Execute Selected item
ShellExecuteEx(@ExecItemInfo);
end;
end; 接下來的工作﹕編譯, 運行......
大功告成啦﹖NO﹗還遠不止如此，屏幕上還有一個MainForm--沒用。我們要將它
隱藏起來, 同時還要在StartBar的右邊加一個Tray Icon并讓它響應mouse的click
以彈出(popup)Desktop Menu, 還有......如果累了可以暫且休息一下或明天再干
或听听音樂......我等著你, 反正也沒有多少了。 第五步﹕在Tray Icon中添加Icon
Windows95推出不久, 就有許多類似的示范程序相繼推出, 我們只對其進行簡單
討論, 詳細資料請參考有關文檔。
在ShellApi.pas中有一個TNotifyIconData的record type是專門用于處理Tray
Icon 的數据類型, 定義如下﹕ TNotifyIconDataA = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array [0..63] of AnsiChar;
end; TNotifyIconData = TNotifyIconDataA; 其中,
cbSize 為結构的尺寸
Wnd 擁有者的窗口handle, 用于標識需要接收系統通知的窗口
uID 用戶自定義的標識號
uFlags 用于標識結构成員的有效性(也就是讓系統認可的那些成員,
可為下列值的組合﹕
NIF_ICON hIcon 成員是有效的
NIF_MESSAGE uCallbackMessage 成員是有效的
NIF_TIP szTip 成員是有效的
uCallbackMessage
用戶定義的回調(Callback)消息
hIcon Icon的handle
szTip HintWindow所顯示的提示信息 由于我們的目的是要在Tray上放一個Icon并能響應mouse click, 所以上述
的成員是我們所必須的。 首先定義消息常量
WM_TRAYICON = WM_USER 100;
WM_SHOWMENU = WM_USER 101; //以后我們會用到
WM_USER是Windows留給用戶自己定義消息的起點。 在MainForm的private段中添加 FTrayIconStruct: TNotifyIconData;
在OnCreate Event中添入﹕ with FTrayIconStruct do
begin
cbSize:= SizeOf(FTrayIconStruct);
Wnd:= Handle;
uID:= 1;
uFlags:= NIF_MESSAGE or NIF_ICON or NIF_TIP;
hIcon:= LoadIcon(HInstance, 'MAINICON');
uCallBackMessage := WM_TRAYICON;
szTip:= 'Hello Desktop Menu';
end;
//Register NotifyIcon
Shell_NotifyIcon(NIM_ADD, @FTrayIconStruct); 接下來, 我們還需要在程序中處理這個WM_TRAYICON消息 第六步﹕處理WM_TRAYICON和WM_SHOWMENU消息 Delphi中預定義了很多Windows本身的消息處理函數, 對于自定義的消息該如何
作呢﹖沒關系, 分析一下, 所有的消息無非就是一些integer罷了, 照著做就
可以了。 加入下面的函數定義 procedure WMTrayIcon(var Message: TMessage); message WM_TRAYICON; procedure TMainForm.WMTrayIcon(var Message: TMessage);
var
ACursorPos : TPoint;
begin
with Message do
case LParam of
WM_LButtonDown:
begin
GetCursorPos(ACursorPos);
PostMessage(Handle, WM_SHOWMENU, 0,
ACursorPos.x (AcursorPos.y shl 16));
end;
end;
end; 采用 case ... of 結构在此程序中并非絕對必要, 但從編程的觀點來考慮
可以為以后的擴充提供較好的基礎。PostMessage 亦處于同樣的目的。 Tip: 對于沒有接触過的(例如, procedure WMTrayIcon), 只要善于思考
找出其最根本的東西, 就可以做到“触類旁通”的效果。同時要為以后
做一些考慮, 真正的受益者是編程者自己。 同樣我們需要處理WM_SHOWMENU消息, 代碼很簡單 procedure WMShowMenu(var Message: TMessage); message WM_SHOWMENU; procedure TMainForm.WMShowMenu(var Message: TMessage);
begin
//首先將本程序切換到前台
SetForegroundWindow(Handle);
with Message do
DesktopMenu.Popup(LParamLo, LParamHi);
end; 第七步﹕隱藏MainForm 隱藏Form的做法有很多很多, 當然了最理想的做法是在user無法察覺的情況下
就將其隱藏起來, 所以只有直接在DPR文件中動手了。
在Application.Initialize;之后加入下面三行代碼
//不顯示MainForm
Application.ShowMainForm := False;
//建立Application的handle
Application.CreateHandle;
//隱藏Application, 從而只在Tray上留下一個Icon
ShowWindow(Application.Handle, SW_HIDE); 至此, 程序已經基本完成, 但只能算是在功能方面, 距一個性能齊備的軟件還有
很多地方不盡人意, 例如﹕
程序沒有設立退出口, (這不能不說是一個极大的缺陷)不能感知Desktop Items
的變化, 甚至還可以考慮在Desktop Menu放入items的icon, 就象Windows95的
StartMenu一樣等等... 不過我們現在的目的是在討論如何建立Desktop Menu
這樣的程序的方法。若要編寫一個實用的Desktop Menu我認為不應采用Delphi
的VCL, 應采用Windows的標准消息循環体系, 最起碼可節省很多寶貴的資源。
有興趣的讀者可以自己嘗試去編寫一個真正的Desktop Menu﹗ 作者的話 最近作者本人在空余時間里經常做一些有關Windows95 Shell方面的編程, 此篇
文章就是將編程當中的一些收獲, 經整理后寫出的, 由于水平有限, 文章中難免
存在這樣或那樣的錯誤, 請多包含。另計划編寫一系列以實戰為基礎, 面向
Windows95 shell和Api等相關議題的文章, 內容以自己在寫AP時所遇到的問題
為主, 真心希望看過此篇文章的讀者能提出一些寶貴的建議(PS:無論贊助与否)
可以是議題方向方面的或是您需要什么等等, 總之無論什么方面的建議, 都會
得到我對您的深深謝意和永久的祝福。
如果你在閱讀時遇到什么問題, 或者您有更好的建議請用mail通知我, 謝謝。 --------------------------------------------------------------------------------
Copyright Homearts software lib.
作者﹕王學胜
wxsheng@public.tpt.tj.cn *********************************************************
哈哈&兵燹
最會的2大絕招 這個不會與那個也不會 哈哈哈 粉好 Delphi K.Top的K.Top分兩個字解釋Top代表尖端的意思,希望本討論區能提供Delphi的尖端新知
K.表Knowlege 知識,就是本站的標語:Open our mind to make knowledge together!
希望能大家敞開心胸,將知識寶庫結合一起
------
********************************************************** 哈哈&兵燹 最會的2大絕招 這個不會與那個也不會 哈哈哈 粉好 Delphi K.Top的K.Top分兩個字解釋Top代表尖端的意思,希望本討論區能提供Delphi的尖端新知 K.表Knowlege 知識,就是本站的標語:Open our mind |
|
LovingTse
一般會員   發表：1 回覆：1 積分：0 註冊：2004-10-24 發送簡訊給我 |
發表時間：2003-02-11 18:44:54
IP:61.221.xxx.xxx 未訂閱
系統時間：2024-05-05 6:18:34
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |