blob: b1cb85dd52c177e6c600a42d1d9c193063e8ab81 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
{$include compilers.inc}
unit wrapdlgs;
interface
uses Windows;
function SelectDirectory(Caption:PAnsiChar;var Directory:PAnsiChar;
Parent:HWND=0):Boolean; overload;
function SelectDirectory(Caption:PWideChar;var Directory:PWideChar;
Parent:HWND=0):Boolean; overload;
implementation
uses common, messages;
type
PSHItemID = ^TSHItemID;
TSHItemID = packed record
cb: word; { Size of the ID (including cb itself) }
abID: array[0..0] of byte; { The item ID (variable length) }
end;
PItemIDList = ^TItemIDList;
TItemIDList = record
mkid: TSHItemID;
end;
TBrowseInfoA = record
hwndOwner : HWND;
pidlRoot : PItemIDList;
pszDisplayName: PAnsiChar; { Return display name of item selected. }
lpszTitle : PAnsiChar; { text to go in the banner over the tree. }
ulFlags : uint; { Flags that control the return stuff }
lpfn : pointer; //TFNBFFCallBack;
lParam : LPARAM; { extra info that's passed back in callbacks }
iImage : integer; { output var: where to return the Image index. }
end;
TBrowseInfoW = record
hwndOwner : HWND;
pidlRoot : PItemIDList;
pszDisplayName: PWideChar; { Return display name of item selected. }
lpszTitle : PWideChar; { text to go in the banner over the tree. }
ulFlags : uint; { Flags that control the return stuff }
lpfn : pointer; //TFNBFFCallBack;
lParam : LPARAM; { extra info that's passed back in callbacks }
iImage : integer; { output var: where to return the Image index. }
end;
function SHBrowseForFolderA(var lpbi: TBrowseInfoA): PItemIDList; stdcall;
external 'shell32.dll' name 'SHBrowseForFolderA';
function SHBrowseForFolderW(var lpbi: TBrowseInfoW): PItemIDList; stdcall;
external 'shell32.dll' name 'SHBrowseForFolderW';
function SHGetPathFromIDListA(pidl: PItemIDList; pszPath: PAnsiChar): bool; stdcall;
external 'shell32.dll' name 'SHGetPathFromIDListA';
function SHGetPathFromIDListW(pidl: PItemIDList; pszPath: PWideChar): bool; stdcall;
external 'shell32.dll' name 'SHGetPathFromIDListW';
procedure CoTaskMemFree(pv: pointer); stdcall; external 'ole32.dll'
name 'CoTaskMemFree';
// ShlObj unit constants
const
BIF_RETURNONLYFSDIRS = $0001; { For finding a folder to start document searching }
// BIF_DONTGOBELOWDOMAIN = $0002; { For starting the Find Computer }
// BIF_STATUSTEXT = $0004;
// BIF_RETURNFSANCESTORS = $0008;
// BIF_EDITBOX = $0010;
// BIF_VALIDATE = $0020; { insist on valid result (or CANCEL) }
BIF_NEWDIALOGSTYLE = $0040; { Use the new dialog layout with the ability to resize }
{ Caller needs to call OleInitialize() before using this API (c) JVCL }
// BIF_BROWSEFORCOMPUTER = $1000; { Browsing for Computers. }
// BIF_BROWSEFORPRINTER = $2000; { Browsing for Printers }
// BIF_BROWSEINCLUDEFILES = $4000; { Browsing for Everything }
{
BFFM_INITIALIZED = 1;
BFFM_SELCHANGED = 2;
BFFM_SETSTATUSTEXT = WM_USER + 100;
BFFM_ENABLEOK = WM_USER + 101;
BFFM_SETSELECTION = WM_USER + 102;
BFFM_SETSELECTIONW = WM_USER + 103;
}
function SelectDirectory(Caption:PAnsiChar;var Directory:PAnsiChar;Parent:HWND=0):Boolean;
var
BrowseInfo:TBrowseInfoA;
Buffer:array [0..MAX_PATH-1] of AnsiChar;
ItemIDList:PItemIDList;
begin
Result:=False;
FillChar(BrowseInfo,SizeOf(BrowseInfo),0);
BrowseInfo.hwndOwner :=Parent;
BrowseInfo.pszDisplayName:=@Buffer;
BrowseInfo.lpszTitle :=Caption;
BrowseInfo.ulFlags :=BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
ItemIDList:=SHBrowseForFolderA(BrowseInfo);
if ItemIDList<>nil then
begin
SHGetPathFromIDListA(ItemIDList,Buffer);
StrDup(Directory,Buffer);
CoTaskMemFree(ItemIDList);
result:=true;
end;
end;
function SelectDirectory(Caption:PWideChar;var Directory:PWideChar;Parent:HWND=0):Boolean;
var
BrowseInfo:TBrowseInfoW;
Buffer:array [0..MAX_PATH-1] of WideChar;
ItemIDList:PItemIDList;
begin
Result:=False;
FillChar(BrowseInfo,SizeOf(BrowseInfo),0);
BrowseInfo.hwndOwner :=Parent;
BrowseInfo.pszDisplayName:=@Buffer;
BrowseInfo.lpszTitle :=Caption;
BrowseInfo.ulFlags :=BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
ItemIDList:=SHBrowseForFolderW(BrowseInfo);
if ItemIDList<>nil then
begin
SHGetPathFromIDListW(ItemIDList,Buffer);
StrDupW(Directory,Buffer);
CoTaskMemFree(ItemIDList);
result:=true;
end;
end;
end.
|
