Как автоматически масштабировать шрифты в Delphi-приложении для разных размеров экрана и DPI устройств

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

При разработке кроссплатформенных приложений для мобильных устройств на Delphi одна из ключевых проблем — адаптация интерфейса к разнообразию экранов. Как показывает обсуждение пользователя stewag64, классические подходы с использованием layout-файлов имеют существенные недостатки: трудоёмкость поддержки и невозможность охвата всех комбинаций размеров/DPI. Рассмотрим решение этой проблемы с примерами на Object Pascal.

Проблема адаптации шрифтов

Основные сложности:
1. Фиксированные размеры шрифтов плохо работают на устройствах с разной плотностью пикселей (DPI)
2. Разнообразие экранов Android-устройств делает ручное создание лэйаутов неэффективным
3. Динамический контент (разные длины текста) требует гибкого подхода

Анализ предложенного решения

Пользователь предложил функцию SetFontSize, которая подбирает размер шрифта эмпирическим путём:

function SetFontSize(LongestText: String; MaxWidth: Single; MarginPerc: Integer): Integer;
var
  i: Integer;
  bmp: TBitmap;
  TextWidth: Single;
begin
  Result := 10;
  bmp := TBitmap.Create(1, 1);
  try
    for i := 10 to 50 do
    begin
      bmp.Canvas.Font.Size := i;
      TextWidth := bmp.Canvas.TextWidth(LongestText) * (1 + MarginPerc / 100);
      if TextWidth > MaxWidth then
      begin
        Result := i;
        Break;
      end;
    end;
  finally
    bmp.Free;
  end;
end;

Преимущества:
- Автоматический подбор под конкретный текст
- Учёт произвольных размеров контролов

Недостатки:
- Не учитывает DPI устройства
- Цикличный подбор может быть ресурсоёмким
- Разные размеры шрифтов у соседних контролов
- Не учитывает высоту текста

Улучшенное решение с учётом DPI и масштабирования

Шаг 1. Получение реальных физических параметров экрана

Используем системные метрики для правильного учёта DPI:

uses
  System.Types, FMX.Platform;

function GetScreenScale: Single;
var
  ScreenSvc: IFMXScreenService;
begin
  if TPlatformServices.Current.SupportsPlatformService(IFMXScreenService, ScreenSvc) then
    Result := ScreenSvc.GetScreenScale
  else
    Result := 1.0;
end;

function GetAdjustedFontSize(BaseSize: Integer): Single;
begin
  Result := BaseSize * GetScreenScale;
end;

Шаг 2. Автоматическое масштабирование для контейнеров

Используем свойства TGridPanelLayout с динамическим расчётом:

procedure TForm1.AdjustLayout;
const
  BASE_HEIGHT = 640; // Базовая высота экрана для проектирования
var
  ScaleFactor: Single;
begin
  ScaleFactor := ClientHeight / BASE_HEIGHT;

  // Масштабируем все контролы
  Label1.Font.Size := Round(12 * ScaleFactor);
  Button1.Font.Size := Round(14 * ScaleFactor);
  Memo1.Font.Size := Round(10 * ScaleFactor);

  // Адаптируем GridPanelLayout
  GridPanelLayout1.RowCollection[2].Value := Memo1.Height * 1.1;
end;

Шаг 3. Универсальная функция подбора размера шрифта с учётом DPI

Усовершенствуем оригинальное решение пользователя:

function SmartFontSize(Control: TControl; const Text: String; MaxWidth: Single): Integer;
var
  bmp: TBitmap;
  Scale: Single;
begin
  Result := 10;
  Scale := GetScreenScale;
  MaxWidth := MaxWidth * Scale; // Учёт DPI

  bmp := TBitmap.Create(1, 1);
  try
    bmp.Canvas.Font.Assign(Control.Font);
    for Result := 10 to 50 do
    begin
      bmp.Canvas.Font.Size := Round(Result * Scale);
      if bmp.Canvas.TextWidth(Text) > MaxWidth then
        Break;
    end;
    Result := Result - 1; // Предотвращаем выход за границы
  finally
    bmp.Free;
  end;
end;

// Использование:
Button1.Font.Size := SmartFontSize(Button1, 'Longest Button Text', Button1.Width);

Альтернативные подходы

1. Использование стилей с относительными размерами

// В стиле компонента:
object TStyleBook
  Styles = <
    item
      Name = 'ButtonStyle'
      Style = <
        item
          Font.Size = 14.000000000000000000
          StyleName = 'fontscale'
        end>
    end>
end

// В коде:
procedure ScaleStyles;
var
  Style: TStyleItem;
begin
  Style := StyleBook1.Style['ButtonStyle'].ItemByStyleName('fontscale');
  Style.Font.Size := 14 * GetScreenScale;
end;

2. Комбинирование TGridPanelLayout и TFlowLayout

// В контейнере FlowLayout устанавливаем:
FlowLayout1.HorizontalSpacing := Round(8 * GetScreenScale);
FlowLayout1.VerticalSpacing := Round(8 * GetScreenScale);

Важные нюансы реализации

1. Учёт ориентации экрана:
   procedure TForm1.FormResize(Sender: TObject);
begin
if ClientWidth > ClientHeight
then
AdjustLayoutLandscape
else
AdjustLayoutPortrait;
end;

2. Оптимизация производительности:
   Кэширование расчётов
   Предварительная генерация размеров для стандартных элементов
   Использование битмапов только при первом запуске

3. Работа с многострочным текстом:
   function GetTextHeight(Canvas: TCanvas; Text: String; Width: Single): Single;
var Layout: TTextLayout;
begin
Layout := TTextLayoutManager.DefaultTextLayout.Create;
try
Layout.BeginUpdate;
Layout.Font := Canvas.Font;
Layout.Text := Text;
Layout.MaxSize := TPointF.Create(Width, MaxSingle);
Layout.EndUpdate;
Result := Layout.Height;
finally
Layout.Free;
end;
end;

Заключение

Для эффективного масштабирования шрифтов в Delphi-приложениях рекомендуется: 1. Использовать системные метрики DPI через GetScreenScale 2. Комбинировать относительное масштабирование с динамическим подбором 3. Применять адаптивные контейнеры (TGridPanelLayout, TFlowLayout) 4. Тестировать на реальных устройствах с разными параметрами экранов

Пример реализации можно расширить добавлением кэширования размеров шрифтов и создания универсального компонента-адаптера, который автоматизирует процесс масштабирования для всего приложения.

Создано по материалам из источника по ссылке.

Адаптация шрифтов в Delphi-приложениях для различных экранов и DPI с использованием динамического масштабирования и системных метрик.

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

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

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