|
Window SubClassing另类运用（之二）
你大概已经熟悉通用对话框（打开/保存文件，选择字体/颜色，以及查找和替换）的使用，不过你是否了解如何调用“选择文件夹”对话框呢？如果答案是否的话，你可以先看看一个简单的例子，籍以做个热身。如果你自认为已经了解它的话，可以跳过下面这一段。
要调用“选择文件夹”对话框，和其他通用对话框所使用的方法非常类似：一个结构（BROWSEINFO）加一个函数（SHBrowseForFolder）即可。请看代码：
procedure TForm1.Button2Click(Sender: TObject);
var
bi : BROWSEINFO;
szDisplay : array[0..MAX_PATH] of char;
pidl : PItemIDList;
str : string;
begin
with bi do begin
hwndOwner := Handle;
pidlRoot := nil;
pszDisplayName := szDisplay;
lpszTitle := ''''Select a Directory'''';
ulFlags := BIF_RETURNONLYFSDIRS or BIF_STATUSTEXT;
lpfn := @BrowseCallback;
lParam := 0;
end;
pidl := SHBrowseForFolder(bi);
if pidl<>nil then begin
SetLength(str, MAX_PATH);
SHGetPathFromIDList(pidl, PChar(str));
str := PChar(str);
Caption := str;
CoTaskMemFree(pidl);
end;
end;
SHBrowseForFolder返回一个LPITEMIDLIST，你需要手动将它转换成一个实际的文件路径（除非你选择的是回收站和控制面板这样的虚拟路径）。最后还要用Shell API把获得的pidl释放。上述代码中，BrowseCallback是一个自己编写的回调函数，如果不想处理回调的话，可以将它设置为nil。我还是处理了这个函数，因为我需要它的一些功能，如下：
function BrowseCallback(AWnd:HWND; uMsg:UINT; lp, lpData:LPARAM):Integer; stdcall;
var
strPath : string;
pidl : PItemIDList;
begin
case uMsg of
BFFM_SELCHANGED:
begin
pidl := PItemIDList(lp);
if pidl<>nil then begin
SetLength(strPath, MAX_PATH);
SHGetPathFromIDList(pidl, PChar(strPath));
strPath := PChar(strPath);
strPath := ''''folder Selected: '''' + strPath;
SendMessage(AWnd, BFFM_SETSTATUSTEXT, 1, LongInt(PChar(strPath)));
end;
end;
end;
Result := 0;
end;
BrowseCallback函数可以接受一些通知消息，例如上面列出的BFFM_SELCHANGED，当用户在文件夹列表中选择了另外一个项目的时候就会触发，程序员可以用另外一些消息（如BFFM_SETSTATUSTEXT）更新对话框其他相应的部分。
对SHBrowseForFolder的介绍说这么多也就足够了。不过，我对于这样单调的界面并不满意。一个最直接的想法就是：希望在对话框中添加一个列表，其中列出一些常用的文件夹供用户选择，而不需要每次都在“庭院深深”的层次树中一次再一次的Click。这又是一个使用SubClass的好地方。还记得在本文的系列之一中我提到的吗？要使用SubClass技术，充分必要条件就是获得一个窗口的句柄。非常幸运，这里我们有很简单的办法能够得到这个句柄，因为对话框初始化成功后会向上述的回调函数发送BFFM_INITIALIZED通知，我们的SubClass工作就在这里完成。
在上述的BrowseCallback函数中添加如下的Message Dispatcher：
case uMsg of
BFFM_INITIALIZED:
begin
OldBrowseProc := TWindowProc(GetWindowLong(AWnd, GWL_WNDPROC));
SetWindowLong(AWnd, GWL_WNDPROC, LongInt(@NewBrowseProc));
AdjustDlg(AWnd);
end;
其中，OldBrowseProc是在implementation部分声明的变量：
var
OldBrowseProc : TWindowProc = nil;
而NewBrowseProc和AdjustDlg都是自己编写的函数，它们都比较长，我将分段讲述它们的内容。
先来看AdjustDlg的工作。它的任务是向对话框中添加一个组合框（Combo Box），并且向其中添加几个项目。听起来很简单，不过有许多琐碎的工作必须要做。因为我们是在对系统定义的窗口进行SubClass，所以VCL在这里基本上帮不上什么忙：我们必须大量使用API。
procedure AdjustDlg(AWnd:HWND);
var
wnd : HWND;
wndCombo : HWND;
rc : TRect;
Found : Boolean;
ClassName : array[0..80] of char;
SaveRect : TRect;
OldStyle : integer;
begin
// Find the TreeView first
wnd := GetWindow(AWnd, GW_CHILD);
[1] [2] [3] [4] 下一页
[常用软件]Window Media Player 播放器 [Delphi程序]Window SubClassing之另类运用（之一）
[Delphi程序]override deal with window closing in database … [Delphi程序]Window 消息大全使用详解
[网页制作]Chromeless Window For IE6 SP1 [网页制作]关于Web设计、开发中window对象的资料
[Web开发]JavaScript : WINDOW FOR JAVASCRIPT [Web开发]JavaScript关于window.open()应用
[Web开发]关于Web设计、开发中window对象的资料 [Web开发]Javascript：window对象的方法
| 
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
