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;
Здесь используются флаги окна, имеющие следующие значения:
• CF_BOTH – позволяет отображать экранные и принтерные шрифты (для отображения либо экранных, либо принтерных шрифтов можно использовать флаги CF_SCREENFONTS и CF_PRINTERFONTS соответственно);
• CF_INITTOLOGFONTSTRUCT – позволяют выбрать в окне шрифт, соответствующий (или максимально похожий) шрифту, описываемому структурой LOGFONT, указатель на которую сохраняется в поле lpLogFont.
Окно для выбора папки
Чтобы иметь возможность пользоваться окном Обзор папок, можно использовать функцию, представленную в листинге 2.28.
Листинг 2.28. Окно для выбора папки
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.pi dlRoot:= 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;
Представленная в листинге 2.28 функция ShowChooseFolder возвращает полный путь указанной папки, если она выбрана, и пустую строку в противном случае. Само окно Обзор папок показано на рис. 2.5.
Рис. 2.5. Окно для выбора папки
Особенностью использованной в данном примере функции SHBrowseForFolder является то, что она возвращает не путь выбранной папки, а указатель на структуру ItemlDList (что-то вроде внутреннего представления путей). Для извлечения построения пути по содержимому этой структуры используется функция SHGetPathFromIDList. После этого структура становится больше не нужна, и ее следует удалить (с использованием специального интерфейса IMalloc). Для этого используется процедура DeletePIDL, реализованная в листинге 2.29.
Листинг 2.29. Удаление структуры ItemlDList
procedure DeletePIDL(pidl: PItemIDList);
var
pMalloc: IMalloc;
begin
SHGetMalloc(pMalloc);