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

来源:互联网 发布:php设计模式 编辑:程序博客网 时间:2024/06/05 09:29

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;varBInfo: _browseinfoA;Buffer: array[0..MAX_PATH] of Char;ID: IShellFolder;Eaten, Attribute: Cardinal;ItemID: PItemidlist;beginwith BInfo dobegin    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) thenbegin    SelectedFolder := Buffer;    if Length(SelectedFolder)<>3 then      SelectedFolder := SelectedFolder;    result := True;endelse begin    SelectedFolder := '';    result := False;end;end;//=====================================================调用方法:procedure TForm1.Button1Click(Sender: TObject);varNewDir:string;beginif   SelectFolderDialog(Handle,'选择','C:\',NewDir)   then          label1.Caption:=NewDir;end;


 

原创粉丝点击