Reviewed, simplified code.
This commit is contained in:
74
units/udirselect.pas
Normal file
74
units/udirselect.pas
Normal file
@@ -0,0 +1,74 @@
|
||||
unit udirselect;
|
||||
|
||||
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.
|
||||
Reference in New Issue
Block a user