Можно такой диалог выбора папки сделать
Код:
{Add in uses ShlObj}
var
Form1: TForm1;
TempPath:array[0..MAX_PATH] of char; //Путь к выбранной папке
implementation
{$R *.dfm}
//Handle - Ссылка на родительское окно
function BrowseDialog(const Handle:Cardinal):string;
var
lpItemID:PItemIDList;
BrowseInfo:TBrowseInfo;
DisplayName:array[0..MAX_PATH] of char;
begin
Result:='';
FillChar(BrowseInfo,sizeof(TBrowseInfo),#0);
with BrowseInfo do
begin
hwndOwner:=Handle;
pszDisplayName:=@DisplayName;
lpszTitle:='Выбрать папку';
ulFlags:=BIF_RETURNONLYFSDIRS;
end;
lpItemID:=SHBrowseForFolder(BrowseInfo);
If lpItemId<>nil then
begin
SHGetPathFromIDList(lpItemID,TempPath);
Result:=TempPath;
GlobalFreePtr(lpItemID);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
BrowseDialog(Handle);
ShowMessage(TempPath); // В TempPath будет путь к выбранной папке
end;
end.