Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Последние темы форума

Показать новые сообщения »

Почтовая рассылка

Подписчиков: 11650
Последний выпуск: 19.06.2015

Пишем компонент - окно выбора папки

Автор: Трофим Роцкий
Development и Дельфи

Среди стандартных диалогов 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;

Конечно, это только "скелет" полноценного компонента, и просторы для модернизации безграничны.

Оставить комментарий

Комментарий:
можно использовать BB-коды
Максимальная длина комментария - 4000 символов.
 

Комментарии

1.
37K
06 марта 2008 года
Vialent
0 / / 06.03.2008
Мне нравитсяМне не нравится
18 марта 2008, 17:44:31
Мда. =/ форум даже в тэге кода кушает.

Ещё разок:
Код:
ulFlags:= 0;

for i := Low(TSFDOption) to High(TSFDOption) do

if i in FOptions then

ulFlags:= ulFlags OR DlgOpts;
на
Код:
ulFlags:= 0;

for i := Low(TSFDOption) to High(TSFDOption) do

if i in FOptions then

ulFlags:= ulFlags OR DlgOpts[ i ];
2.
37K
06 марта 2008 года
Vialent
0 / / 06.03.2008
Мне нравитсяМне не нравится
18 марта 2008, 17:43:10
Э-э попробую чуток поправить. Видать форум элемент i внутри массива DlgOpts воспринимает как тэг [ i ]. Юнит нужно писать в тэге код.

По ошибке. Нужно найти:
Код:
ulFlags:= 0;

for i := Low(TSFDOption) to High(TSFDOption) do

if i in FOptions then

ulFlags:= ulFlags OR DlgOpts;
и заменить на
Код:
ulFlags:= 0;

for i := Low(TSFDOption) to High(TSFDOption) do

if i in FOptions then

ulFlags:= ulFlags OR DlgOpts;

3.
27K
01 марта 2007 года
ive
0 / / 01.03.2007
Мне нравитсяМне не нравится
1 марта 2007, 20:13:31
В примере Владимира от 17 марта 2006, 10:53:08 ошибка!
...
ulFlags:= 0;
for i := Low(TSFDOption) to High(TSFDOption) do
if i in FOptions then ulFlags:= ulFlags OR DlgOpts;
...
Должно быть
...
ulFlags:= 0;
for i := Low(TSFDOption) to High(TSFDOption) do
if i in FOptions then ulFlags:= ulFlags OR DlgOpts;
...
4.
27K
01 марта 2007 года
ive
0 / / 01.03.2007
Мне нравитсяМне не нравится
1 марта 2007, 20:10:07
В примере Владимира от 17 марта 2006, 10:53:08 ошибка
...
ulFlags:= 0;
for i := Low(TSFDOption) to High(TSFDOption) do
if i in FOptions then ulFlags:= ulFlags OR DlgOpts;
...
Должно быть
...
ulFlags:= 0;
for i := Low(TSFDOption) to High(TSFDOption) do
if i in FOptions then ulFlags:= ulFlags OR DlgOpts;
...


5.
27K
01 марта 2007 года
ive
0 / / 01.03.2007
Мне нравитсяМне не нравится
1 марта 2007, 20:07:45
В примере Владимира от 17 марта 2006, 10:53:08 ошибка
...
ulFlags:= 0;
for i := Low(TSFDOption) to High(TSFDOption) do
if i in FOptions then ulFlags:= ulFlags OR DlgOpts;
...
Должно быть
...
ulFlags:= 0;
for i := Low(TSFDOption) to High(TSFDOption) do
if i in FOptions then ulFlags:= ulFlags OR DlgOpts;
...


6.
Аноним
Мне нравитсяМне не нравится
18 марта 2006, 00:11:11
2UL
У меня всё работает.
2All
Только форма с диалогом вылазит с боку, как её настроить что бы вылазила по центру? И как сделать что бы можно было указывать папки только с жесткого диска?
7.
Аноним
Мне нравитсяМне не нравится
17 марта 2006, 10:53:08
unit SelectFolderDialog;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ShlObj;

type
TSFDOption = (sfdoReturnOnlyFSDirs, sfdoDontGoBelowDomain, sfdoStatusText,
sfdoReturnFSAncestors, sfdoEditBox, sfdoValidate, sfdoBrowseForComputer,
sfdoBrowseForPrinter, sfdoBrowseIncludeFiles);
TSFDOptions = Set of TSFDOption;

TSFBrowseFor = (sfbfDesktop, sfbfInternet, sfbfPrograms, sfbfControls,
sfbfPrinters, sfbfPersonal, sfbfFavorites, sfbfStartup, sfbfRecent,
sfbfSendto, sfbfBitBucket, sfbfStartMenu, sfbfDesktopDirectory,
sfbfDrives, sfbfNetwork, sfbfNethood, sfbfFonts, sfbfTemplates,
sfbfCommonStartMenu, sfbfCommonPrograms, sfbfCommonStartUp,
sfbfCommonDesktopDirectory, sfbfAppData, sfbfPrintHood, sfbfAltStartUp,
sfbfCommonAltStartUp, sfbfCommonFavorites, sfbfInternetCache, sfbfCookies,
sfbfHistory);

TSelectFolderDialog = class(TComponent)
private
FPath, FTitle: String;
FOptions: TSFDOptions;
FBrowseFor: TSFBrowseFor;
protected
public
constructor Create(AOwner: TComponent); override;
function Execute: Boolean;

property Path: String read FPath;
published
property BrowseFor: TSFBrowseFor read FBrowseFor write FBrowseFor;
property Options: TSFDOptions read FOptions write FOptions
default [sfdoReturnOnlyFSDirs, sfdoStatusText];
property Title: String read FTitle write FTitle;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Dialogs', [TSelectFolderDialog]);
end;

const
DlgOpts: array [TSFDOption] of Cardinal = (BIF_RETURNONLYFSDIRS,
BIF_DONTGOBELOWDOMAIN, BIF_STATUSTEXT, BIF_RETURNFSANCESTORS, BIF_EDITBOX,
BIF_VALIDATE, BIF_BROWSEFORCOMPUTER, BIF_BROWSEFORPRINTER,
BIF_BROWSEINCLUDEFILES);
BF: array [TSFBrowseFor] of Cardinal = (CSIDL_DESKTOP, CSIDL_INTERNET,
CSIDL_PROGRAMS, CSIDL_CONTROLS, CSIDL_PRINTERS, CSIDL_PERSONAL,
CSIDL_FAVORITES, CSIDL_STARTUP, CSIDL_RECENT, CSIDL_SENDTO, CSIDL_BITBUCKET,
CSIDL_STARTMENU, CSIDL_DESKTOPDIRECTORY, CSIDL_DRIVES, CSIDL_NETWORK,
CSIDL_NETHOOD, CSIDL_FONTS, CSIDL_TEMPLATES, CSIDL_COMMON_STARTMENU,
CSIDL_COMMON_PROGRAMS, CSIDL_COMMON_STARTUP, CSIDL_COMMON_DESKTOPDIRECTORY,
CSIDL_APPDATA, CSIDL_PRINTHOOD, CSIDL_ALTSTARTUP, CSIDL_COMMON_ALTSTARTUP,
CSIDL_COMMON_FAVORITES, CSIDL_INTERNET_CACHE, CSIDL_COOKIES, CSIDL_HISTORY);

constructor TSelectFolderDialog.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FOptions := [sfdoReturnOnlyFSDirs, sfdoStatusText];
end;

function TSelectFolderDialog.Execute: Boolean;
var
lpItemID: PItemIDList;
APath: array [0..Max_path] of char;
BrowseInfo: TBrowseInfo;
Wnd: HWND;
Component: TComponent;
i: TSFDOption;
begin
Result := False;
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
Component := Owner;
Wnd := 0;
while (Component <> nil) and not(Component is TForm) do
Component := Component.Owner;
if Component <> nil then
Wnd := (Component as TForm).Handle;
SHGetSpecialFolderLocation(Wnd, BF[FBrowseFor], BrowseInfo.pidlRoot);
with BrowseInfo do
begin
hwndOwner := Wnd;
lpszTitle := PChar(FTitle);
pszDisplayName := APath;
ulFlags := 0;
for i := Low(TSFDOption) to High(TSFDOption) do
if i in FOptions then
ulFlags := ulFlags or DlgOpts;
end;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then
begin
SHGetPathFromIDList(lpItemID, APath);
FPath := APath;
GlobalFreePtr(lpItemID);
Result := True;
end;
end;

end.
8.
Аноним
Мне нравитсяМне не нравится
9 июня 2005, 13:28:30
При бросании компоненты на форму возникает ошибка
Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог