SelectDiretory

本文转载自我2004年在csdn发布的博客，原文于2000年发布阿甘的家。

Delphi里有个函数SelectDiretory，重载了两种形式：

function SelectDirectory(const Caption: string; const Root: WideString; out Directory: string): Boolean; overload; 
function SelectDirectory(var Directory: string; Options: TSelectDirOpts; HelpCtx: Longint): Boolean; overload; 

按第一种方式可以调用Win32的标准选择目录对话框，第二种方式弹出的则是Delphi自定义风格的对话框。我们编程常用的是第一种，但我在使用中发现，用该函数不能初始化对话框的起始目录，如右图：希望对话框弹出时就定位到某个目录，是办不到的。

我从来是单干，自然很久都没有找到答案，直到有一天终于注册上了“大富翁”（其实我很久以前就知道大富翁论坛了，只是一直注册不了），我提出的问题就是“如何指定SelectDirectory的起始目录”。问题很快得到了解答，答案是由cAkk提供的，如下：

给那个窗口发消息可以设置路径：

SendMessage(
  Hwnd,
  BFFM_SETSELECTION, 
  Ord(TRUE), 
  Longint(PChar(Path))
  ); 

关键是如何得到该窗口的句柄？

Borland在写SelectDirectory函数时省略了BrowseInfo的lpfn属性，这个属性指向一个CallBack函数,可以实现你的程序和该对话框窗口的通讯.该Callback函数声明为：

int BrowseCallbackProc(
  HWND hwnd,
  UINT uMsg,
  LPARAM lParam,
  LPARAM lpData
  );

其中,HWND参数就是传递过来的该对话框的句柄,得到这个句柄,你就可以用我前面说的SendMessage设置路径了。

还有一点,你应该在BrowseCallbackProc函数里判断当接受到BFFM_INITIALIZED消息时设置路径,也就是说：uMsg:=BFFM_INITIALIZED的时候。

具体实现如下，需要注意的几点是：

不能再用SelectDirectory函数（要不就修改它的源代码），需要直接调用API函数ShBrowseForFolder。
要把shlobj和AcriveX两个单元包含进去。

unit 
  Unit1; 
interface 
uses
  shlobj,ActiveX;

var
  Form1: TForm1; 
  Path: string; //起始路径

implementation 
{$R *.DFM} 

function BrowseCallbackProc(hwnd: HWND;uMsg: UINT;lParam: Cardinal;lpData: Cardinal): integer; stdcall; 
begin 
  if uMsg=BFFM_INITIALIZED then 
    result :=SendMessage(Hwnd,BFFM_SETSELECTION,Ord(TRUE),Longint(PChar(Path)))
  else
    result :=1 
end; 

function SelDir(const Caption: string; const Root: WideString; out Directory: string): Boolean; 
var
　WindowList: Pointer; 
　BrowseInfo: TBrowseInfo; 
  Buffer: PChar; 
  RootItemIDList, ItemIDList: PItemIDList; 
  ShellMalloc: IMalloc; 
  IDesktopFolder: IShellFolder; 
  Eaten, Flags: LongWord; 
begin 
  Result := False; 
  Directory := ''; 
  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 :=@BrowseCallbackProc;
        lParam :=BFFM_INITIALIZED;  
      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; 

procedure TForm1.SpeedButton1Click(Sender: TObject); 
var 
　Path1: string; begin 
  Path :=Edit1.Text; 
  SelDir('SelectDirectory Sample','', Path1); 
  Edit1.Text :=Path1 
  end; 
end. 

——谨以怀念写Delphi的青春岁月

FEATURED TAGS

FRIENDS