Delphi World - Получение информации о системных шрифтах
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Получение информации о системных шрифтах

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

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Получение информации о системных шрифтах

Данная функция возвращает Наndle системного шрифта (определённого в свойтвах
экрана). В качестве параметра используется одно из значений типа TNCFont:

CaptionFont - шрифт, используемый в заголовках форм;
MenuFont - шрифт меню;
MessageFont - шрифт текста в стандартных диалоговых окнах;
SmCaptionFont - шрифт всплывающих подсказок;
StatusFont - шрифт строк состояния;

Зависимости: Windows
Автор:       Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright:   Dimka Maslov
Дата:        21 мая 2002 г.
***************************************************** }

type
  TNCFont = (CaptionFont, MenuFont, MessageFont, SmCaptionFont, StatusFont);

function GetNCFontHandle(const NCFont: TNCFont): cardinal;
var
  NCM: TNonClientMetrics;
  LF: TLogFont;
  B: LongBool;
begin
  NCM.cbSize := SizeOf(NCM);
  B := SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCM, 0);
  if B then
  begin
    case NCFont of
      SmCaptionFont: LF := NCM.lfSmCaptionFont;
      CaptionFont: LF := NCM.lfCaptionFont;
      MenuFont: LF := NCM.lfMenuFont;
      MessageFont: LF := NCM.lfMessageFont;
      StatusFont: LF := NCM.lfStatusFont;
    else
      LF := NCM.lfMessageFont;
    end;
    {if WinNT then begin
     LF.lfCharset:=LangIDToCharset(0);
    end;}
  end
  else
  begin
    FillChar(LF, SizeOf(LF), 0);
    LF.lfHeight := -11;
    LF.lfWidth := 0;
    LF.lfCharSet := DEFAULT_CHARSET;
    StrPCopy(@LF.lfFaceName[0], 'MS Sans Serif');
  end;
  Result := CreateFontIndirect(LF);
end;

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

Button1.Font.Handle := GetNCFontHandle(MessageFont);
StatusBar1.Font.Handle := GetNCFontHandle(StatusFont); 
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования