SelectDirectory使用方法

來源:互聯網
上載者:User

格式

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;  

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.