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);
Found := False;
while IsWindow(wnd) do begin
GetClassName(wnd, ClassName, 80);
if lstrcmpi(ClassName, 'SysTreeView32')=0 then begin
Found := True;
Break;
end;
wnd := GetWindow(wnd, GW_HWNDNEXT);
end;
if not Found then Exit;
为了能够让插入的ComboBox和其他窗口控件的布局协调一致，首先需要找到用来显示文件夹的TreeView窗口。我的计划是：让ComboBox占据TreeView原来的位置（当然它的高度要比TreeView小得多），然后，包括TreeView在内的其他窗口依次下移。下面是实现代码：
// Add combo Box and move other controls down
GetWindowRect(wnd, rc);
ScreenToClient(AWnd, rc.TopLeft);
ScreenToClient(AWnd, rc.BottomRight);
wndCombo := CreateWindow('COMBOBOX', '',
WS_CHILD or WS_VISIBLE or CBS_DROPDOWNLIST or CBS_OWNERDRAWFIXED or CBS_HASSTRINGS,
rc.Left, rc.Top,
rc.Right-rc.Left, rc.Bottom-rc.Top,
AWnd, HMENU(IDC_COMBO),
HInstance, nil);
SendMessage(wndCombo, WM_SETFONT,
SendMessage(AWnd, WM_GETFONT, 0, 0),
1);
OldStyle := GetWindowLong(wnd, GWL_STYLE);
SetWindowLong(wnd, GWL_STYLE, OldStyle or TVS_SHOWSELALWAYS);
SaveRect := rc;
wnd := GetWindow(AWnd, GW_CHILD);
while IsWindow(wnd) do begin
GetWindowRect(wnd, rc);
ScreenToClient(AWnd, rc.TopLeft);
ScreenToClient(AWnd, rc.BottomRight);
if (wnd<>wndCombo) and (rc.Top>=SaveRect.Top) then
SetWindowPos(wnd, HWND_NOTOPMOST, rc.Left, rc.Top+40, 0, 0, SWP_NOSIZE or SWP_NOZORDER);
wnd := GetWindow(wnd, GW_HWNDNEXT);
end;
GetWindowRect(AWnd, rc);
SetWindowPos(AWnd, HWND_NOTOPMOST, 0, 0, rc.Right-rc.Left, rc.Bottom-rc.Top+40, SWP_NOMOVE or SWP_NOZORDER);
如果你过去很少用API写程序，那么这些代码可能让你看得有点头晕。基本上上述程序完成如下的工作：
（1）计算TreeView在窗口中的位置；
（2）建立ComboBox窗口，并基于TreeView的位置将它放置到合理的地方；
（3）将ComboBox的字体设置为和整个窗体的字体相同（这一步是必要的，否则显示的效果会很难看）；
（4）为TreeView的窗口风格添加TVS_SHOWSELALWAYS位，从而在焦点移动到ComboBox的时候，仍然可以明显的观察到TreeView中究竟选中了哪个项目；
（5）将窗口中的其他控件依次下移，从而为ComboBox腾出必要的空间；
（6）将窗口本身的高度也略微放大，从而适应添加ComboBox以后的大小。
下一步就是向ComboBox中增加一些表项，否则的话它就是一个鸡肋。我决定添加两种项目：（1）系统中的某些特殊路径，这些路径可以通过SHGetSpecialFolderLocation获得；（2）通常的文件路径。为了让代码简洁一些，我增加了一个辅助函数：
procedure InsertComboItem(hCombo:HWND; const Text:string; data:DWORD);
var
nIndex : integer;
begin
nIndex := SendMessage(hCombo, CB_ADDSTRING, 0, LongInt(PChar(Text)));
SendMessage(hCombo, CB_SETITEMDATA, nIndex, data);
end;
然后在AdjustDlg函数的末尾添加如下的代码：
InsertComboItem(wndCombo, '', CSIDL_DESKTOP);
InsertComboItem(wndCombo, '', CSIDL_FAVORITES);
InsertComboItem(wndCombo, '', CSIDL_STARTMENU);
InsertComboItem(wndCombo, '', CSIDL_DRIVES);
InsertComboItem(wndCombo, 'c:\', 555);
InsertComboItem(wndCombo, 'd:\winnt', 555);
InsertComboItem(wndCombo, 'c:\windows\system', 555);
这里用555并没有什么特别的意义。我本来想用0来标志普通文件夹，但后来发现CSIDL_DESKTOP正是定义为0，所以必须用其他数字来区分。555是我信手写的，你当然可以用别的数字，只要注意不要和预定义的CSIDL常量冲突即可。
AdjustDlg函数的内容就这么多。接下来是NewBrowseProc函数的内容，它的基本结构如下：
function NewBrowseProc(AWnd:HWND; uMsg:UINT; wp:WPARAM; lp:LPARAM):LongInt; stdcall;
begin
Result := 0;
case uMsg of
…
end;
if Assigned(OldBrowseProc) then
Result := OldBrowseProc(AWnd, uMsg, wp, lp);
end;
在NewBrowseProc中必须处理几条消息。第一个就是用户在ComboBox中选择一项的时候，在TreeView中必须同步跳转到同样的文件夹：
case uMsg of
WM_COMMAND:
if HiWord(wp)=CBN_SELCHANGE then begin
hCombo := GetDlgItem(AWnd, IDC_COMBO);
index := SendMessage(hCombo, CB_GETCURSEL, 0, 0);
if index=CB_ERR then Exit;
csidl := SendMessage(hCombo, CB_GETITEMDATA, index, 0);
if csidl<>555 then begin // csidl
SHGetSpecialFolderLocation(AWnd, csidl, pidl);
SendMessage(AWnd, BFFM_SETSELECTION, 0, LongInt(pidl));
CoTaskMemFree(pidl);
end
else begin // normal Folder
SetLength(str, MAX_PATH);
SendMessage(hCombo, CB_GETLBTEXT, index, LongInt(PChar(str)));
str := PChar(str);
SendMessage(AWnd, BFFM_SETSELECTION, 1, LongInt(PChar(str)));
end;
end;
由于我们添加的ComboBox是一个自绘风格（Owner-Draw）的列表，所以我们还必须处理WM_MEASUREITEM和WM_DRAWITEM消息。WM_MEASUREITEM的处理相对简单，因为对于ComboBox来说项目的宽度无所谓（它自动由ComboBox本身的宽度来决定），我们只需要设置它的高度即可。为了简化起见，我用了硬编码的方法，当然基于系统设置进行仔细的计算也是可行的（而且完全应该）：
WM_MEASUREITEM:
begin
pmis := PMEASUREITEMSTRUCT(lp);
if pmis^.CtlType=ODT_COMBOBOX then
pmis^.itemHeight := 20;
end;
其中pmis声明为一个PMEASUREITEMSTRUCT结构指针。
WM_DRAWITEM的处理要复杂的多。因为对于系统级的文件夹，必须从System ImageList中获得它的图标，而且还要从LPITEMIDLIST取得文件夹的名称（不一定是文件路径：比如，c:\windows\desktop在Shell中的名称是“桌面”）。为此我添加了几个辅助函数，用来简化WM_DRAWITEM的处理：
function GetNameFromPIDL(pidl:PItemIDList) : string;
var
sfi : SHFILEINFO;
begin
SHGetFileInfo(PChar(pidl), 0, sfi, sizeof(sfi), SHGFI_DISPLAYNAME or SHGFI_PIDL);
Result := StrPas(sfi.szDisplayName);
end;
function GetPathFromPIDL(pidl:PItemIDList) : string;
var
str : string;
begin
SetLength(str, MAX_PATH);
SHGetPathFromIDList(pidl, PChar(str));
str := PChar(str);
Result := str;
end;
procedure GetSmallIconFromPIDL(pidl:PItemIDList; var iml:HIMAGELIST; var index:integer);
var
sfi : SHFILEINFO;
begin
iml := SHGetFileInfo(PChar(pidl), 0, sfi, sizeof(sfi), SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_PIDL);
index := sfi.iIcon;
end;
procedure GetSmallIconFromPath(const Path:string; var iml:HIMAGELIST; var index:integer);
var
sfi : SHFILEINFO;
begin
iml := SHGetFileInfo(PChar(Path), 0, sfi, sizeof(sfi), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
index := sfi.iIcon;
end;
处理项目绘制的代码其实从原理上来讲非常简单，但是比较琐碎，必须大量调用SendMessage和Shell API接口函数，还包括GDI对象的管理。我不打算仔细解释下面这些代码；这些代码的效果就是在ComboBox中为每一个项目前面添加一个代表其文件夹的图标。
WM_DRAWITEM:
begin
pdis := PDRAWITEMSTRUCT(lp);
if pdis^.CtlType=ODT_COMBOBOX then begin
hCombo := pdis^.hwndItem;
if pdis^.itemID=$ffffffff then Exit;
csidl := DWORD(SendMessage(hCombo, CB_GETITEMDATA, pdis^.itemID, 0));
if (pdis^.itemState and ODS_SELECTED)=ODS_SELECTED then begin
FillRect(pdis^.hDC, pdis^.rcItem, GetSysColorBrush(COLOR_HIGHLIGHT));
SetTextColor(pdis^.hDC, GetsysColor(COLOR_HIGHLIGHTTEXT));
end
else begin
FillRect(pdis^.hDC, pdis^.rcItem, GetSysColorBrush(COLOR_WINDOW));
SetTextColor(pdis^.hDC, GetSysColor(COLOR_WINDOWTEXT));
end;
SetBkMode(pdis^.hDC, TRANSPARENT);
if csidl<>555 then begin // csidl
SHGetSpecialFolderLocation(AWnd, csidl, pidl);
str := GetNameFromPIDL(pidl);
GetSmallIconFromPIDL(pidl, himl, iImage);
ImageList_Draw(himl, iImage, pdis^.hDC, pdis^.rcItem.Left+2, pdis^.rcItem.Top+2, ILD_TRANSPARENT);
Inc(pdis^.rcItem.Left, 20);
DrawText(pdis^.hdc, PChar(str), -1, pdis^.rcItem, DT_SINGLELINE or DT_LEFT or DT_VCENTER);
CoTaskMemFree(pidl);
end
else begin // normal path
SetLength(str, MAX_PATH);
SendMessage(hCombo, CB_GETLBTEXT, pdis^.itemID, LongInt(PChar(str)));
str := PChar(str);
GetSmallIconFromPath(str, himl, iImage);
ImageList_Draw(himl, iImage, pdis^.hDC, pdis^.rcItem.Left+2, pdis^.rcItem.Top+2, ILD_TRANSPARENT);
Inc(pdis^.rcItem.Left, 20);
DrawText(pdis^.hDC, PChar(str), -1, pdis^.rcItem, DT_SINGLELINE or DT_LEFT or DT_VCENTER);
end;
end;
end;
