实现文件路径对话框的几种方式

1 // 调用delphi的SelectDirectory方式实现,并添加新建文件功能 ///
2
3   uses
4 ShlObj,ActiveX;
5
6
7 { $R *.dfm }
8 function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam,
9 lpData: LPARAM): Integer stdcall ; // 这个是回调函数
10 begin
11 if (uMsg = BFFM_INITIALIZED) and (lpData <> 0 ) then
12 SendMessage(Wnd, BFFM_SETSELECTION, Integer(True), lpdata);
13 result : = 0 ;
14 end ;
15
16 这里重写delphi的SelectDirectory方法
17
18 function SelectDirectory( const Caption: string ;
19 const Root: WideString; var Directory: string ): Boolean;
20 var
21 WindowList: Pointer;
22 BrowseInfo: TBrowseInfo;
23 Buffer: PChar;
24 OldErrorMode: Cardinal;
25 RootItemIDList, ItemIDList: PItemIDList;
26 ShellMalloc: IMalloc;
27 IDesktopFolder: IShellFolder;
28 Eaten, Flags: LongWord;
29 begin
30 Result : = False;
31 if not DirectoryExists(Directory) then
32 Directory : = '' ;
33 FillChar(BrowseInfo, SizeOf(BrowseInfo), 0 );
34 if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil ) then
35 begin
36 Buffer : = ShellMalloc.Alloc(MAX_PATH);
37 try
38 RootItemIDList : = nil ;
39 if Root <> '' then
40 begin
41 SHGetDesktopFolder(IDesktopFolder);
42 IDesktopFolder.ParseDisplayName(Application.Handle, nil ,
43 POleStr(Root), Eaten, RootItemIDList, Flags);
44 end ;
45 BrowseInfo.ulFlags : = BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE or BIF_EDITBOX; // BIF_NEWDIALOGSTYLE , BIF_EDITBOX
46 // 分别是添加新建文件夹按钮、路径对话框 delphi默认只有 BIF_RETURNONLYFSDIRS
47 with BrowseInfo do
48 begin
49 hwndOwner : = Application.Handle;
50 pidlRoot : = RootItemIDList;
51 pszDisplayName : = Buffer;
52 lpszTitle : = PChar(Caption);
53 end ;
54
55 if Directory <> '' then
56 begin
57 BrowseInfo.lpfn : = SelectDirCB;
58 BrowseInfo.lParam : = Integer(PChar(Directory));
59 end ;
60 WindowList : = DisableTaskWindows( 0 );
61 OldErrorMode : = SetErrorMode(SEM_FAILCRITICALERRORS);
62 try
63 ItemIDList : = ShBrowseForFolder(BrowseInfo);
64 finally
65 SetErrorMode(OldErrorMode);
66 EnableTaskWindows(WindowList);
67 end ;
68 Result : = ItemIDList <> nil ;
69 if Result then
70 begin
71 ShGetPathFromIDList(ItemIDList, Buffer);
72 ShellMalloc.Free(ItemIDList);
73 Directory : = Buffer;
74 end ;
75 finally
76 ShellMalloc.Free(Buffer);
77 end ;
78 end ;
79 end ;
80
81 /// 通过ShBrowseForFolder实现 /
82
83 // SelectDir(句柄,提示的文字,打开时默认的目录,返回文件路径):成功否. // 无用
84 function SelectDir(ParentHWnd: HWnd; const Caption: string ; const Root: WideString;
85 out Directory: string ): Boolean;
86 var
87 BrowseInfo: TBrowseInfo;
88 Buffer: PChar;
89 RootItemIDList, ItemIDList: PItemIDList;
90 ShellMalloc: IMalloc;
91 IDesktopFolder: IShellFolder;
92 Eaten, Flags: LongWord;
93 begin
94 Result : = False;
95 Directory : = '' ;
96 FillChar(BrowseInfo, SizeOf(BrowseInfo), 0 );
97 if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil ) then
98 begin
99 Buffer : = ShellMalloc.Alloc(MAX_PATH);
100 try
101 SHGetDesktopFolder(IDesktopFolder);
102 IDesktopFolder.ParseDisplayName(Application.Handle, nil ,
103 POleStr(Root), Eaten, RootItemIDList, Flags);
104 with BrowseInfo do
105 begin
106 hwndOwner : = ParentHWnd;
107 pidlRoot : = RootItemIDList;
108 pszDisplayName : = Buffer;
109 lpszTitle : = PChar(Caption);
110 ulFlags : = BIF_RETURNONLYFSDIRS;
111 end ;
112 ItemIDList : = ShBrowseForFolder(BrowseInfo);
113 Result : = ItemIDList <> nil ;
114 if Result then
115 begin
116 ShGetPathFromIDList(ItemIDList, Buffer);
117 ShellMalloc.Free(ItemIDList);
118 Directory : = Buffer;
119 end ;
120 finally
121 ShellMalloc.Free(Buffer);
122 end ;
123 end ;
124 end ;
125
126

 

转载于:https://www.cnblogs.com/RoyGo/archive/2010/04/22/1906989.html