directorylistbox是不能实现这个功能的,用API吧SHBrowseForFolder

解决方案 »

  1.   

    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; var 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 //设置ROOT路径,只显示ROOT以下的文件及文件夹
            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','C:\windows',Path1); //只显示C:\windows下的文件及文件夹
      Edit1.Text :=Path1; //用户选择的目录
    end; end.