Среди стандартных диалогов Delphi 6 (вкладка Dialogs) диалог выбора папки, как это не прискорбно, отсутствует. Но ничего, сейчас мы исправим данное упущение, написав соответствующий компонент.
Чтобы создать новый компонент, в Delphi IDE выберите пункт File > New > Other и затем в появившемся окне нажмите New Component. Появится диалоговое окно, в котором:
Ancensor type (класс-предок нового компонента) - введите TComponent;
Class Name (имя нового класса) - TBrowseFolderDlg;
Palette Page (имя вкладки: поместим наш диалог вместе со стандартными дельфийскими) - Dialogs.
Остальное оставьте без изменений и нажмите OK. Наш мегадиалог будет вызываться функцией, продекларированной в Public Declarations компонента:
function BrowseFolder(title: PChar; h: hwnd): String;
Где title - заголовок диалога (поставьте любой на ваш вкус), h - хэндл окна-владельца (то есть вашей программы). А команды, использованные в коде, содержатся в ShlObj.pas, так что не забудьте указать этот модуль в разделе uses.
unit BrowseFolderDlg;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, ShlObj;
type
TBrowseFolderDlg = class(TComponent)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
function BrowseFolder(title: PChar; h: hwnd): String;
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Dialogs', [TBrowseFolderDlg]);
end;
function TBrowseFolderDlg.BrowseFolder(title: PChar; h: hwnd): String;
var
lpItemID: PItemIDList;
path: array[0..Max_path] of char; //выбранная папка
BrowseInfo: TBrowseInfo; //настройки диалога
begin
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
SHGetSpecialFolderLocation(h,csidl_desktop,BrowseInfo.pidlRoot);
//устанавливаем свойства диалогового окна
with BrowseInfo do
begin
hwndOwner := h; //окно-владелец
lpszTitle := title; //заголовок диалога
//не показываем некоторые системные папки: "Корзина", "Панель управления" и т.д
ulFlags := BIF_RETURNONLYFSDIRS+BIF_EDITBOX+BIF_STATUSTEXT;
end;
//выводим диалог
lpItemID := SHBrowseForFolder(BrowseInfo);
//папка, указанная юзером, существует?
if lpItemId <> nil then
begin
SHGetPathFromIDList(lpItemID, Path);
result:=path;
GlobalFreePtr(lpItemID); //освобождаем ресурсы
end;
end;
end.
Готово? Сохранитесь и, выбрав Component > Install Component, проинсталлируйте наш диалог, указав в разделе Unit File Name путь к файлу BrowseFolderDlg.pas.
Осуществить вызов диалога из программы можно так (разумеется, предварительно бросив TBrowseFolderDlg на форму):
procedure TForm1.Button1Click(Sender: TObject);
begin
Form1.Caption:= 'Выбрана следующая папка: '+
BrowseFolderDlg1.BrowseFolder('Укажите каталог:',Application.Handle);
end;
Конечно, это только "скелет" полноценного компонента, и просторы для модернизации безграничны.