Unit StdWindows;

interface
uses Windows, Messages, CommDlg, ShlObj, ActiveX, ShellAPI;
var
  hParentWnd: HWND;   //Окно, в котором расположены элементф управления
  hAppInst: Cardinal;

//Функции вывода диалоговых окон
//...следующие две функции возвращают пустую строку,
//если не нажата кнопка OK  в окне диалога
function ShowOpen(strFilter: string; nFilterIndex: Integer = 0;
                  strInitFileName: string = '';
                  strTitle: string = 'Открытие файла'):string;
function ShowSave(strFilter: string; nFilterIndex: Integer = 0;
                  strInitFileName: string = '';
                  strTitle: string = 'Сохранение файла'):string;
//...если пользователь нажал Отмена, то возвращается старое значение цвета,
//иначе - выбранное в диалоговом окне
function ShowChooseColor(lastColor: COLORREF = 0):COLORREF;
//...если пользователь нажал OK, то изменяется значение параметра и
//возвращается TRUE
function ShowChooseFont(var font: LOGFONT):BOOL;
//...возвращает выбранную папку или ''б если нажата кнопка отмены
function ShowChooseFolder(strTitle: string = ''):string;
//...взвращают TRUE при присоединении или отсоединении сетевого ресурса
function ShowConnection(): BOOL;
function ShowDisconnect(): BOOL;
//...показывает окно "О программе"
procedure ShowAbout(strAppName: string; strInfo: string = '');

implementation
var
  colors :array [1..16] of COLORREF; //16 цветов для диалога выбора цвета

//Замена символов '|' в строке на символы с нулевым кодом
procedure PrepareFilterString(var strFilter: string);
var
  i: Integer;
begin
  for i := 1 to length(strFilter) do
    if (strFilter[i] = '|') then strFilter[i] := #0;
end;
//Удаление pidl'а (указатель на структуру, используемую Shell API-функциями)
procedure DeletePIDL(pidl: PItemIDList);
var
  pMalloc: IMalloc;
begin
    SHGetMalloc(pMalloc);
    if (pMalloc <> nil) then
    begin
      pMalloc.Free(pidl);
      pMalloc._Release();
    end;
end;

//Копирование текста из строки (string) в массив Char
procedure CopyToArray(str: string; var arr: array of Char);
var
  i: Integer;
begin
  for i := 1 to length(str) do
    arr[i-1] := str[i];
  arr[length(str)] := #0;
end;

//Окно открытия файла
function ShowOpen(strFilter: string; nFilterIndex: Integer;
                  strInitFileName: string; strTitle: string):string;
var
  ofn: OPENFILENAME;
begin
  ZeroMemory(Addr(ofn), SizeOf(ofn));
  //Формурование буфера (260 символов)
  SetLength(strInitFileName, MAX_PATH);
  PrepareFilterString(strFilter);

  //Заполнение структуры для диалога
  ofn.lStructSize := SizeOf(ofn);
  ofn.hWndOwner := hParentWnd;
  ofn.hInstance := hAppInst;
  ofn.lpstrFilter := PAnsiChar(strFilter);
  ofn.nFilterIndex := nFilterIndex;
  ofn.lpstrFile := PAnsiChar(strInitFileName);
  ofn.nMaxFile := MAX_PATH;
  ofn.lpstrTitle := pAnsiChar(strTitle);
  ofn.Flags := OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST or OFN_HIDEREADONLY;

  //Отображение окна диалога и обработка результата
  if (GetOpenFileName(ofn) = TRUE) then
    ShowOpen := ofn.lpstrFile;
end;
//Окно сохранения файла
function ShowSave(strFilter: string; nFilterIndex: Integer;
                  strInitFileName: string; strTitle: string):string;
var
  ofn: OPENFILENAME;
begin
  ZeroMemory(Addr(ofn), SizeOf(ofn));
  //Формурование буфера (260 символов)
  SetLength(strInitFileName, MAX_PATH);
  PrepareFilterString(strFilter);

  //Заполнение структуры для диалога
  ofn.lStructSize := SizeOf(ofn);
  ofn.hWndOwner := hParentWnd;
  ofn.hInstance := hAppInst;
  ofn.lpstrFilter := PAnsiChar(strFilter);
  ofn.nFilterIndex := nFilterIndex;
  ofn.lpstrFile := PAnsiChar(strInitFileName);
  ofn.nMaxFile := MAX_PATH;
  ofn.lpstrTitle := pAnsiChar(strTitle);
  ofn.Flags := OFN_PATHMUSTEXIST or OFN_OVERWRITEPROMPT;

  //Отображение окна диалога и обработка результата
  if (GetSaveFileName(ofn) = TRUE) then
    ShowSave := ofn.lpstrFile;
end;

//Окно выбора цвета
function ShowChooseColor(lastColor: COLORREF):COLORREF;
var
  choose: TChooseColor;
begin
  ZeroMemory(Addr(choose), SizeOf(choose));
  //Заполнение структуры для диалогового окна
  choose.lStructSize := SizeOf(choose);
  choose.hWndOwner := hParentWnd;
  choose.hInstance := hAppInst;
  choose.rgbResult := lastColor;
  choose.lpCustColors := Addr(colors);
  choose.Flags := CC_RGBINIT or CC_ANYCOLOR or CC_FULLOPEN;
  //Отображение окна диалога и обработка результата
  if (ChooseColor(choose) = TRUE) then ShowChooseColor := choose.rgbResult
  else ShowChooseColor := lastColor;
end;

//Окно выбора шрифта
function ShowChooseFont(var font: LOGFONT):BOOL;
var
  choose: TChooseFont;
begin
  ZeroMemory(Addr(choose), SizeOf(choose));
  //Заполнение структуры для диалогового окна
  choose.lStructSize := SizeOf(choose);
  choose.hWndOwner := hParentWnd;
  choose.hInstance := hAppInst;
  choose.lpLogFont := Addr(font);
  choose.Flags := CF_BOTH or CF_INITTOLOGFONTSTRUCT;
  //Отображение окна диалога и обработка результата
  if (ChooseFont(choose) = TRUE) then
  begin
    CopyMemory(Addr(font), choose.lpLogFont, SizeOf(font));
    ShowChooseFont := TRUE;
  end
  else ShowChooseFont := FALSE;
end;

//Окно выбора папки (просмотр дерева папок)
function ShowChooseFolder(strTitle: string):string;
var
  choose: BROWSEINFO;
  buffer: string;
  pidl: PItemIDList;
begin
  ZeroMemory(Addr(choose), SizeOf(choose));
  SetLength(buffer, MAX_PATH);
  //Заполнение структуры для диалога
  choose.hwndOwner := hParentWnd;
  choose.pidlRoot := nil;        //Корень - папка рабочего стола
  choose.pszDisplayName := PAnsiChar(buffer);
  choose.lpszTitle := PAnsiChar(strTitle);
  choose.ulFlags := 0;

  //Вывод диалогового окна и обработка результата
  pidl := SHBrowseForFolder(choose);
  if (pidl <> nil) then
  begin
    //Получение полного пути выбранной папки
    SHGetPathFromIDList(pidl, PAnsiChar(buffer));
    ShowChooseFolder := buffer;
    DeletePIDL(pidl);
  end
  else
    ShowChooseFolder := '';
end;

//Окно подключения к сетевому ресурсу
function ShowConnection(): BOOL;
begin
  ShowConnection :=
   WNetConnectionDialog(hParentWnd, RESOURCETYPE_DISK) = NO_ERROR;
end;

//Окно отключения от сетевого ресурса
function ShowDisconnect(): BOOL;
begin
  ShowDisconnect :=
   WNetDisconnectDialog(hParentWnd, RESOURCETYPE_DISK) = NO_ERROR;
end;

//Окно "О прорамме"
procedure ShowAbout(strAppName: string; strInfo: string = '');
begin
  ShellAbout(hParentWnd, PAnsiChar(strAppName), PAnsiChar(strInfo),
             LoadIcon(0, IDI_ASTERISK));
end;

end.
