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;
Конечно, это только "скелет" полноценного компонента, и просторы для модернизации безграничны.