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

hzzkf 2000-03-14 07:41:00
加精
各位,我需要在程序中作出选择备份数据库目录的功能,其外观和功能大致为瑞星杀毒软件或flashget中浏览文件夹的样子。浏览框中应能包括网上邻居及我的文档等,并且在有子目录的目录前有加号,望各位高手赐教。谢谢!
...全文
237 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
Lin 2000-03-17
  • 打赏
  • 举报
回复
hzzkf:

真是气死我了? 没注意到我和hubdog的答案吗?
hzzkf 2000-03-16
  • 打赏
  • 举报
回复
各位,不好意思,你们的方法我发现都麻烦,这几天我自己总算研究出了结果,很简单:
SelectDirectory('请选择备份数据库所在目录','桌面',dir)其中dir为一string型,
不过,为了感谢各位的关心,每人有奖!!
Firing_Sky 2000-03-16
  • 打赏
  • 举报
回复
用FindFirst,FindNext,FindClose来游历目录,关于网上邻居的游历,我记得我帖出过一个帖子,你查查看,找不到的话我再帖出来
Jean 2000-03-16
  • 打赏
  • 举报
回复
用RX Lib中的TDirectoryEdit:

RX Lib在www.torry.ru上
hubdog 2000-03-15
  • 打赏
  • 举报
回复
用了我写这个控件,应该没问题。
或者你去深度历险去down一些类似的控件
一大堆
unit CXBrowseDlg;

interface

uses
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;

implementation

procedure 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属性。
hzzkf 2000-03-15
  • 打赏
  • 举报
回复
谢谢各位的赐教,不过以上方法我以用过,但不能在浏览框中出现网上邻居及我的文档等,请各位补充!
Lin 2000-03-14
  • 打赏
  • 举报
回复
To hzzkf:
  同意hubdog,注意它有两个原型,打开不同的对话框:一个就是你所说的,另外一个是Windows 3.x风格的,如果你用过的话。在程序中一定加入下面一句:

uses ..., FileCtrl;

To AcherMagic:
  为什么不用现成的呢?
AcherMagic 2000-03-14
  • 打赏
  • 举报
回复
用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;
hubdog 2000-03-14
  • 打赏
  • 举报
回复
delphi自带了selectdirectory函数

5,379

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧