Плавное масштабирование текста / forpes.ru

Главная
Плавное масштабирование текста

Плавное масштабирование текста +5

30.03.2018 03:10

small-pro 6 1900 Источник

Масштабирование текста – задача не столь тривиальная, как может показаться с первого взгляда. При простом изменении размера шрифта мы не можем получить плавного и пропорционального изменения ширины текста. Изменения происходят «скачкообразно», что сильно мешает в разработке разного рода редакторов, графиков, диаграмм, везде, где используется масштабирование.

Как пример. Разрабатывал редактор печатей. В силу специфики предметной области, работа ведется с «микроскопическими» шрифтами, размер у которых и дробный, и чрезвычайно мелкий. Без масштаба не обойтись. Однако, если при максимальном масштабе выставили все тексты как надо, сделали выравнивание, и все красиво, то при возвращении в «нормальный» масштаб, все форматирование может «полететь».

При большом масштабе логотип справа выглядит хорошо. В процессе уменьшения масштаба периодически возникает ситуация, представленная на рисунке слева – надписи «расползаются».

Надпись состоит из двух частей. Слева видим как-бы слитный текст, выглядящий как единое целое. Но при уменьшении масштаба между надписями ощутимо возникает пробел.
Функция масштаба в таких проектах – вещь крайне принципиальная. И то, что сделали при большом масштабе, должно выглядеть также при любом масштабе. Никакие «малые» сдвиги и погрешности недопустимы.

Тестовое приложение

Для проверки методов масштаба сделаем небольшое приложение. Исходник представлен в архиве.

Вверху панель с органами управления. Включая ползунок с масштабом и выбор метода масштабирования в выпадающем списке;
Все функции масштаба имеют следующий тип:

  TxDrawZoomFunc = function (ACanvas : TCanvas;    // где рисуем текст
                             ARect : TRect;        // область рисования
                             AZoom, ASize : double;// масштаб, размер шрифта
                             AText : string        // текст для отрисовки
                             ) : boolean;          // результат операции

Функции регистрируются вместе с названием в списке строк. Именно он и представлен в выпадающем списке: GDrawZoomFuncList: Tstrings = nil;
Чтобы видеть — продергивается ли текст, и насколько продергивается, рисуем сетку, зависящую от масштаба;
Вместе с текстом рисуется «расчетный» прямоугольник, который вычисляется как область текста при нормальном размере шрифта, помноженную на масштаб:

//******************************************************************************
//  Получить расчетный прямоугольник текста с учетом масштаба
//******************************************************************************
function DrawZoomCalcRect (ACanvas : TCanvas; ARect : TRect; 
                           AZoom, ASize : double; AText : string) : TRect;
var siz : TSize;
begin
  //-- шрифт в первозданном виде, без масштаба ---------------------------------
  ACanvas.Font.Height := -trunc(ASize * ACanvas.Font.PixelsPerInch/72);
  //-- получить прямоугольник области текста в его первозданном виде -----------
  GetTextExtentPoint32(ACanvas.Handle,PWideChar(AText),Length(AText), siz);  
  //----------------------------------------------------------------------------
  //  применяем масштаб, получаем расчетный прямоугольник для текста, 
  //  каким он должен быть после масштабирования  
  //----------------------------------------------------------------------------  
  result := ARect;
  result.Right := result.Left + round (AZoom * siz.Width);
  result.Bottom := result.Top + round (AZoom * siz.Height);  
end;

Во всех методах масштаба рассчитывается глобальная переменная GDiffWidth: extended. Это отношение расчетной ширины к получившейся. Нужно для анализа результатов тестирования.

Используется ряд вспомогательных функций:

//******************************************************************************
// ширина и высота прямоугольника
//******************************************************************************
function WidthRect  (ARect : TRect) : Integer;
begin
  result := ARect.Right - ARect.Left;
end;

function HeightRect (ARect : TRect) : Integer;
begin
  result := ARect.Bottom - ARect.Top;
end;

//******************************************************************************
//  Проверить валидность осмновных параметров отрисовки
//******************************************************************************
function CheckParamsValid (ACanvas : TCanvas; ARect : TRect; AObject : TObject; AObjChecked : boolean = true) : boolean;
begin
  result := (ACanvas <> nil) and 
            ((not AObjChecked) or (AObject <> nil)) and
            (WidthRect (ARect) > 0) and (HeightRect (ARect)>0);
end;

//******************************************************************************
//  Создать битмап с размерами ARect    
//******************************************************************************
function CreateBmpRect (ARect : TRect) : TBitmap;
begin
  result := TBitmap.Create;
  result.Width  := abs (WidthRect (ARect));
  result.Height := abs (HeightRect (ARect));
end;

Метод 1 «В лоб». Дробный размер шрифта

Если решать проблему «в лоб», то напрашивается такой способ: менять высоту шрифта в зависимости от масштаба. Для этого подойдет такой параметр, как Font.Height. Это высота шрифта в пикселях, и по логике вещей, это должно привести к плавному изменению масштаба.

$inline$

Где:

ASize – размер шрифта, который может быть дробным
AZoom – масштаб.

Откуда взялась формула. Высота шрифта в Windows выражается в пунктах, которые пришли, в свою очередь, из типографского дела.

1 дюйм = 25.4 мм = 72 пункта

Таким образом, первая функция масштабирования выглядит следующим образом

//******************************************************************************
//  Масштаб "в лоб"
//  1 дюйм = 25.4 мм = 72 пункта 
//******************************************************************************
function DrawZoomTextSimple (ACanvas : TCanvas; ARect : TRect; AZoom, ASize : double; AText : string) : boolean;
var rct : TRect;
begin
  result := CheckParamsValid(ACanvas,ARect,nil,false) and (AText<>'');
  if not result then exit;
  rct := DrawZoomCalcRect(ACanvas, ARect, AZoom, ASize, AText);
  
  with Acanvas do begin
    Pen.Color := clGreen;
    Pen.Width := 1;
    Rectangle(rct);
    Font.Height := -trunc(AZoom * ASize * Font.PixelsPerInch / 72);
    TextOut (ARect.Left, ARect.Top, AText); 
    GDiffWidth := WidthRect(rct) / TextWidth(AText);
  end;
end;

Результат виден на рисунке.

Если слева двойка краем четко расположена на серой линии, то при незначительном изменении масштаба на правом рисунке, серая линия пересекает двойку по центру.

Результат неудовлетворительный.

Метод 2 «Мировые координаты» SetGraphicsMode

Понятно, что топором блоху не подковать. Надо использовать инструментарий, который предоставляет Windows.

function SetGraphicsMode(hdc: HDC; iMode: Integer): Integer;

DC Дескриптор контекста устройства.
iMode Определяет графический режим. Этот параметр может быть одним из нижеследующих значений:
GM_COMPATIBLE: Устанавливает графический режим, который является совместимым с 16-разрядными Windows. Это — режим по умолчанию.
GM_ADVANCED: Устанавливает улучшенный графический режим, который дает возможность преобразования мирового пространства. В том числе, в этом режиме доступна трансформация масштаба. Вот ее и задействуем.

Алгоритм работы следующий:

Перевести DC в режим GM_ADVANCED;
Проинициализировать поля структуры TXForm (которая на самом деле представляет собой матрицу). Преобразование будет осуществляться по следующим формулам:
$inline$
$inline$
Как видно, чтобы осуществить масштаб, нас интересуют поля eM11 и eM22;
Назначить матрицу преобразования: SetWorldTransform(DC, xFrm);
Нарисовать текст в «обычных» координатах, без учета масштаба, в своем «обычном» размере;
Вернуть трансформацию в изначальное состояние.
Вернуть предыдущий режим.

Вторая функция масштабирования выглядит следующим образом:

//******************************************************************************
//  Масштаб SetGraphicsMode (GM_ADVANCED)
//   Применяем трансформацию масштаба
//******************************************************************************
function DrawZoomTextWorldMode(ACanvas : TCanvas; ARect : TRect; 
                               AZoom, ASize : double; AText : string) : boolean;
var rct  : TRect;
    oldM : integer;    
    xFrm : TXForm;
begin
  result := CheckParamsValid(ACanvas,ARect,nil,false) and (AText <> '');
  if not result then exit;
  //-- получим прямоугольник текста в первозданном виде, масштаб=1 -------------
  rct := DrawZoomCalcRect(ACanvas,ARect,1,ASize,AText);
  //-- назначаем "продвинутый" режим контексту устройства ----------------------
  oldM := SetGraphicsMode(ACanvas.Handle, GM_ADVANCED);

  try
    //-- обнуляем матрицу ------------------------------------------------------
    FillChar(xFrm,SizeOf(xFrm),0);  
    //-- устанавливаем нужный коэффициенты -------------------------------------
    //   x' = x * eM11 + y * eM21 + eDx 
    //   y' = x * eM12 + y * eM22 + eDy 
    xFrm.eM11 := AZoom;
    xFrm.eM22 := AZoom;
    //-- назначили матрицу преобразования --------------------------------------
    SetWorldTransform(ACanvas.Handle, xFrm);
    //-- рисуем так, как будто ничего не знаем про масштаб ---------------------
    with Acanvas do begin
      Pen.Color := clRed;
      Pen.Width := 1;
      Rectangle (rct);
      TextOut (rct.Left, rct.Top, AText);
      //-- ситаем коеффициент различия расчетной/реальной ширины текста --------
      GDiffWidth := WidthRect(rct)/TextWidth(AText);
    end;
  finally
    //-- вернем матрицу преобразования на место --------------------------------
    xFrm.eM11 := 1;
    xFrm.eM22 := 1;
    SetWorldTransform(ACanvas.Handle, xFrm);
    //-- возвращаем режим на место ---------------------------------------------
    SetGraphicsMode(ACanvas.Handle, oldM);
  end;
end;

Результат таков:

Ситуация, аналогичная предыдущей. Слева двойка уютно расположилась между серых границ клеток, справа линия клеток ее пересекает. Т.е. от «продергивания» при масштабе не избавились.

Однако, положительные моменты тут есть: можно рисовать, не заботясь о масштабе. Т.е., у нас есть некая очень большая функция, рисующая что-то очень несоразмерно крутое, но без учета масштаба. Мы можем перед ее вызовом назначить матрицу преобразования, получив, тем самым, возможность масштабировать. Задействовав, при этом, параметры eDx и eDy, получим еще и перемещение.

Следует обратить внимание, что толщина линий также меняется в зависимости от масштаба. Дополнительные вкусности и трансформации – не по теме статьи.

Между тем, нужный результат не достигнут.

Метод 3 «Масштаб» SetMapMode / MM_ISOTROPIC

Преобразование координат средствами Windows на методе 2 SetGraphicsMode(GM_ADVANCED) не заканчивается. Рассмотрим связку следующих функций:

function SetMapMode(DC: HDC; p2: Integer): Integer; 
function SetWindowExtEx(DC: HDC; XExt, YExt: Integer; Size: PSize): BOOL; 
function SetViewportExtEx(DC: HDC; XExt, YExt: Integer; Size: PSize): BOOL;

Функция SetMapMode заставляет выбранный контекст устройства считать пиксель чем-то иным. Допустим, пиксель может быть на самом деле 0.001 дюйма. Это зависит от параметра p2, который может принимать следующие значения:

MM_ISOTROPIC – произвольное масштабирование с одинаковым масштабом по обеим осям. Коэффициент масштаба задается парой SetWindowExt и SetViewportExt, о чем ниже.
MM_ANISOTROPIC – произвольное масштабирование по каждой из осей. Коэффициент масштаба задается парой SetWindowExt и SetViewportExt, о чем ниже.
MM_HIENGLISH — 0.001 дюйма. X слева — направо, Y снизу — вверх.
MM_LOENGLISH — 0.01 дюйма. X слева — направо, Y снизу — вверх.
MM_HIMETRIC — 0.01 милиметра. X слева — направо, Y снизу — вверх.
MM_LOMETRIC — 0.1 милиметра. X слева — направо, Y снизу — вверх.
MM_TEXT – Пиксель в пиксель. X слева — направо, Y снизу — вверх.
MM_TWIPS — 1/20 точки. (Точка = 1 inch /72, следовательно, twip = 1 inch /1440). X слева — направо, Y снизу — вверх.

Что значит фраза «X слева — направо, Y снизу — вверх». Это значит, что координаты по X вполне себе обычные, а вот по Y – отрицательные. Т.е., если нужно нарисовать эллипс в прямоугольнике (10,10,1000,1000), то чтобы его увидеть без дополнительных трансформаций, надо написать Ellipse (10,-10,1000,-1000).

Но нас интересует масштаб. Причем самый обычный, одинаковый на всех осях. Поэтому используем p2= MM_ISOTROPIC.

После установки режима нам надо задать коэффициент масштаба. Это делается парой функций SetWindowExtEx / SetViewportExtEx

Установка логического окна вывода
SetWindowExtEx(DC, логическая ширина, логическая высота, nil);
Установка реального окна вывода
SetViewportExtEx(DC, реальная ширина, реальная высота, nil);

Теперь у нас масштаб таков, что реальная ширина(высота) экрана, формы, пайнтбокса, произвольного прямоугольника и т.д. соответствует некоей логической ширине(высоте), например, бумаги в принтере, или ширине большой картинки, которую нужно отобразить в масштабе и т.д.

Коэффициент масштаба таков: F = (реальная величина) / (логическая величина).
Т.к. масштаб должен быть одинаков по обеим осям, Windows выбирает наименьший коэффициент.

Что такое логическая величина. Если Вы хотите отразить некую картинку, то это будут ее ширина и высота, а реальной величиной – область в пикселях, куда необходимо отразить.

Функции преобразования таковы:
x' = x * F
y' = y * F

Таким образом, реальная величина для ширины: Zoom * Width и высоты: Zoom * Height.
Третья функция масштабирования выглядит так:

//******************************************************************************
//  Масштаб: новый режим отображение SetMapMode/SetWindowExtEx/SetViewportExtEx
//******************************************************************************
function DrawZoomTextMapMode (ACanvas : TCanvas; ARect : TRect; 
                              AZoom, ASize : double; AText : string) : boolean;
var DC  : HDC;
    rct : TRect;   
    Old : integer;
    w,h : Integer;
begin
  result := CheckParamsValid(ACanvas,ARect,nil,false);
  if not result then exit;
  //-- получим расчетный прямоугольник, каким он должен быть после масштаба ----   
  rct := DrawZoomCalcRect(ACanvas,ARect,1,ASize,AText) and (AText <> '');
  //-- применим масштаб ко все области отображения -----------------------------
  DC := ACanvas.Handle;
  w := WidthRect(ARect);
  h := heightRect(ARect); 
  //-- В изотропном режиме отображения MM_ISOTROPIC масштаб вдоль осей X и Y 
  //-- всегда  одинаковый (т.е. для обоих осей одинаковые логические единицы длины)  
  Old := SetMapMode(DC, MM_ISOTROPIC);
  //-- установка логического окна вывода ----------------------
  SetWindowExtEx(DC, w, h, nil);
  //-- установка реального окна вывода ------------------------
  SetViewportExtEx(DC, round(AZoom*W), round(AZoom*H), nil);
  //-- рисуем -------------------------------------------------
  try
    with ACanvas do begin
      Pen.Color := clPurple;
      Pen.Width := 1;
      Rectangle(rct);
      TextOut (ARect.Left, ARect.Top, AText); 
      GDiffWidth := WidthRect(rct)/TextWidth(AText);
    end;  
  finally
    SetMapMode(DC, Old);
  end;
end;

Однако, результат по-прежнему не радует:

Ситуация абсолютно идентичная двум предыдущим.

Плюсы метода аналогичны методу 2 – можно не заботиться об масштабе во время написания функция «рисования», но тут нет возможности перемещения. Трансформация перемещения – сугубо ручная работа.

Вообще, эта функция не заточена под трансформации. Она больше подходит для отображения чего-либо в единицах этого чего-либо. Это некий «переводчик» с одного языка единиц измерения на язык экранного представления.

Метод 4 «Дюймы» SetMapMode / MM_HIENGLISH

Но попробуем еще один вариант. В методе 3 функция SetMapMode подробно расписана. В том числе упоминались флаги перевода из метрических систем в экранные. Попробуем поработать в дюймовой системе координат. Почему не в миллиметрах – чтобы избежать дополнительных преобразований. У нас ведь все равно изначально некие дюймовый показатели. Зачем их дополнительно делать на 25.4 (см.метод 1).

Что сподвигло. Все ж таки величина 0.001 дюйма – это очень малая дискрета. А вдруг?
Четвертая функция масштабирования такова:

//******************************************************************************
//  Масштаб новый режим отображение SetMapMode/SetWindowExtEx/SetViewportExtEx
//   MM_HIENGLISH - Каждый логический модуль преобразован в 0.001 дюйма. 
//******************************************************************************
function DrawZoomTextMapModeHIENGLISH(ACanvas : TCanvas; ARect : TRect; 
                                      AZoom, ASize : double; AText : string) : boolean;
var DC : HDC;
    Old: integer;
    pnt : TPoint;
    rct : TRect;
    siz : TSize;
    tmp : Integer;
begin
  result := CheckParamsValid(ACanvas,ARect,nil,false) and (AText <> '');
  if not result then exit;
  //-- тут масштаб не нужен, нужен фиксированный размер шрифта ---------
  ACanvas.Font.Height := -trunc(ASize * ACanvas.Font.PixelsPerInch / 72);
  tmp := ACanvas.Font.Height;
  DC := ACanvas.Handle;
  //-- Число пикселей на горизонтальный логический дюйм ------------------------
  pnt.X := GetDeviceCaps(DC,LogPixelsX);
  //-- Число пикселей на вертикальный логический дюйм --------------------------
  pnt.Y := GetDeviceCaps(DC,LogPixelsY);
  //-- считаем размер в дюймах (0.001 дюймов)----------------------------------- 
  GetTextExtentPoint32(DC,PWideChar(AText),Length(AText), siz);
  rct.Top := -round(1000* AZoom * ARect.Top / pnt.Y);
  rct.Left := round(1000* AZoom * ARect.Left / pnt.X);  
  rct.Right := rct.Left + round(1000* AZoom * siz.Width / pnt.X);
  rct.Bottom := rct.Top - round(1000* AZoom * siz.Height / pnt.Y);  
  
  ACanvas.Font.Height := -round(rct.Bottom-rct.Top) ;
  Old := SetMapMode(DC, MM_HIENGLISH);
  
  try
    with Acanvas do begin
      Pen.Color := clTeal;
      Pen.Width := 1;
      Rectangle (rct);
      TextOut (rct.Left, rct.Top, AText);
      GDiffWidth := WidthRect(rct) / TextWidth(AText);
    end;
  finally
    SetMapMode(DC, Old);
    ACanvas.Font.Height := tmp;
  end;
end;

К сожалению, результат ничем не лучше предыдущих:

Метод 5 «Посимвольная отрисовка»

Во всех предыдущих методах такое ощущение, что целочисленная часть TLogFont. lfHeight ощутимо портит жизнь и не позволяет осуществить «тонкую» настройку под определенный масштаб. Эх… была б она дробной… Ну ладно, попробуем решить проблему иначе.

Основная идея такая: проход по всем символам текста, подсчет начала по оси X, где должен быть выведен символ. Коэффициент пересчета вычисляется изначально, как отношение расчетной ширины и реальной.

//******************************************************************************
//  Масштаб посимвольной отрисовкой
//******************************************************************************
function DrawZoomTextChar(ACanvas : TCanvas; ARect : TRect; 
                          AZoom, ASize : double; AText : string) : boolean;
var rct : TRect;
    fct : double;
    i : Integer;
    w : Integer;
begin
  result := CheckParamsValid(ACanvas,ARect,nil,false) and (AText <> '');
  if not result then exit;
  //-- считаем, каким дорлжен стать прямоугольник текста при масштабе ----------
  rct := DrawZoomCalcRect(ACanvas,ARect,AZoom,ASize,AText);

  try
    with ACanvas do begin
      Pen.Color := clMaroon;
      Pen.Width := 1;
      Rectangle(rct);
      GDiffWidth := WidthRect (rct);
      //-- отмасштабировали шрифт ----------------------------------------------
      Font.Height := -trunc(AZoom * ASize * Font.PixelsPerInch/72);
      //-- отношение "правидьной" ширины к реальной ----------------------------
      fct := WidthRect (rct)/TextWidth(AText);
      //-- проходим по всем символам строки, считаем координаты начала, выводим 
      w := 0;      
      for i := 1 to Length(AText) do begin
        TextOut (rct.Left, rct.Top, AText[i]);
        w := w + TextWidth(AText[i]);
        //-- сместили начало следующего символа относительно общего начала ----- 
        rct.Left := round (ARect.Left + w * fct);
      end; 
      GDiffWidth := GDiffWidth / (rct.Left-ARect.Left);
    end;  
  except
    result := false;
  end;
end;

Поразительно, но работает:

Двойка намертво прилипла к линии и не покидает ее при любом масштабе.

Первый успешный метод масштабирования. Цель достигнута, но хотелось бы более качественного решения.

Метод 6 «Bitmap буфер»

Предыдущий метод состоял в том, что происходила посимвольная «подгонка» под требуемый рассчитанный заранее размер путем сдвига начала отрисовки каждого символа. А что если все то же самое сделать на основе bitmap?

Идея заключается в том, что текст вначале рисуется на некий промежуточный битмап в заданном масштабе. Назовем ее «боевой» матрицей. Затем происходит stretch копирование на другую битмап-матрицу, у которой установлен размер, согласно посчитанным значениям. После этого происходит «прозрачное» копирование на «рабочую» канву.

Текст функции:

//******************************************************************************
//  Масштаб с использованием TBitmap и StretchDraw
//******************************************************************************
function DrawZoomTextBitmap(ACanvas : TCanvas; ARect : TRect; 
                            AZoom, ASize : double; AText : string) : boolean;
var rct: TRect; 
    val: TRect; 
    siz: TSize; 
    bmp: TBitmap; // битмап-буфер "боевая" матрица
    dst: TBitmap; // битмап-stretch приемник
begin
  result := CheckParamsValid(ACanvas,ARect,nil,false) and (AText <> '');
  if not result then exit;
  //-- считаем, каким дорлжен стать прямоугольник текста при масштабе ----------  
  rct := DrawZoomCalcRect(Acanvas,Arect,AZoom,ASize,AText); 
  //-- находим реальный прямоугольник при масштабе -----------------------------
  ACanvas.Font.Height := -trunc(AZoom * ASize * ACanvas.Font.PixelsPerInch / 72);
  GetTextExtentPoint32(ACanvas.Handle,PWideChar(AText),Length(AText), siz);
  val := ARect;
  val.Right := val.Left + siz.Width;
  val.Bottom := val.Top + siz.Height;
  //-- битмап-буфер, на котором рисуем текст -----------------------------------
  bmp := CreateBMPRect (val);// имеет реальный, не "расчетный" размер 
  try 
    with bmp.Canvas do begin
      Font.Assign(ACanvas.Font);
      Brush.Color := clWhite;
      TextOut(0,0,AText);
    end;
    //-- создаем буфер с расчетными размерами ----------------------------------
    dst := CreateBmpRect(rct);
    //-- растягиваем/стягиваем "боевую" матрицу под размер, который должен быть
    dst.Canvas.StretchDraw(dst.Canvas.ClipRect,bmp);
    //-- рисуем с прозрачностью на канву ---------------------------------------
    dst.TransparentColor := clWhite;
    dst.Transparent := true;
    with ACanvas do begin
      Pen.Color := clBlue;
      Pen.Width := 1;
      Rectangle(rct);
      ACanvas.Draw(rct.Left,rct.Top,dst);
    end; 
    GDiffWidth := WidthRect(rct) / dst.Width; 
  finally
    if dst <> nil then dst.Free;
    bmp.Free;
  end;        
end;

И этот метод также работает отменно:

Текст как будто прилип к своим клеткам. Чрезвычайно плавное масштабирование.

Второй успешный метод масштабирования. Цель достигнута, но хотелось бы еще более качественного решения. Слишком ресурсоёмки два последних метода. Это вот прямо чувствуется.

Метод 7 «GDI+» Масштаб размером шрифта

Вот и подошли к однозначно правильному и великолепному средству, как масштабирование и вывод текста силами GDI+.

Здесь комментировать особо нечего. Основное, это изменение размера шрифта, согласно масштабу. И вывод текста средствами GDI+, с использованием антиалиасинга (TextRenderingHintAntiAlias). Все остальное вполне понятно по исходнику:

//******************************************************************************
//  Масштаб GDI+ с изменением размера шрифта
//******************************************************************************
function DrawZoomTextGDIPlus(ACanvas : TCanvas; ARect : TRect; 
                             AZoom, ASize : double; AText : string) : boolean;
var clr : TColor;
    grp : TGPGraphics;
    brh : TGPSolidBrush;
    nam : TGPFontFamily;
    fsl : FontStyle;
    src : TGPRectF;
    fnt : TGPFont;    
begin
  result := CheckParamsValid(ACanvas,ARect,nil,false) and (AText<>'');
  if not result then exit;
  ACanvas.Font.Height := -trunc(AZoom * ASize * ACanvas.Font.PixelsPerInch / 72);

  grp := TGPGraphics.Create(ACanvas.Handle);
  try
    with ACanvas do begin
      clr := Font.Color;
      //-- создаем название шрифта ---------------------------------------------
      nam := TGPFontFamily.Create(Font.Name);
      //-- определяем стиль шрифта ---------------------------------------------
      fsl := FontStyleRegular;
      if fsBold in Font.Style then fsl := fsl + FontStyleBold;
      if fsItalic in Font.Style then fsl := fsl + FontStyleItalic;
      if fsUnderline in Font.Style then fsl := fsl + FontStyleUnderline;      
      if fsStrikeOut in Font.Style then fsl := fsl + FontStyleStrikeout;      
      //-- устанавливаем антиалиасинг с "растягиванием" по расчетной ширине ----
      grp.SetTextRenderingHint(TextRenderingHintAntiAlias);
      //-- создаем кисть для шрифта, цвет шрифта -------------------------------
      brh := TGPSolidBrush.Create(MakeColor(GetRValue(clr),
                                            GetGValue(clr),
                                            GetBValue(clr)));
      //-- создаем шрифт без масштаба, в "родном" размере ----------------------
      Fnt := TGPFont.Create(nam, ASize * Font.PixelsPerInch / 72, fsl, UnitPixel); 
      //-- получаем "опоясывающий" прямоугольник -------------------------------
      grp.MeasureString(AText,-1,fnt,MakePoint(ARect.Left*1.0, ARect.Top*1.0),src);
      //-- рисуем "опоясывающий" прямоугольник -------------------------------
      Pen.Color := clNavy;      
      pen.Width := 1;
      Rectangle (round(src.X),round(src.Y),
                 round(src.X + AZoom*src.Width),
                 round(src.Y + AZoom*src.Height));
      //-- считаем и апоминаем ширину, какой она должна быть -------------------
      GDiffWidth := AZoom*src.Width;
      Fnt.Free;

      //-- создаем шрифт с учетом масштаба -------------------------------------
      Fnt := TGPFont.Create(nam, AZoom * ASize * Font.PixelsPerInch / 72, fsl, UnitPixel); 
      grp.SetTextRenderingHint(TextRenderingHintAntiAlias);
      grp.DrawString(AText, -1, Fnt, MakePoint(ARect.Left*1.0, ARect.Top*1.0), brh);              
      //-- получаем реальные размеры текста с учетом масштаба ------------------
      grp.MeasureString(AText,-1,fnt,MakePoint(ARect.Left*1.0, ARect.Top*1.0),src);
      GDiffWidth := GDiffWidth / src.Width;      
    end;  
  except
    result := false;
  end;
  Fnt.free;
  brh.free;
  nam.free;
  grp.free;
end;

Результат естественным образом превзошел все ожидания. Скрины приводить не буду, т.к. они похожи на приведенные выше, в двух последних методах. Ощутить мощь GDI+ лучше запустив исполняемый файл.

Метод 8 «GDI+» Трансформация масштаба

И снова GDI+. Но на этот раз будем использовать трансформацию масштаба. Т.е. рисуем текст в его «нормальном» размере, а его масштабированием будет заниматься движок GDI+. Трансформация осуществляется вызовом ScaleTransform(AZoom,AZoom).

//******************************************************************************
//  Масштаб GDI+ с применением трансофрмации масштаба
//******************************************************************************
function DrawZoomTextGDIPlusScale(ACanvas : TCanvas; ARect : TRect; AZoom, ASize : double; AText : string) : boolean;
var clr : TColor;
    grp : TGPGraphics;
    brh : TGPSolidBrush;
    nam : TGPFontFamily;
    fsl : FontStyle;
    src : TGPRectF;
    fnt : TGPFont;  
    pnt : TGPPointF;  
begin
  result := CheckParamsValid(ACanvas,ARect,nil,false) and (AText<>'');
  if not result then exit;

  grp := TGPGraphics.Create(ACanvas.Handle);
  try
    with ACanvas do begin
      clr := Font.Color;
      pnt := MakePoint(ARect.Left*1.0, ARect.Top*1.0); 
      //-- создаем название шрифта ---------------------------------------------
      nam := TGPFontFamily.Create(Font.Name);
      //-- определяем стиль шрифта ---------------------------------------------
      fsl := FontStyleRegular;
      if fsBold in Font.Style then fsl := fsl + FontStyleBold;
      if fsItalic in Font.Style then fsl := fsl + FontStyleItalic;
      if fsUnderline in Font.Style then fsl := fsl + FontStyleUnderline;      
      if fsStrikeOut in Font.Style then fsl := fsl + FontStyleStrikeout;      
      //-- устанавливаем антиалиасинг с "растягиванием" по расчетной ширине ----
      grp.SetTextRenderingHint(TextRenderingHintAntiAlias);
      //-- создаем кисть для шрифта, цвет шрифта -------------------------------
      brh := TGPSolidBrush.Create(MakeColor(GetRValue(clr),
                                            GetGValue(clr),
                                            GetBValue(clr)));
      //-- создаем шрифт без масштаба, в "родном" размере ----------------------
      Fnt := TGPFont.Create(nam, ASize * Font.PixelsPerInch / 72, fsl, UnitPixel); 
      //-- получаем "опоясывающий" прямоугольник -------------------------------
      grp.MeasureString(AText,-1,fnt,pnt,src);
      //-- рисуем "опоясывающий" прямоугольник -------------------------------
      Pen.Color := $00BC6C01;      
      pen.Width := 1;
      Rectangle (round(AZoom*src.X),round(AZoom*src.Y),
                 round(AZoom*(src.X + src.Width)),
                 round(AZoom*(src.Y + src.Height)));
      //-- применяем трансформацию масштаба ----------------------------------
      grp.ScaleTransform(AZoom,AZoom); 
      grp.DrawString(AText, -1, Fnt, pnt, brh);              
      GDiffWidth := 1; 
    end;  
  except
    result := false;
  end;
  Fnt.free;
  brh.free;
  nam.free;
  grp.free;
end;

Самый лучший результат из всех вышеперечисленных.

Результаты тестов

В тестовой программе можно запустить сбор статистики, нажав кнопку «Start». Будет произведен последовательный перебор всех представленных методов на всех возможных в программе масштабах. По окончании работы будет выведена следующая диаграмма:

Первый столбец – среднее время отрисовки в миллисекундах. Второй – относительное отклонение расчетных величин от фактических. Проще говоря, первый столбец – сколь мало времени занимает операция, второй — сколь высок результат масштабирования.

Как видно, методы делятся на 2 группы – первые 4 с неудовлетворительным результатом масштаба, вторые 4 – масштабирование удачное, то, чего хотелось.

Странно, но самый топорный первый метод по скорости показал лучше результаты, чем его навороченные собратья по группе неудачников. Правда, отклонения у него от расчетных значений самые большие.

Безусловный победитель – метод 8 «GDI+» с трансформацией масштаба.
Поэтому оформим отрисовку текста в GDI+ отдельной функцией.

Функция плавного масштабирования текста с поворотом на заданный угол и антиалиасингом

//******************************************************************************
//  Рисуем текст GDI+
//******************************************************************************
function DrawGDIPlusText (ACanvas : TCanvas; ARect : TRect; Angle, ASize : double; AText : string; AZoom : double = 1) : boolean;
var clr : TColor;
    grp : TGPGraphics;
    brh : TGPSolidBrush;
    nam : TGPFontFamily;
    fsl : FontStyle;
    fnt : TGPFont;    
    pnt : TGPPointF;
begin
  result := CheckParamsValid(ACanvas,ARect,nil,false) and (AText<>'');
  if not result then exit;

  grp := TGPGraphics.Create(ACanvas.Handle);
  try
    with ACanvas do begin
      clr := Font.Color;
      //-- создаем название шрифта ---------------------------------------------
      nam := TGPFontFamily.Create(Font.Name);
      //-- определяем стиль шрифта ---------------------------------------------
      fsl := FontStyleRegular;
      if fsBold in Font.Style then fsl := fsl + FontStyleBold;
      if fsItalic in Font.Style then fsl := fsl + FontStyleItalic;
      if fsUnderline in Font.Style then fsl := fsl + FontStyleUnderline;      
      if fsStrikeOut in Font.Style then fsl := fsl + FontStyleStrikeout;      
      //-- создаем кисть для шрифта, цвет шрифта -------------------------------
      brh := TGPSolidBrush.Create(MakeColor(GetRValue(clr),GetGValue(clr),GetBValue(clr)));
      //-- создаем шрифт без масштаба, в "родном" размере ----------------------
      Fnt := TGPFont.Create(nam, ASize * Font.PixelsPerInch / 72, fsl, UnitPixel); 
      //-- устанавливаем антиалиасинг с "растягиванием" по расчетной ширине ----      
      grp.SetTextRenderingHint(TextRenderingHintAntiAlias);
      //-- готовим точку начала отрисовки --------------------------------------
      pnt := MakePoint(ARect.Left*1.0, ARect.Top*1.0);
      //-- точка трансформации, если угол, то вращение будет вокруг этих координат
      grp.TranslateTransform(pnt.X,pnt.y); 
      //-- если указан угол, применяем трансформацию вращения ------------------      
      if Angle <> 0 then begin        
        //-- применяем трансформацию вращения ----------------------------------
        grp.RotateTransform(Angle); 
      end;  
      //-- рисуем текст теперь от начала "новых" координат -------------------
      pnt := MakePoint(0.0,0.0);
      //-- если указан масштаб, применяем трансформацию масштаба ------------------            
      if AZoom <> 1 then begin
        grp.ScaleTransform(AZoom,AZoom); 
      end;
      //-- рисуем текст без указания длины -------------------------------------
      grp.DrawString(AText, -1, Fnt, pnt, brh);              
    end;  
  except
    result := false;
  end;
  Fnt.free;
  brh.free;
  nam.free;
  grp.free;
end;

Небольшие выводы и комментарии

В дополнение к описанным функциям и их возможностям хочется добавить следующее: для SetMapMode существует пара функций
SetWindowOrgEx – устанавливает точку начала координат логического пространства.
SetViewportOrgEx – устанавливает точку начала координат физического пространства.
Проще говоря, вызвав SetViewportOrgEx (DC,100,100,nil), мы сделаем точку (100,100) началом координат и последующий вызов TextOut(0,0,’Center here’) нарисует этот текст от точки (100,100);
В GDI+ для установки нового начала координат используется метод TranslateTransform (см. листинг функции DrawGDIPlusText).

Вообще, зачем нужны эти «игры» с началом координат. Когда надо вращать какой-то графический объект на заданный угол, легче всего это сделать вокруг начала системы координат. Это избавит программиста от дополнительных вычислений, а листинг – от лишних строк.
Безусловно, в ряде случаев выручит SetGraphicsMode. Например, нарисовать эллипс под углом. И вообще, вместо того, чтобы мучится с каждой фигурой отдельно, заставляя ее правильно отображаться под углом, легче применить трансформацию. Метод един для всех.
При использовании масштабирования и смещения лучше пользовать SetGraphicsMode и все трансформации описывать в одной матрице TXForm.
Если пишется некий визуальный графический редактор/график/диаграмма, все равно придется использовать всякие плюшки типа антиалиасинга, масштаба, трансформации, которые есть в GDI+, не точить ли софт сразу под GDI+? Отметая все осторожные наставления – типа, глючный, типа, ресурсоемкий. Не знаю, не замечал.
GDI+ прекрасно уживается с VCL классами. Можно на одном TCanvas одновременно рисовать и стандартными методами TCanvas, и Windows API GDI, и методами GDI+.
Трансформации GDI действуют и на GDI+. Трансформации GDI+ действуют только в рамках GDI+. Т.е. трансформация, установленная, например, через SetGraphicsMode, действует также и на систему координат GDI+.

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

В форме:


type
  TFmMain = class(TForm)  
  …
  private
    FList : TxZoomStatList; // класс статистики (utlZoomStat)
    FListPoint : TPoint;
    FMouseDown : boolean;
    FMousePoint: TPoint;
    FProcessing : boolean;
    …
  End;


procedure TFmMain.pbMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FMouseDown := (Button = mbLeft) and 
                //-- статистика - последняя в списке -----------------
                (ComboBox1.ItemIndex=ComboBox1.Items.Count-1);
  if FMouseDown then begin
    //-- сохраняем точку, где началось перетаскивание ----------------
    FMousePoint := Point(X,Y);
    //-- запоминаем текущие смещения ---------------------------------    
    FListPoint := Point(FList.OffX, FList.OffY);
  end;  
end;

procedure TFmMain.pbMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FMouseDown then begin
    //-- расчет новых смещенией ------------------------------------------
    FList.OffX := FListPoint.X + X-FMousePoint.X; 
    FList.OffY := FListPoint.Y + Y-FMousePoint.Y;    
    //-- рисуем статистику -----------------------------------------------
    pbPaint(Sender);
  end;
end;

procedure TFmMain.pbMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
//-- сброс перетаскивания ---------------------
  FMouseDown := false;
end;

Описание класса статистики

type
//******************************************************************************
//  Запись по статистике   
//******************************************************************************
  PxZoomStat = ^TxZoomStat;
  TxZoomStat = packed record
    FIndex : Integer;
    FColor : TColor;
    FName  : string;
    FCount : Integer;
    FTime  : extended;
    FDiff  : extended;
    FTimeC : extended;
    FDiffC : extended;
    FTimeR : TRect;
    FDiffR : TRect;    
  end;

  TxZoomStatList = class
  private
    FOffX : Integer;
    FOffY : Integer;    
    FList : TList;
    FGDIPlus : boolean;
    function GetCount : Integer;
    function GetItem (Index : Integer) : PxZoomStat;
  public
    Constructor Create; virtual;
    Destructor Destroy; override;
    function Add (AIndex : Integer; AName : string; ATime, ADiff : Extended) : Integer; overload;
    function Add (AIndex : Integer; ATime, ADiff : Extended) : PxZoomStat; overload;    
    procedure Delete (Index : Integer);
    procedure Clear;
    property Count : Integer read GetCount;
    property Items[Index : Integer] : PxZoomStat read GetItem; default;
    //--------------------------------------------------------------------------
    property GDIPlus : boolean read FGDIPlus write FGDIPlus;
    property OffX : Integer read FOffX write FOffX;
    property OffY : Integer read FOffY write FOffY;    
  end;

Рисуем статистику. DrawZoomStatList:

//******************************************************************************
//  Рисуем статистику
//  Суть в следующем. Вся графика рисуется так, как будто никакого масштаба и 
//  перетаскивания нет. По сути, можно рисовать вообще в абсолютных координатах. 
//  Масштаб и перемещение осуществляется за счет вызова 
//  SetGraphicsMode(DC, GM_ADVANCED);
//******************************************************************************

function DrawZoomStatList(ACanvas : TCanvas; ARect : TRect; 
                          AZoom, ASize : double; AText : string) : boolean;
var lst : TxZoomStatList; // экземпляр списка со статистикой (реализован в utlZoomStat) 
    rct : TRect;   
    val : TRect;
    str : string;
    i : Integer;
    p : PxZoomStat;
    wBar : Integer;
//------------------------------------------------------------------------------
    maxTime : Extended;
    maxDiff : Extended;    
    minTime : Extended;
    minDiff : Extended;    
    wTime : Extended;
    wDiff : Extended;    
//-- масштаб -------------------------------------------------------------------    
    DC  : HDC;
    fnt : hFont;
    tmp : hFont;
//--------------------------------------
    oldM : integer;    
    xFrm : TXForm;
begin
  lst := xGZoomList(false);
  result := CheckParamsValid(ACanvas,ARect,lst,true);
  if not result then exit;
  DC := ACanvas.Handle;

  maxTime :=-1;
  maxDiff :=-1;
  minTime := MaxInt;
  minDiff := MaxInt;

  for i := 0 to lst.Count-1 do begin
    p := lst[i];
    if (p = nil) or (p^.FCount = 0) then continue;
    p^.FTimeC := p^.FTime / p^.FCount;
    p^.FDiffC := p^.FDiff / p^.FCount;  
    if p^.FTimeC > maxTime then maxTime := p^.FTimeC;   
    if p^.FTimeC < minTime then minTime := p^.FTimeC;    
    if p^.FDiffC > maxDiff then maxDiff := p^.FDiffC;   
    if p^.FDiffC < minDiff then minDiff := p^.FDiffC;    
  end;
  
  wTime := (maxTime - minTime) * 0.1;
  minTime := minTime - wTime;
  maxTime := maxTime + wTime;  

  wDiff := (maxDiff - minDiff) * 0.1;
  minDiff := minDiff - wDiff;
  maxDiff := maxDiff + wDiff;  

  with ACanvas do begin
    Font.Height := -trunc(ASize * Font.PixelsPerInch/72);
    wBar := TextWidth('F=0000.00000') div 2; // ширина столбца зависит от шрифта 
  end;
  //-- применим масштаб ко все области отображения -----------------------------
  oldM := SetGraphicsMode(DC, GM_ADVANCED);
  //-- обнуляем матрицу ------------------------------------------------------
  FillChar(xFrm,SizeOf(xFrm),0);  
  //-- устанавливаем нужный коэффициенты -------------------------------------
  xFrm.eM11 := AZoom; // если масштаб задается другим способом, здесь =1
  xFrm.eM22 := AZoom; // если масштаб задается другим способом, здесь =1
  xFrm.eDx := lst.FOffX; // смещение по X, посчитаны в главном окне программы
  xFrm.eDy := lst.FOffY; // смещение по Y, посчитаны в главном окне программы   
  //-- назначили матрицу преобразования --------------------------------------
  SetWorldTransform(DC, xFrm);

  rct := ARect;
  rct.Top := rct.Top + 10;  
  rct.Bottom := rct.Top + round ( ASize * 190/6.5); // высота столбца зависит от шрифта
  
  if wTime <> 0 then 
    wTime := (rct.Bottom - rct.Top) / (minTime - maxTime);
  if wDiff <> 0 then 
    wDiff := (rct.Bottom - rct.Top) / (minDiff - maxDiff);
  
  try
    with ACanvas do begin
      val := rct;
      val.Left := val.Left + wBar; 
      val.Right := val.Left + wBar;
      Pen.Width := 1;
      
      for i := 0 to lst.Count-1 do begin
        p := lst[i];
        if (p = nil) or (p^.FCount = 0) then continue;
        Pen.Color := Darker(p^.FColor,10);
        //-- первый столбец времени -------------------------------
        OffsetRect (val,wBar,0);
        Brush.Color := Lighter(p^.FColor,50);
        val.Top := val.Bottom-round (wTime*(minTime-p^.FTimeC));
        Rectangle(val);
        p^.FTimeR := val;
        //-- второй столбец коэффициента --------------------------
        OffsetRect (val,wBar,0);
        Brush.Color := Lighter(p^.FColor,10);
        val.Top := val.Bottom-round (wDiff*(minDiff-p^.FDiffC));        
        Rectangle(val); 
        p^.FDiffR := val;        
        OffsetRect (val,wBar,0);               
      end; 

      for i := 0 to lst.Count-1 do begin
        p := lst[i];
        if (p = nil) or (p^.FCount = 0) then continue;
        Brush.Style := bsClear;
        Font.Color := Darker(p^.FColor,10);
        val := p^.FTimeR;
        str := 't='+FormatFLoat('#0.000#',p^.FTimeC);
        OffsetRect(val,-1,HeightRect(val)+2);
        if lst.GDIPlus then 
          DrawGDIPlusText (ACanvas, val, 0, ASize, str)
        else  
          TextOut (val.Left,val.Top,str);

        Font.Color := Darker(p^.FColor,30); 
        val := p^.FDiffR;
        str := 'f='+FormatFLoat('#0.000#',p^.FDiffC);        
        OffsetRect(val,1,-TextHeight(str)-2);
        if lst.GDIPlus then 
          DrawGDIPlusText (ACanvas, val, 0, ASize, str)
        else  
          TextOut (val.Left, val.Top,str);        

        val := p^.FDiffR;
        str := p^.FName;
        val.Top := val.Bottom+TextHeight(str)+2;
        val.Bottom := ARect.Bottom;

        if lst.GDIPlus then 
          DrawGDIPlusText (ACanvas, val, 30, ASize, str)
        else begin  
          fnt := CreateRotatedFont(Font, -30);
          tmp := SelectObject(DC,fnt);
          try
            TextOut (val.Left,val.Top, str);        
          finally
            SelectObject(DC, tmp);
            DeleteObject(fnt);
          end;  
        end;
      end;  
    end;  
  finally
    xFrm.eM11 := 1;
    xFrm.eM22 := 1;
    xFrm.eDx := 0;
    xFrm.eDy := 0;    
    SetWorldTransform(DC, xFrm);
    //-- возвращаем режим на место ---------------------------------------------
    SetGraphicsMode(DC, oldM);
  end;
end;

Скачать: Исходник Delphi XE 7(70 Кб)

Комментарии (6)

VaalKIA
30.03.2018 08:52
#10731756
Неуверен, но вроде бы, в шрифтах есть информация, какие пары букв следует расположить ближе, какие дальше, назвается это кернинг, соотвественно печать букв по отдельности и серией может отличаться визуально.
1. small-pro Автор
  30.03.2018 20:26
  #10733458
  Вы абсолютно правы, такая информация имеется. Но, если честно, не представляю, как его можно прикрутить к теме плавного масштаба текста.
1. sshmakov
  01.04.2018 08:55
  #10735248
  Кернинг не учитывается в посимвольном выводе, и это плохо. Но автор этот способ забраковал, стал пользоваться GDI+, а там с кернингом должно быть всё хорошо.

we1
30.03.2018 09:02
#10731768
Пока просматривал статью было ощущение «миллион лет до нашей эры». Я даже не про Delphi, а про выбор качественной отрисовки шрифта, которая, как мне показалось, всегда делается системой, только разные прокладки используются. Разве сейчас все, кто хотят использовать хорошую отрисовку шрифта не используют FreeType?
1. small-pro Автор
  30.03.2018 20:28
  #10733460
  Статья не про качество шрифта, а качество масштабирования. Я не знаю, как с помощью FreeType обеспечить плавное масштабирование текста. Т.е. как сделать так, чтоб отношение высоты текста к его ширине при масштабировании было константой? Если для этого нужно использовать какие-то дополнительные вычисления, то чем FreeType лучше? Если нельзя это сделать одной функцией, как в GDI+, то тем более – какое отношение к теме статьи имеет FreeType?
  На этом ресурсе принято обмениваться опытом, знаниями. Можно ли увидеть пример использования FreeType для плавного масштабирования текста?

sshmakov
01.04.2018 09:05
#10735272
Интересно, что, например, Microsoft Word не слишком старается правильно масштабировать текст на экране. При стандартном размере 100% ещё есть какая-то надежда, что то, что мы видим на экране будет выглядеть точно так же на печати. А если уменьшить или увеличить масштаб, то строчки съезжают примерно как в первых вариантах.