完整範例 - Fontlist (8/10)

　　到此為止，對系統字型的處理告一段落，剩下的是目錄字型的處理。首先，我們要讓使用者選擇目錄（SelectFolder），這是十分簡單的事：

function TForm1.SelectFolder: string;
begin
  Result:=FFolder;
  if not BrowseDirectory('Please select a font folder', '', result)
    then result:='';
end;

　　如果把BrowseDirectory改成SelectDirectory，再加上uses FileCtrl;，本篇的內容便算完成了。但是因為SelectDirectory有很多缺點（SelectDirectory有兩種形式，其中一種是舊式的Win32式的界面，用來很覺別扭，另一種（SelectFolder（Caption, Root, Dir)）是Win NT的風格，但是它對話框出現的位置有時很奇怪，而且對話框出現時，選取的是根目錄(Root)，而不是舊目錄(Dir)，所以使用者每一次都要從設定的根目錄找起，這用起來十分煩人），為了程序員的尊嚴，我們當然不然讓這種缺點留著，所以我們使用了BrowseDirectory，它的代碼如下。

var
  StartDirectryCallBack: string='';

function BrowseDialogCallBack (Wnd: HWND; uMsg: UINT; _lParam, _lpData: LPARAM):
  integer stdcall;  // Called back by BrowseDirectory
var
  wa, rect: TRect;
  dialogPT: TPoint;
begin
  if uMsg=BFFM_INITIALIZED then
  begin
    SystemParametersInfo(SPI_GETWORKAREA, 0, @wa, 0);
    GetWindowRect(Wnd, Rect);
    dialogPT.X:=((wa.Right-wa.Left) div 2) -
                ((rect.Right-rect.Left) div 2);
    dialogPT.Y:=((wa.Bottom-wa.Top) div 2) -
                ((rect.Bottom-rect.Top) div 2);
    MoveWindow(Wnd, dialogPT.X, dialogPT.Y,
               Rect.Right-Rect.Left, Rect.Bottom-Rect.Top, True);
    if StartDirectryCallBack<>'' then
      SendMessage(Wnd,BFFM_SETSELECTION, 1, Integer(@StartDirectryCallBack[1]));
  end;
  Result:=0;
end;

function BrowseDirectory(const Caption: string; const Root: WideString;
  var Directory: string): Boolean;
var
  WindowList: Pointer;
  BrowseInfo: TBrowseInfo;
  Buffer: PChar;
  RootItemIDList, ItemIDList: PItemIDList;
  ShellMalloc: IMalloc;
  IDesktopFolder: IShellFolder;
  Eaten, Flags: LongWord;
begin
  Result:=False;
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(ShellMalloc)=S_OK) and (ShellMalloc<>nil) then
  begin
    Buffer:=ShellMalloc.Alloc(MAX_PATH);
    try
      RootItemIDList:=nil;
      if Root <> '' then
      begin
        SHGetDesktopFolder(IDesktopFolder);
        IDesktopFolder.ParseDisplayName(Application.Handle, nil,
          POleStr(Root), Eaten, RootItemIDList, Flags);
      end;
      with BrowseInfo do
      begin
        hwndOwner:=Application.Handle;
        pidlRoot:=RootItemIDList;
        pszDisplayName:=Buffer;
        lpszTitle:=PChar(Caption);
        ulFlags:=BIF_RETURNONLYFSDIRS;
        lpfn:=BrowseDialogCallBack;
        StartDirectryCallBack:=Directory;
      end;
      WindowList:=DisableTaskWindows(0);
      try
        ItemIDList:=ShBrowseForFolder(BrowseInfo);
      finally
        EnableTaskWindows(WindowList);
      end;
      Result:= ItemIDList<>nil;
      if Result then
      begin
        ShGetPathFromIDList(ItemIDList, Buffer);
        ShellMalloc.Free(ItemIDList);
        Directory:=Buffer;
      end;
    finally
      ShellMalloc.Free(Buffer);
    end;
  end;
end;

　　BrowseDirectory和SelectDirectory所用的方法基本一樣，只是前者在Callback函數中調整了對話框的位置，以及選擇了舊目錄。代碼較長和复雜，不一一說明，有興趣的朋友可以自行研究。