A
alading
Unregistered / Unconfirmed
GUEST, unregistred user!
我想在程序中实现点击“浏览”按钮，类似于WINDOWS中“查找文件或文件夹”中的“浏览(B)”按钮，但用DIRECTORYLISTBOX却只能看到一个驱动器中的文件夹。我想在WINDOWS中肯定有这样的API函数，但不知道如何实现，请多多指教！
H
hubdog
Unregistered / Unconfirmed
GUEST, unregistred user!
ShBrowseForFolder(BrowseInfo)
H
hubdog
Unregistered / Unconfirmed
GUEST, unregistred user!
我写的控件<br>unit CXBrowseDlg;<br><br>interface<br><br>uses<br> Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,shlobj,<br> ActiveX;<br><br>type<br> TEnableOperation=(eoNone,eoEnable,eoDisable);<br><br> TFolderID = (<br> fiAltStartUp,fiAppData,fiBitBucket,fiCommonAltStartUp,fiCommonDesktopDirectory,<br> fiCommonFaverites,fiCommonPrograms, fiCommonStartMenu,fiCommonStartUp ,fiControls,<br> fiCookies,fiDesktop,fiDesktopDirectory,fiDrives,fiFavorites,fiFonts,fiHistory,<br> fiInternet,fiInternetCache,fiNetHood,fiNetwork,fiPersonal,fiPrinters,fiPrintHood,<br> fiPrograms,fiRecent,fiSendTo,fiStartMenu,fiStartUp,fiTemplates);<br> <br> TCXBrowseDlgOption=(fdBrowseForComputer,fdBrowseForPrinter,fdBrowseInclueFiles,<br> fdDontGoBelowDomain,fdEditBox,fdReturnFSAncestors,fdReturnOnlyFSDirs,fdStatusText,<br> fdValidate);<br><br> TCXBrowseDlgOptions=set of TCXBrowseDlgOption;<br><br> TBrowseChangeProc=procedure (Handle:HWnd;LParam:lparam;DisplayText:Boolean;var StatusText:string;<br> var EnableOperation:TEnableOperation) of object;<br><br> TBrowseValidateProc=procedure (Handle:HWnd;ErrorInput:String) of object;<br><br> TCXBrowseDlg = class(TComponent)<br> private<br> { Private declarations }<br> FDirectory:String;<br> FDisplayName:string;<br> //FOnBrowseInfo:TBrowseProc;<br> FOnChange:TBrowseChangeProc;<br> FOnValidateFailed:TBrowseValidateProc;<br> FOptions:TCXBrowseDlgOptions;<br> FRoot:TFolderId;<br> FTitle:String;<br> procedure SetOptions(Value:TCXBrowseDlgOptions);<br> { Protected declarations }<br> public<br> { Public declarations }<br> //property ItemID
ItemIDList read FItemID write SetItemID;<br> published<br> { Published declarations }<br> constructor Create(AOwner:TComponent);override;<br> function Execute:Boolean;<br> property Title:string read FTitle write FTitle ;//default '浏览文件夹';//运行时只读<br> property Options:TCXBrowseDlgOptions read FOptions write SetOptions;//FOptions default [];<br> property Root:TFolderId read FRoot write FRoot default fiDesktop;<br> property Directory:String read FDirectory;// write FDirectory;// default '';只读<br> property DisplayName:string read FDisplayName;<br> property OnChange: TBrowseChangeProc read FOnChange write FOnChange;<br> property OnValidateFailed: TBrowseValidateProc read FOnValidateFailed write FOnValidateFailed;<br> end;<br><br>procedure Register;<br><br>implementation<br><br>procedure Register;<br>begin<br> RegisterComponents('CXLib', [TCXBrowseDlg]);<br>end;<br><br>function BrowseCallBack(Wnd: HWND; uMsg: UINT; Param, Data: LPARAM): Integer stdcall;<br>var<br> StatusText:String;<br> PStatusTextChar;<br> FolderDialog:TCXBrowseDlg;<br> EditText:AnsiString;<br> EnableOperation:TEnableOperation;<br>begin<br> FolderDialog:=ptr(Data);<br> EnableOperation:=eoNone;<br> GetMem(PStatusText,256);<br> case uMsg of<br> BFFM_SELCHANGED:<br> begin<br> if assigned(FolderDialog.OnChange) then<br> begin<br> if (fdStatusText in FolderDialog.Options) then<br> FolderDialog.OnChange(Wnd,param,true,StatusText,EnableOperation)<br> else<br> FolderDialog.OnChange(Wnd,param,false,StatusText,EnableOperation);<br> if (fdStatusText in FolderDialog.Options) then<br> SendMessage(Wnd,BFFM_SETSTATUSTEXT,0,integer(StrPCopy(PStatusText,StatusText)));//注意Pchar的处理不太好<br> case EnableOperation of<br> eoEnable:SendMessage(Wnd,BFFM_ENABLEOK,0,1);<br> eoDisable:SendMessage(Wnd,BFFM_ENABLEOK,0,0);<br> end;<br> end;<br> end;<br> BFFM_VALIDATEFAILED:<br> begin<br> if Assigned(FolderDialog.OnValidateFailed) then<br> begin<br> EditText:=Pchar(ptr(param));<br> FolderDialog.OnValidateFailed(wnd,EditText);//Pchar和String的互换？<br> end;<br> end;<br> end;<br> FreeMem(PStatusText,256);<br> result:=1;<br>end;<br><br>constructor TCXBrowseDlg.Create(AOwner:TComponent);<br>begin<br> inherited Create(AOwner);<br> FDisplayName:='';<br> FOptions:=[];<br> FRoot:=fiDesktop;<br> FTitle:='浏览文件夹';<br>end;<br><br>procedure TCXBrowseDlg.SetOptions(Value:TCXBrowseDlgOptions);<br>begin<br> FOptions:=Value;<br> if ((fdValidate in FOptions) and (not(fdEditBox in FOptions))) then<br> FOptions:=FOptions + [fdEditBox];<br>end;<br><br>function TCXBrowseDlg.Execute:Boolean;<br>const<br> DialogOptions: array[TCXBrowseDlgOption] of DWORD = (<br> BIF_BROWSEFORCOMPUTER,BIF_BROWSEFORPRINTER,BIF_BROWSEINCLUDEFILES,BIF_DONTGOBELOWDOMAIN,<br> BIF_EDITBOX,BIF_RETURNFSANCESTORS,BIF_RETURNONLYFSDIRS,BIF_STATUSTEXT,BIF_VALIDATE);<br>const<br> FolderIDs: array[TFolderID] of integer = (<br> CSIDL_ALTSTARTUP,CSIDL_APPDATA,CSIDL_BITBUCKET,CSIDL_COMMON_ALTSTARTUP,CSIDL_COMMON_DESKTOPDIRECTORY,<br> CSIDL_COMMON_FAVORITES,CSIDL_COMMON_PROGRAMS,CSIDL_COMMON_STARTMENU,CSIDL_COMMON_STARTUP,<br> CSIDL_CONTROLS,CSIDL_COOKIES,CSIDL_DESKTOP,CSIDL_DESKTOPDIRECTORY,CSIDL_DRIVES,CSIDL_FAVORITES,<br> CSIDL_FONTS,CSIDL_HISTORY,CSIDL_INTERNET,CSIDL_INTERNET_CACHE,CSIDL_NETHOOD,CSIDL_NETWORK,<br> CSIDL_PERSONAL,CSIDL_PRINTERS,CSIDL_PRINTHOOD,CSIDL_PROGRAMS,CSIDL_RECENT,CSIDL_SENDTO,CSIDL_STARTMENU,<br> CSIDL_STARTUP,CSIDL_TEMPLATES);<br>var<br> BrowseInfo: TBrowseInfo;<br> Option:TCXBrowseDlgOption;<br> RootIDList,ItemIDList: PItemIDList;<br> DisplayBuffer,SelectBuffer:array [0..Max_Path] of char;//PChar;<br> ShellMalloc: IMalloc;<br>begin<br> result:=false;<br> FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);<br> if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then<br> SHGetSpecialFolderLocation(Application.Handle, FolderIDs[FRoot], RootIDList);<br> with BrowseInfo do<br> begin<br> hwndOwner := Application.Handle;<br> pidlRoot := RootIDList;//nil;//RootItemIDList;<br> pszDisplayName := DisplayBuffer;<br> lpszTitle := PChar(FTitle);<br> for Option := Low(Option) to High(Option) do<br> if Option in FOptions then<br> ulFlags := ulFlags or DialogOptions[Option];<br> lpfn:=@BrowseCallBack;//如何实现CallBack函数<br> lparam:=integer(self);<br> end;<br> ItemIDList := ShBrowseForFolder(BrowseInfo);<br> Result := ItemIDList <> nil;<br> if Result then<br> begin<br> ShGetPathFromIDList(ItemIDList, SelectBuffer);<br> ShellMalloc.Free(ItemIDList);<br> FDirectory := SelectBuffer;<br> FDisplayName:=BrowseInfo.pszDisplayName;<br> end;<br> ShellMalloc.Free(RootIDList);<br>end;<br><br>end.<br>//应加上FolderInfo属性，应加上Enable属性(实现的有问题<br>//应再加上ItemIDList的属性,Caption,Center属性。
ItemIDList read FItemID write SetItemID;<br> published<br> { Published declarations }<br> constructor Create(AOwner:TComponent);override;<br> function Execute:Boolean;<br> property Title:string read FTitle write FTitle ;//default '浏览文件夹';//运行时只读<br> property Options:TCXBrowseDlgOptions read FOptions write SetOptions;//FOptions default [];<br> property Root:TFolderId read FRoot write FRoot default fiDesktop;<br> property Directory:String read FDirectory;// write FDirectory;// default '';只读<br> property DisplayName:string read FDisplayName;<br> property OnChange: TBrowseChangeProc read FOnChange write FOnChange;<br> property OnValidateFailed: TBrowseValidateProc read FOnValidateFailed write FOnValidateFailed;<br> end;<br><br>procedure Register;<br><br>implementation<br><br>procedure Register;<br>begin<br> RegisterComponents('CXLib', [TCXBrowseDlg]);<br>end;<br><br>function BrowseCallBack(Wnd: HWND; uMsg: UINT; Param, Data: LPARAM): Integer stdcall;<br>var<br> StatusText:String;<br> PStatusTextChar;<br> FolderDialog:TCXBrowseDlg;<br> EditText:AnsiString;<br> EnableOperation:TEnableOperation;<br>begin<br> FolderDialog:=ptr(Data);<br> EnableOperation:=eoNone;<br> GetMem(PStatusText,256);<br> case uMsg of<br> BFFM_SELCHANGED:<br> begin<br> if assigned(FolderDialog.OnChange) then<br> begin<br> if (fdStatusText in FolderDialog.Options) then<br> FolderDialog.OnChange(Wnd,param,true,StatusText,EnableOperation)<br> else<br> FolderDialog.OnChange(Wnd,param,false,StatusText,EnableOperation);<br> if (fdStatusText in FolderDialog.Options) then<br> SendMessage(Wnd,BFFM_SETSTATUSTEXT,0,integer(StrPCopy(PStatusText,StatusText)));//注意Pchar的处理不太好<br> case EnableOperation of<br> eoEnable:SendMessage(Wnd,BFFM_ENABLEOK,0,1);<br> eoDisable:SendMessage(Wnd,BFFM_ENABLEOK,0,0);<br> end;<br> end;<br> end;<br> BFFM_VALIDATEFAILED:<br> begin<br> if Assigned(FolderDialog.OnValidateFailed) then<br> begin<br> EditText:=Pchar(ptr(param));<br> FolderDialog.OnValidateFailed(wnd,EditText);//Pchar和String的互换？<br> end;<br> end;<br> end;<br> FreeMem(PStatusText,256);<br> result:=1;<br>end;<br><br>constructor TCXBrowseDlg.Create(AOwner:TComponent);<br>begin<br> inherited Create(AOwner);<br> FDisplayName:='';<br> FOptions:=[];<br> FRoot:=fiDesktop;<br> FTitle:='浏览文件夹';<br>end;<br><br>procedure TCXBrowseDlg.SetOptions(Value:TCXBrowseDlgOptions);<br>begin<br> FOptions:=Value;<br> if ((fdValidate in FOptions) and (not(fdEditBox in FOptions))) then<br> FOptions:=FOptions + [fdEditBox];<br>end;<br><br>function TCXBrowseDlg.Execute:Boolean;<br>const<br> DialogOptions: array[TCXBrowseDlgOption] of DWORD = (<br> BIF_BROWSEFORCOMPUTER,BIF_BROWSEFORPRINTER,BIF_BROWSEINCLUDEFILES,BIF_DONTGOBELOWDOMAIN,<br> BIF_EDITBOX,BIF_RETURNFSANCESTORS,BIF_RETURNONLYFSDIRS,BIF_STATUSTEXT,BIF_VALIDATE);<br>const<br> FolderIDs: array[TFolderID] of integer = (<br> CSIDL_ALTSTARTUP,CSIDL_APPDATA,CSIDL_BITBUCKET,CSIDL_COMMON_ALTSTARTUP,CSIDL_COMMON_DESKTOPDIRECTORY,<br> CSIDL_COMMON_FAVORITES,CSIDL_COMMON_PROGRAMS,CSIDL_COMMON_STARTMENU,CSIDL_COMMON_STARTUP,<br> CSIDL_CONTROLS,CSIDL_COOKIES,CSIDL_DESKTOP,CSIDL_DESKTOPDIRECTORY,CSIDL_DRIVES,CSIDL_FAVORITES,<br> CSIDL_FONTS,CSIDL_HISTORY,CSIDL_INTERNET,CSIDL_INTERNET_CACHE,CSIDL_NETHOOD,CSIDL_NETWORK,<br> CSIDL_PERSONAL,CSIDL_PRINTERS,CSIDL_PRINTHOOD,CSIDL_PROGRAMS,CSIDL_RECENT,CSIDL_SENDTO,CSIDL_STARTMENU,<br> CSIDL_STARTUP,CSIDL_TEMPLATES);<br>var<br> BrowseInfo: TBrowseInfo;<br> Option:TCXBrowseDlgOption;<br> RootIDList,ItemIDList: PItemIDList;<br> DisplayBuffer,SelectBuffer:array [0..Max_Path] of char;//PChar;<br> ShellMalloc: IMalloc;<br>begin<br> result:=false;<br> FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);<br> if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then<br> SHGetSpecialFolderLocation(Application.Handle, FolderIDs[FRoot], RootIDList);<br> with BrowseInfo do<br> begin<br> hwndOwner := Application.Handle;<br> pidlRoot := RootIDList;//nil;//RootItemIDList;<br> pszDisplayName := DisplayBuffer;<br> lpszTitle := PChar(FTitle);<br> for Option := Low(Option) to High(Option) do<br> if Option in FOptions then<br> ulFlags := ulFlags or DialogOptions[Option];<br> lpfn:=@BrowseCallBack;//如何实现CallBack函数<br> lparam:=integer(self);<br> end;<br> ItemIDList := ShBrowseForFolder(BrowseInfo);<br> Result := ItemIDList <> nil;<br> if Result then<br> begin<br> ShGetPathFromIDList(ItemIDList, SelectBuffer);<br> ShellMalloc.Free(ItemIDList);<br> FDirectory := SelectBuffer;<br> FDisplayName:=BrowseInfo.pszDisplayName;<br> end;<br> ShellMalloc.Free(RootIDList);<br>end;<br><br>end.<br>//应加上FolderInfo属性，应加上Enable属性(实现的有问题<br>//应再加上ItemIDList的属性,Caption,Center属性。
C
cAkk
Unregistered / Unconfirmed
GUEST, unregistred user!
天! 至于吗?!!!!<br>用D4里面的SelectDirectory函数就可以完全达到你要的效果!
C
CJ
Unregistered / Unconfirmed
GUEST, unregistred user!
ok the question should be solved：）
A
alading
Unregistered / Unconfirmed
GUEST, unregistred user!
多人接受答案了。
