Автор: Babay_S
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Вызывает диалог открытия файла

вызывет диалог открытия как в офисе

Зависимости: uses activeX
Автор:       Babay_S
Copyright:   Мои раскопки
Дата:        27 сентября 2002 г.
***************************************************** }

uses activeX;

function GetFileNameFromBrowse(hOwner: LongInt; var sFile: string;
  sInitDir, sDefExt, sFilter, sTitle: string): Boolean;
{Вызывает диалог открытия файла
 Пример
 GetFileNameFromBrowse(handle,b1,'c:\Install','*.txt',
'Текстовые файлы'#0'*.txt'#0'Все файлы'#0'*.*'#0#0,'Название');
 фильтр который будет использоваться должен стоять в перечне первым
}

implementation

function SHGetFileNameFromBrowse(hOwner: LongInt; sFile: LPWSTR; nMaxFile:
  LongInt;
  sInitDir: LPWSTR; sDefExt, sFilter, sTitle: LPWSTR): Boolean;
  stdcall; external 'Shell32.dll' index 63;

//*************************** Код функций ****************************************

function GetFileNameFromBrowse(hOwner: LongInt; var sFile: string;
  sInitDir, sDefExt, sFilter, sTitle: string): Boolean;
var
  sFileW, sInitDirW, sDefExtW, sFilterW, sTitleW: PWideChar;
  sFileL, sInitDirL, sDefExtL, sFilterL, sTitleL: Integer;
begin
  sFileW := CoTaskMemAlloc(255 * sizeof(WideChar));
  StringToWideChar(SFile, SFileW, 255);
  SInitDirL := Length(sInitDir) + 1;
  sInitDirW := CoTaskMemAlloc(SInitDirL * sizeof(WideChar));
  StringToWideChar(SInitDir, SInitDirW, sInitDirL);
  SDefExtL := Length(sDefExt) + 1;
  sDefExtW := CoTaskMemAlloc(SDefExtL * sizeof(WideChar));
  StringToWideChar(SDefExt, SDefExtW, sDefExtL);
  SFilterL := Length(sFilter) + 1;
  sFilterW := CoTaskMemAlloc(SFilterL * sizeof(WideChar));
  StringToWideChar(SFilter, SFilterW, sFilterL);
  STitleL := Length(sTitle) + 1;
  sTitleW := CoTaskMemAlloc(STitleL * sizeof(WideChar));
  StringToWideChar(STitle, STitleW, sTitleL);
  Result := SHGetFileNameFromBrowse(hOwner, sFileW, Integer(sFileW), sInitDirW,
    sDefExtW, sFilterW, sTitleW);
  SFile := sFileW;
  CoTaskMemFree(sFileW);
  CoTaskMemFree(sInitDirW);
  CoTaskMemFree(sDefExtW);
  CoTaskMemFree(sFilterW);
  CoTaskMemFree(sTitleW);
end;

Пример использования:

if GetFileNameFromBrowse(handle, b1, 'c:\Install', '*.txt',
  'Текстовые файлы'#0'*.txt'#0'Все файлы'#0'*.*'#0#0      , 'Название') then
begin

end;