Mega Code Archive
How to show the select directory dialog and sepeify the initial directory
<![CDATA[
Title: How to show the select directory dialog and sepeify the initial directory
uses
ShlObj, ActiveX;
function SelectDirectoryEx(hOwn: HWND; var Path: string; Caption, Root: string;
uFlag: DWORD = $25): Boolean;
const
BIF_NEWDIALOGSTYLE = $0040;
var
BrowseInfo: TBrowseInfo;
Buffer: PChar;
RootItemIDList, ItemIDList: PItemIDList;
ShellMalloc: IMalloc;
IDesktopFolder: IShellFolder;
Dummy: LongWord;
function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: Cardinal;
lpData: Cardinal): Integer; stdcall;
var
PathName: array[0..MAX_PATH] of Char;
begin
case uMsg of
BFFM_INITIALIZED:
SendMessage(Hwnd, BFFM_SETSELECTION, Ord(True), Integer(lpData));
BFFM_SELCHANGED:
begin
SHGetPathFromIDList(PItemIDList(lParam), @PathName);
SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, Longint(PChar(@PathName)));
end;
end;
Result := 0;
end;
begin
Result := False;
FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc nil) then
begin
Buffer := ShellMalloc.Alloc(MAX_PATH);
try
RootItemIDList := nil;
if Root '' then
begin
SHGetDesktopFolder(IDesktopFolder);
IDesktopFolder.ParseDisplayName(hOwn, nil, POleStr(WideString(Root)),
Dummy, RootItemIDList, Dummy);
end;
with BrowseInfo do
begin
hwndOwner := hOwn;
pidlRoot := RootItemIDList;
pszDisplayName := Buffer;
lpszTitle := PChar(Caption);
ulFlags := uFlag;
lpfn := @BrowseCallbackProc;
lParam := Integer(PChar(Path));
end;
ItemIDList := ShBrowseForFolder(BrowseInfo);
Result := ItemIDList nil;
if Result then
begin
ShGetPathFromIDList(ItemIDList, Buffer);
ShellMalloc.Free(ItemIDList);
Path := StrPas(Buffer);
end;
finally
ShellMalloc.Free(Buffer);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Path: string;
begin
Path := 'C:\Windows';
if SelectDirectoryEx(Handle, Path, 'Select Directory Sample', 'C:\') then
ShowMessage(Path);
end;
{******************************************************************}
{
Heres an example on how to locate a folder with a specific filer,
using SHBrowseForFolder and a BrowseCallBack function
( by Jack Kallestrup )
}
uses ShlObj, ShellApi;
function BrowseCallBack ( Hwnd : THandle; uMsg : UINT; lpParam, lpData : LPARAM): integer; stdcall;
var
Buffer : Array[0..255] of char;
Buffer2 : Array[0..255] of char;
TmpStr : String;
begin
// Initialize buffers
FillChar(Buffer,SizeOf(Buffer),#0);
FillChar(Buffer2,SizeOf(Buffer2),#0);
// Statusline text
TmpStr := 'Locate folder containing '+StrPas(PChar(lpData));
// Copy statustext to pchar
StrPCopy(Buffer2,TmpStr);
// Send message to BrowseForDlg that
// the status text has changed
SendMessage(hwnd,BFFM_SETSTATUSTEXT,0,Integer(@Buffer2));
// If directory in BrowswForDlg has changed ?
if uMsg = BFFM_SELCHANGED then begin
// Get the new folder name
SHGetPathFromIDList(PItemIDList(lpParam),Buffer);
// And check for existens of our file.
{$IFDEF RX_D3} //RxLib - extentions
if FileExists(NormalDir(StrPas(Buffer))+StrPas(PChar(lpData)))
and (StrLen(Buffer) 0) then
{$ELSE}
if Length(StrPas(Buffer)) 0 then
if Buffer[Length(StrPas(Buffer))-1] = '\' then
Buffer[Length(StrPas(Buffer))-1] := #0;
if FileExists(StrPas(Buffer)+'\'+StrPas(PChar(lpData))) and
(StrLen(Buffer) 0) then
{$ENDIF}
// found : Send message to enable OK-button
SendMessage(hwnd,BFFM_ENABLEOK,1,1)
else
// Send message to disable OK-Button
SendMessage(Hwnd,BFFM_ENABLEOK,0,0);
end;
result := 0
end;
function BrowseforFile(Handle : THandle; Title : String; Filename : String) : String;
var
BrowseInfo : TBrowseInfo;
RetBuffer,
FName,
ResultBuffer : Array[0..255] of char;
PIDL : PItemIDList;
begin
StrPCopy(Fname,FileName);
//Initialize buffers
FillChar(BrowseInfo,SizeOf(TBrowseInfo),#0);
Fillchar(RetBuffer,SizeOf(RetBuffer),#0);
FillChar(ResultBuffer,SizeOf(ResultBuffer),#0);
BrowseInfo.hwndOwner := Handle;
BrowseInfo.pszDisplayName := @Retbuffer;
BrowseInfo.lpszTitle := @Title[1];
// we want a status-text
BrowseInfo.ulFlags := BIF_StatusText;
// Our call-back function cheching for fileexist
BrowseInfo.lpfn := @BrowseCallBack;
BrowseInfo.lParam := Integer(@FName);
// Show BrowseForDlg
PIDL := SHBrowseForFolder(BrowseInfo);
// Return fullpath to file
if SHGetPathFromIDList(PIDL,ResultBuffer) then
result := StrPas(ResultBuffer)
else
Result := '';
GlobalFreePtr(PIDL); //Clean up
end;
Usage Example:
procedure TForm1.Button1Click(Sender: TObject);
const
FileName = 'File.xyz';
var
Answer: Integer;
begin
if MessageBox(0, 'To locate the file yourself, click ok',
PChar(Format('File %s not found.',[FileName])),MB_OKCANCEL) = 1 then
BrowseforFile(Handle, 'locate ' + FileName, FileName);
end;
]]>