Delphi 显示选择文件夹对话框 (有新建按钮)

Delphi 显示选择文件夹对话框 (有新建按钮) 附实例

uses ShlObj
选择文件夹对话框。
入口参数:
Handle:调用者句柄
Caption:对话框标题
InitFolder:初始文件夹;
SelectedFolder:返回选择结果
返回值:
如果用户选择了路径并确定,返回True。并由SelectedFolder返回选择结果。否则返回False}

截图:

 

function SelectFolderDialog(const Handle:integer;const Caption:string;
              
const InitFolder:string;var SelectedFolder:string):boolean;
var
BInfo: _browseinfoA;
Buffer: 
array[0..MAX_PATH] of Char;
ID: IShellFolder;
Eaten, Attribute: Cardinal;
ItemID: PItemidlist;
begin
with BInfo do
begin
    HwndOwner :
= Handle;
    lpfn :
= nil;
    lpszTitle :
= Pchar(Caption);
    ulFlags :
= BIF_RETURNONLYFSDIRS+BIF_NEWDIALOGSTYLE;
    SHGetDesktopFolder(ID);
    ID.ParseDisplayName(
0,nil,'\',Eaten,ItemID,Attribute);
    pidlRoot :
= ItemID;
    GetMem(pszDisplayName, MAX_PATH);
end;

FreeMem(pszDisplayName);
if SHGetPathFromIDList(SHBrowseForFolder(BInfo), Buffer) then
begin
    SelectedFolder :
= Buffer;
    
if Length(SelectedFolder)<>3 then
      SelectedFolder :
= SelectedFolder;
    result :
= True;
end
else begin
    SelectedFolder :
= '';
    result :
= False;
end;
end;

//=====================================================

调用方法:

procedure TForm1.Button1Click(Sender: TObject);
var
NewDir:
string;
begin
if   SelectFolderDialog(Handle,'选择','C:\',NewDir)   then
          label1.Caption:
=NewDir;
end;

转载于:https://www.cnblogs.com/lahcs/archive/2009/03/12/1409558.html

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值