改变自己
我可以改变世界 改变自己

格式

Delphi syntax:

On Windows:

  function SelectDirectory(const Caption: string; const Root: WideString; out Directory: string): Boolean;

On Linux:

  function SelectDirectory(const Caption: WideString; const Root: string; var Directory: string; ShowHidden: Boolean = False): Boolean;

 

SelectDirectory弹出对话框让用户选择目录,不改变目录的键值,在linux和windows中格式有所不同,

caption标题是长字符串

const Root指定浏览的根目录

out Directory返回所选目录

ShowHidden标识所选目录是否显示隐藏子目录

例:

uses FileCtrl;

 

const

  SELDIRHELP = 1000;

procedure TForm1.Button1Click(Sender: TObject);

var

  Dir: string;

begin

  Dir := 'C:\MYDIR';

  if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP) then

    Label1.Caption := Dir;

end;

 

由于显示的对话框不是居中显示 重新定义函数在程序中

uses  

      ShlObj,   ActiveX;   //必须的控件包

   

  function   SelectDirectory(const   Caption:   string;   const   Root:   WideString;  

      OwnerWindow:   THandle;   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   :=   OwnerWindow;  

                  pidlRoot   :=   RootItemIDList;  

                  pszDisplayName   :=   Buffer;  

                  lpszTitle   :=   PChar(Caption);  

                  ulFlags   :=   BIF_RETURNONLYFSDIRS;  

              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.Button1Click(Sender:   TObject);  

  var  

      vDirectory:   string;

  begin  

      SelectDirectory('Select   Path',   '',   Handle,   vDirectory); //此处handle即是窗口位置句柄

  end;  

posted on 2009-01-19 14:12  dashan  阅读(2485)  评论(0编辑  收藏  举报