Получить список CharSets, поддерживаемых шрифтом

Delphi , Графика и Игры , Шрифты

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

type
   TNewTextMetricEx = packed record
     NewTextMetric: TNewTextMetric;
     FontSignature: TFontSignature
   end;

   TCharSetRec = packed record
     Name: string;
     ID: Integer
   end;

 const
   NumCharSets = 19;

   CharSets: array[0..NumCharSets - 1] of TCharSetRec = ((Name: 'ANSI_CHARSET'; ID: 0),
     (Name: 'DEFAULT_CHARSET'; ID: 1),
     (Name: 'SYMBOL_CHARSET'; ID: 2),
     (Name: 'SHIFTJIS_CHARSET'; ID: $80),
     (Name: 'HANGEUL_CHARSET'; ID: 129),
     (Name: 'GB2312_CHARSET'; ID: 134),
     (Name: 'CHINESEBIG5_CHARSET'; ID: 136),
     (Name: 'OEM_CHARSET'; ID: 255),
     (Name: 'JOHAB_CHARSET'; ID: 130),
     (Name: 'HEBREW_CHARSET'; ID: 177),
     (Name: 'ARABIC_CHARSET'; ID: 178),
     (Name: 'GREEK_CHARSET'; ID: 161),
     (Name: 'TURKISH_CHARSET'; ID: 162),
     (Name: 'VIETNAMESE_CHARSET'; ID: 163),
     (Name: 'THAI_CHARSET'; ID: 222),
     (Name: 'EASTEUROPE_CHARSET'; ID: 238),
     (Name: 'RUSSIAN_CHARSET'; ID: 204),
     (Name: 'MAC_CHARSET'; ID: 77),
     (Name: 'BALTIC_CHARSET'; ID: 186));

 function EnumProc(const EnumLogFontEx: TEnumLogFontEx;
   const NewTextMetricEx: TNewTextMetricEx;
   FontType: Integer;
   Strings: TStrings): Integer; stdcall;
 var
   I: Integer;
   ID: Integer;
   S: string;
 begin
   ID := EnumLogFontEx.elfLogFont.lfCharSet;
   S  := Format('Unknown charset %d', [ID]);
   for I := 0 to NumCharSets - 1 do
     if CharSets[I].ID = ID then
     begin
       S := CharSets[I].Name;
       Break;
     end;
   Strings.Add(S);
   Result := 1
 end;

 procedure GetAvailableCharSets(const FaceName: string; CharSets: TStrings);
 var
   DC: THandle;
   LogFont: TLogFont;
 begin
   DC := GetDC(GetDesktopWindow);
   if DC <> 0 then
     try
       FillChar(LogFont, SizeOf(LogFont), 0);
       Move(FaceName[1], LogFont.lfFaceName, Length(FaceName));
       LogFont.lfCharSet := DEFAULT_CHARSET;
       EnumFontFamiliesEx(DC, LogFont, @EnumProc, lParam(CharSets), 0);
     finally
       ReleaseDC(GetDesktopWindow, DC)
     end
 end;


 procedure TForm1.Button1Click(Sender: TObject);
 begin
   Memo1.Clear;
   GetAvailableCharSets('Arial Narrow Bold', Memo1.Lines);
 end;

Перевод контента на русский язык:

Код, написанный на Delphi, предназначен для вывода списка поддерживаемых шрифтом наборов символов. Процедура GetAvailableCharSets принимает в качестве параметра имя шрифта и заполняет строковый список (TStrings) именами доступных наборов символов.

Разблокировка работы:

1. Получение контекста устройства (DC) для десктопа с помощью GetDC.
2. Если DC не равен 0, то попытка заполнить структуру LogFont нулями и скопировать имя шрифта в поле lfFaceName.
3. Установка поля lfCharSet структуры LogFont в значение по умолчанию (1).
4. Вызов функции EnumProc для перечисления семейств шрифтов, соответствующих указанному имени шрифта. Функция EnumProc передается в качестве callback-функции EnumFontFamiliesEx.
5. В функции EnumProc проверка, если текущий набор символов совпадает с любым из предопределенных наборов символов в массиве CharSets.
6. Если совпадение найдено, то добавление соответствующего имени набора символов в строковый список (TStrings) и выход из цикла.
7. Наконец, процедура освобождает DC с помощью ReleaseDC.

Обработчик события Button1Click используется для тестирования функциональности с шрифтом Arial Narrow Bold.

Для улучшения кода:

• Рекомендуется добавить обработку ошибок в случаях, когда имя шрифта не является действительным или перечисление семейств шрифтов fails.
• Можно добавить больше логирования или отладочной информации для лучшего понимания потока программы и идентификации потенциальных проблем.
• Если вы хотите поддерживать другие языки или наборы символов, вам нужно будет расширить массив CharSets соответственно.

Пример модифицированного кода для обработки ошибок:

procedure GetAvailableCharSets(const FaceName: string; CharSets: TStrings);
var
  DC: THandle;
  LogFont: TLogFont;
begin
  try
    DC := GetDC(GetDesktopWindow);
    if DC = 0 then
      raise Exception.Create('Failed to get device context');

    FillChar(LogFont, SizeOf(LogFont), 0);
    Move(FaceName[1], LogFont.lfFaceName, Length(FaceName));
    LogFont.lfCharSet := DEFAULT_CHARSET;

    EnumFontFamiliesEx(DC, @LogFont, @EnumProc, lParam(CharSets), 0);

  except
    on E: Exception do
      ShowMessage('Error: ' + E.Message);
  finally
    ReleaseDC(GetDesktopWindow, DC);
  end;
end;

Модифицированный код будет выбрасывать исключение, если имя шрифта не является действительным или перечисление семейств шрифтов fails, и отображать сообщение об ошибке в окне диалога.

Статья описывает способ получить список поддерживаемых шрифтом кодировок (CharSets) с помощью процедуры GetAvailableCharSets, которая использует функцию EnumFontFamiliesEx для перебора доступных шрифтов и EnumProc - подпроцедуру для определения кодировки

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Шрифты ::