在程序中添加一个浏览文件夹的功能

Question

用shBrowseForFolder函数
//uses unit shlobj
procedure TForm1.Button1Click(Sender: TObject);
var
  brow : _browseinfoA;
begin
  FillChar(Brow, SizeOf(Brow), 0);
  Brow.hwndOwner := Form1.Handle ;
  brow.ulFlags := BIF_RETURNONLYFSDIRS;
  Brow.lpszTitle := 'Select A Directory';
  ShBrowseForFolder(Brow);
end;

Answer 1

To hzzkf:
　　同意hubdog，注意它有两个原型，打开不同的对话框：一个就是你所说的，另外一个是Windows 3.x风格的，如果你用过的话。在程序中一定加入下面一句：uses ..., FileCtrl;To　AcherMagic：
　　为什么不用现成的呢？

Answer 2

用了我写这个控件，应该没问题。
或者你去深度历险去down一些类似的控件
一大堆
unit CXBrowseDlg;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,shlobj,
  ActiveX;type
  TEnableOperation=(eoNone,eoEnable,eoDisable);  TFolderID = (
    fiAltStartUp,fiAppData,fiBitBucket,fiCommonAltStartUp,fiCommonDesktopDirectory,
    fiCommonFaverites,fiCommonPrograms, fiCommonStartMenu,fiCommonStartUp ,fiControls,
    fiCookies,fiDesktop,fiDesktopDirectory,fiDrives,fiFavorites,fiFonts,fiHistory,
    fiInternet,fiInternetCache,fiNetHood,fiNetwork,fiPersonal,fiPrinters,fiPrintHood,
    fiPrograms,fiRecent,fiSendTo,fiStartMenu,fiStartUp,fiTemplates);
    
  TCXBrowseDlgOption=(fdBrowseForComputer,fdBrowseForPrinter,fdBrowseInclueFiles,
    fdDontGoBelowDomain,fdEditBox,fdReturnFSAncestors,fdReturnOnlyFSDirs,fdStatusText,
    fdValidate);  TCXBrowseDlgOptions=set of TCXBrowseDlgOption;  TBrowseChangeProc=procedure (Handle:HWnd;LParam:lparam;DisplayText:Boolean;var StatusText:string;
    var EnableOperation:TEnableOperation) of object;  TBrowseValidateProc=procedure (Handle:HWnd;ErrorInput:String) of object;  TCXBrowseDlg = class(TComponent)
  private
    { Private declarations }
    FDirectory:String;
    FDisplayName:string;
    //FOnBrowseInfo:TBrowseProc;
    FOnChange:TBrowseChangeProc;
    FOnValidateFailed:TBrowseValidateProc;
    FOptions:TCXBrowseDlgOptions;
    FRoot:TFolderId;
    FTitle:String;
    procedure SetOptions(Value:TCXBrowseDlgOptions);
    { Protected declarations }
  public
    { Public declarations }
    //property ItemID:PItemIDList read FItemID write SetItemID;
  published
    { Published declarations }
    constructor Create(AOwner:TComponent);override;
    function Execute:Boolean;
    property Title:string read FTitle write FTitle ;//default '浏览文件夹';//运行时只读
    property Options:TCXBrowseDlgOptions read FOptions write SetOptions;//FOptions default [];
    property Root:TFolderId read FRoot write FRoot default fiDesktop;
    property Directory:String read FDirectory;// write FDirectory;// default '';只读
    property DisplayName:string read FDisplayName;
    property OnChange: TBrowseChangeProc read FOnChange write FOnChange;
    property OnValidateFailed: TBrowseValidateProc read FOnValidateFailed write FOnValidateFailed;
  end;procedure Register;implementationprocedure Register;
begin
  RegisterComponents('CXLib', [TCXBrowseDlg]);
end;function BrowseCallBack(Wnd: HWND; uMsg: UINT; Param, Data: LPARAM): Integer stdcall;
var
  StatusText:String;
  PStatusText:PChar;
  FolderDialog:TCXBrowseDlg;
  EditText:AnsiString;
  EnableOperation:TEnableOperation;
begin
  FolderDialog:=ptr(Data);
  EnableOperation:=eoNone;
  GetMem(PStatusText,256);
  case uMsg of
    BFFM_SELCHANGED:
      begin
        if assigned(FolderDialog.OnChange) then
        begin
          if (fdStatusText in FolderDialog.Options) then
            FolderDialog.OnChange(Wnd,param,true,StatusText,EnableOperation)
          else
            FolderDialog.OnChange(Wnd,param,false,StatusText,EnableOperation);
          if (fdStatusText in FolderDialog.Options) then
            SendMessage(Wnd,BFFM_SETSTATUSTEXT,0,integer(StrPCopy(PStatusText,StatusText)));//注意Pchar的处理不太好
          case EnableOperation of
            eoEnable:SendMessage(Wnd,BFFM_ENABLEOK,0,1);
            eoDisable:SendMessage(Wnd,BFFM_ENABLEOK,0,0);
          end;
        end;
      end;
    BFFM_VALIDATEFAILED:
      begin
        if Assigned(FolderDialog.OnValidateFailed) then
        begin
          EditText:=Pchar(ptr(param));
          FolderDialog.OnValidateFailed(wnd,EditText);//Pchar和String的互换？
        end;
      end;
  end;
  FreeMem(PStatusText,256);
  result:=1;
end;constructor TCXBrowseDlg.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FDisplayName:='';
  FOptions:=[];
  FRoot:=fiDesktop;
  FTitle:='浏览文件夹';
end;procedure TCXBrowseDlg.SetOptions(Value:TCXBrowseDlgOptions);
begin
  FOptions:=Value;
  if ((fdValidate in FOptions) and (not(fdEditBox in FOptions))) then
    FOptions:=FOptions + [fdEditBox];
end;function TCXBrowseDlg.Execute:Boolean;
const
  DialogOptions: array[TCXBrowseDlgOption] of DWORD = (
    BIF_BROWSEFORCOMPUTER,BIF_BROWSEFORPRINTER,BIF_BROWSEINCLUDEFILES,BIF_DONTGOBELOWDOMAIN,
    BIF_EDITBOX,BIF_RETURNFSANCESTORS,BIF_RETURNONLYFSDIRS,BIF_STATUSTEXT,BIF_VALIDATE);
const
  FolderIDs: array[TFolderID] of integer = (
    CSIDL_ALTSTARTUP,CSIDL_APPDATA,CSIDL_BITBUCKET,CSIDL_COMMON_ALTSTARTUP,CSIDL_COMMON_DESKTOPDIRECTORY,
    CSIDL_COMMON_FAVORITES,CSIDL_COMMON_PROGRAMS,CSIDL_COMMON_STARTMENU,CSIDL_COMMON_STARTUP,
    CSIDL_CONTROLS,CSIDL_COOKIES,CSIDL_DESKTOP,CSIDL_DESKTOPDIRECTORY,CSIDL_DRIVES,CSIDL_FAVORITES,
    CSIDL_FONTS,CSIDL_HISTORY,CSIDL_INTERNET,CSIDL_INTERNET_CACHE,CSIDL_NETHOOD,CSIDL_NETWORK,
    CSIDL_PERSONAL,CSIDL_PRINTERS,CSIDL_PRINTHOOD,CSIDL_PROGRAMS,CSIDL_RECENT,CSIDL_SENDTO,CSIDL_STARTMENU,
    CSIDL_STARTUP,CSIDL_TEMPLATES);
var
  BrowseInfo: TBrowseInfo;
  Option:TCXBrowseDlgOption;
  RootIDList,ItemIDList: PItemIDList;
  DisplayBuffer,SelectBuffer:array [0..Max_Path] of char;//PChar;
  ShellMalloc: IMalloc;
begin
  result:=false;
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
    SHGetSpecialFolderLocation(Application.Handle, FolderIDs[FRoot], RootIDList);
  with BrowseInfo do
  begin
    hwndOwner := Application.Handle;
    pidlRoot := RootIDList;//nil;//RootItemIDList;
    pszDisplayName := DisplayBuffer;
    lpszTitle := PChar(FTitle);
    for Option := Low(Option) to High(Option) do
      if Option in FOptions then
        ulFlags := ulFlags or DialogOptions[Option];
    lpfn:=@BrowseCallBack;//如何实现CallBack函数
    lparam:=integer(self);
  end;
  ItemIDList := ShBrowseForFolder(BrowseInfo);
  Result :=  ItemIDList <> nil;
  if Result then
  begin
    ShGetPathFromIDList(ItemIDList, SelectBuffer);
    ShellMalloc.Free(ItemIDList);
    FDirectory := SelectBuffer;
    FDisplayName:=BrowseInfo.pszDisplayName;
  end;
  ShellMalloc.Free(RootIDList);
end;end.
//应加上FolderInfo属性，应加上Enable属性(实现的有问题
//应再加上ItemIDList的属性,Caption,Center属性。

Answer 3

用RX Lib中的TDirectoryEdit:RX Lib在www.torry.ru上

Answer 4

用FindFirst，FindNext，FindClose来游历目录，关于网上邻居的游历，我记得我帖出过一个帖子，你查查看，找不到的话我再帖出来

Answer 5

各位，不好意思，你们的方法我发现都麻烦，这几天我自己总算研究出了结果，很简单：
SelectDirectory('请选择备份数据库所在目录','桌面',dir)其中dir为一string型，
不过，为了感谢各位的关心，每人有奖！！

Answer 6

hzzkf:真是气死我了? 没注意到我和hubdog的答案吗?