75 lines
2.3 KiB
ObjectPascal
75 lines
2.3 KiB
ObjectPascal
unit uBrowseForFolder;
|
|
|
|
interface
|
|
|
|
function BrowseForFolder(const appHWND: THandle; const browseTitle: String;
|
|
const initialFolder: String = ''): String;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Windows, shlobj;
|
|
|
|
var
|
|
lg_StartFolder: String;
|
|
|
|
/// /////////////////////////////////////////////////////////////////////
|
|
// Call back function used to set the initial browse directory.
|
|
/// /////////////////////////////////////////////////////////////////////
|
|
function BrowseForFolderCallBack(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam)
|
|
: Integer stdcall;
|
|
begin
|
|
if uMsg = BFFM_INITIALIZED then
|
|
SendMessage(Wnd, BFFM_SETSELECTION, 1, Integer(@lg_StartFolder[1]));
|
|
|
|
result := 0;
|
|
end;
|
|
|
|
/// /////////////////////////////////////////////////////////////////////
|
|
// This function allows the user to browse for a folder
|
|
//
|
|
// Arguments:-
|
|
// browseTitle : The title to display on the browse dialog.
|
|
// initialFolder : Optional argument. Use to specify the folder
|
|
// initially selected when the dialog opens.
|
|
// mayCreateNewFolder : Flag indicating whether the user can create a
|
|
// new folder.
|
|
//
|
|
// Returns: The empty string if no folder was selected (i.e. if the user
|
|
// clicked cancel), otherwise the full folder path.
|
|
/// /////////////////////////////////////////////////////////////////////
|
|
function BrowseForFolder(const appHWND: THandle; const browseTitle: String;
|
|
const initialFolder: String = ''): String;
|
|
var
|
|
browse_info: TBrowseInfo;
|
|
folder: array [0 .. MAX_PATH] of char;
|
|
find_context: PItemIDList;
|
|
begin
|
|
// --------------------------
|
|
// Initialise the structure.
|
|
// --------------------------
|
|
FillChar(browse_info, SizeOf(browse_info), #0);
|
|
lg_StartFolder := initialFolder;
|
|
browse_info.pszDisplayName := @folder[0];
|
|
browse_info.lpszTitle := PChar(browseTitle);
|
|
browse_info.ulFlags := BIF_DONTGOBELOWDOMAIN or BIF_RETURNONLYFSDIRS or
|
|
BIF_STATUSTEXT or BIF_VALIDATE {or BIF_USENEWUI} or BIF_NONEWFOLDERBUTTON;
|
|
|
|
browse_info.hwndOwner := appHWND;
|
|
if initialFolder <> '' then
|
|
browse_info.lpfn := BrowseForFolderCallBack;
|
|
find_context := SHBrowseForFolder(browse_info);
|
|
if Assigned(find_context) then
|
|
begin
|
|
if SHGetPathFromIDList(find_context, folder) then
|
|
result := folder
|
|
else
|
|
result := '';
|
|
GlobalFreePtr(find_context);
|
|
end
|
|
else
|
|
result := '';
|
|
end;
|
|
|
|
end.
|