Получение системного шрифта

← →
fdooch (2007-07-29 01:33) [0]

Не могли бы вы подсказать, как корректно получить системный шрифт, используемый для отрисовки надписей на элементах управления?

Первое, что приходит в голову - вызов функции GetStockObject с параметрами SYSTEM_FONT, DEFAULT_GUI_FONT. MSDN утверждает, что GetStockObject(SYSTEM_FONT) вернёт шрифт Tahoma в Windows 2000/XP и MS Sans Serif - в Windows 95/98 and Windows NT. Однако созданный мной пример не подтверждает этого:

procedure TMain.FormCreate(Sender: TObject); type TFontInfo = record StockObject: Integer; StockName : string end; const FontCount = 7; FontInfos: array [0..FontCount-1] of TFontInfo = ((StockObject: DEVICE_DEFAULT_FONT; StockName: "DEVICE_DEFAULT_FONT"), (StockObject: ANSI_FIXED_FONT; StockName: "ANSI_FIXED_FONT"), (StockObject: ANSI_VAR_FONT; StockName: "ANSI_VAR_FONT"), (StockObject: DEFAULT_GUI_FONT; StockName: "DEFAULT_GUI_FONT"), (StockObject: OEM_FIXED_FONT; StockName: "OEM_FIXED_FONT"), (StockObject: SYSTEM_FONT; StockName: "SYSTEM_FONT"), (StockObject: SYSTEM_FIXED_FONT; StockName: "SYSTEM_FIXED_FONT")); procedure AddFont(const FontName: string; LogFont: TLogFont; FontHandle: HFONT); begin with TButton.Create(Self) do begin Parent:=Self; Caption:=FontName; if FontHandle=0 then Font.Handle:=CreateFontIndirect(LogFont) else Font.Handle:=FontHandle; SetBounds(10, 10+Self.Tag*35, 200, 25) end; Tag:=Tag+1; with Memo.Lines, LogFont do begin Add(FontName); Add("Name: "+lfFaceName); Add("Height: "+IntToStr(lfHeight)); Add("Bold: "+BoolToStr(lfWeight=FW_BOLD, True)); Add("Italic: "+BoolToStr(Boolean(lfItalic), True)); Add("UnderLine: "+BoolToStr(Boolean(lfUnderline), True)); Add("StrikeOut: "+BoolToStr(Boolean(lfStrikeOut), True)); Add("") end end; var Step : Integer; NCM : TNonClientMetrics; Font : HFONT; LogFont: TLogFont; begin MSSansSerif.Font.Name:="MS Sans Serif"; Tahoma.Font.Name:="Tahoma"; SegoeUI.Font.Name:="Segoe UI"; // Получение стандартных шрифтов с помощью функции GetStockObject for Step:=0 to FontCount-1 do begin Font:=GetStockObject(FontInfos[Step].StockObject); if Font<>0 then begin FillChar(LogFont, SizeOf(LogFont), 0); if GetObject(Font, SizeOf(LogFont), @LogFont)<>0 then AddFont(FontInfos[Step].StockName, LogFont, Font) end end; // Получение шрифтов для неклиентской области окна с помощью функции SystemParametersInfo NCM.cbSize:=SizeOf(NCM); if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCM, 0) then begin AddFont("CaptionFont", NCM.lfCaptionFont, 0); AddFont("SmCaptionFont", NCM.lfSmCaptionFont, 0); AddFont("MenuFont", NCM.lfMenuFont, 0); AddFont("StatusFont", NCM.lfStatusFont, 0); AddFont("MessageFont", NCM.lfMessageFont, 0); end; end;

Вызов функции GetStockObject ни с одним параметром не дал в Windows XP верного результата (Tahoma), так же, как и в Vista (Segoe UI).

В принципе, функция SystemParametersInfo возвращает ожидаемый результат (и в XP, и в Vista), однако корректно ли использовать её для отрисовки элементов управления клиентской области окна?

Цель действий, повторю ещё раз, корректно определить системный шрифт для отрисовки элементов управления ОС с Windows 98 до Windows Vista.

← →
Leonid Troyanovsky © (2007-07-29 11:07) [1]

> fdooch (29.07.07 01:33)

> В принципе, функция SystemParametersInfo возвращает ожидаемый
> результат (и в XP, и в Vista), однако корректно ли использовать
> её для отрисовки элементов управления клиентской области
> окна?

Корректно, если оный элемент есть окно.

> Цель действий, повторю ещё раз, корректно определить системный
> шрифт для отрисовки элементов управления ОС с Windows 98
> до Windows Vista.

SystemParametersInfo Requirements

Client
Requires Windows Vista, Windows XP, Windows 2000 Professional, Windows NT Workstation, Windows Me, Windows 98, or Windows 95.

Server
Requires Windows Server 2008, Windows Server 2003, Windows 2000 Server, or Windows NT Server.

--
Regards, LVT.

← →
fd00ch © (2007-07-29 12:34) [2]

Если использовать функцию SystemParametersInfo, то какой шрифт из записи TNonClientMetrics следует использовать для отрисовки текста в кнопках, списках, деревьях и т.д.? Конечно, явно не lfCaptionFont/lfSmCaptionFont, но и оставшиеся три тоже, вроде, не уместны. Поясню своё мнение. В обычной ситуации все оставшиеся три поля записи TNonClientMetrics (lfMenuFont, lfStatusFont, lfMessageFont) ссылаются на одну и ту же структуру TLogFont. Однако пользователю доступна возможность сменить (во всей системе) любой из этих шрифтов (через "Свойства экрана"-"Оформление"-"Дополнительно" в XP). Согласитесь, будет нелогично, если я рисую на контролах надписи с помощью, к примеру, Control.Font.Handle:=CreateFontIndirect(lfMenuFont), а пользователь, изменивший шрифт для меню (на, например, готический :)), увидит соответствующие изменения во всей программе.

А вообще, почему же вызов GetStockObject(SYSTEM_FONT) возвращает шрифт System, а не MS Sans Serif, Tahoma, Segoe UI в зависимости от версии ОС? (или же у меня в вышеприведённом коде есть какая-либо ошибка?) Как я понимаю, именно он и должен возвращать нужный мне шрифт.

← →
Leonid Troyanovsky © (2007-07-29 13:10) [3]

> fd00ch © (29.07.07 12:34) [2]

> Если использовать функцию SystemParametersInfo, то какой
> шрифт из записи TNonClientMetrics следует использовать для
> отрисовки текста в кнопках, списках, деревьях и т.д.?

На кнопках, видимо, lfMessageFont,
в деревьях, списках - другое, видимо, SPI_GETICONTITLELOGFONT.
В меню - все честно, lfMenuFont.
См. также Screen.MenuFonts, IconFonts.

> А вообще, почему же вызов GetStockObject(SYSTEM_FONT) возвращает
> шрифт System, а не MS Sans Serif, Tahoma, Segoe UI в зависимости
> от версии ОС? (или же у меня в вышеприведённом коде есть
> какая-либо ошибка?) Как я понимаю, именно он и должен возвращать
> нужный мне шрифт.

Может и есть, я не смотрел :) Как насчет DeleteObject?

Попробуй DEFAULT_GUI_FONT:
The font used by the DEFAULT_GUI_FONT stock object could change. Use this stock object when you want to use the font that menus, dialog boxes, and other user interface objects use.

--
Regards, LVT.

> Leonid Troyanovsky © (29.07.07 13:10) [3]

> Попробуй DEFAULT_GUI_FONT:

А .. это я тоже просмотрел, sorry.
См. также http://www.rsdn.ru/Forum/?mid=759971

--
Regards, LVT.

Кстати, у кого есть Delphi 2007 (с подержкой Win Vista) - напишите,

пожалуйста, реализацию процедуры InitDefFontData из модуля Graphics.

Получение системного шрифта Найти похожие ветки