Как показать строку без этих уродливых квадратиков

Это перевод How to display a string without those ugly boxes. Автор: Реймонд Чен.

Вы все видели эти квадратики. Когда вы пытаетесь отобразить строку и используемый вами шрифт не поддерживает всех символов в ней, вы увидите прямоугольники вместо символов, которые недоступны в выбранном шрифте (прим. пер.: с некоторыми шрифтами вы видите символы "Ђ").

Создайте новое приложение, установите для формы шрифт "System" и добавьте такой код в обработчик события OnPaint:

procedure TForm6.FormPaint(Sender: TObject);
begin
  TextOutW(Canvas.Handle, 5, 5, 'ABC'#$0410#$0411#$0412#$0E01#$0E02#$0E03, 9);
end;

Эта строка содержит первые три буквы с трёх различных алфавитов: "ABC" из латинского алфавита, "АБВ" из кирилицы и "กขฃ" из тайского.

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

Прим. пер.: если в региональных стандартах у вас включены опции "Дополнительной языковой поддержки", то, скорее всего, у вас уже установлены unicode-шрифты и всё будет отображаться верно. Также в Windows 2000 и выше GDI пытается выполнять авто-подстановку для некоторых системных шрифтов типа Tahoma (конкретнее: для шрифтов типа OpenType).

Но как выбрать правильный шрифт? Что, если строка будет содержать корейские или японские символы? В системе может не быть шрифта, который поддерживает все возможные символы, определяемые Unicode (или, по крайней мере, не в базовой поставке системы). Что вы будете делать?

И тут на сцену выходит подстановка шрифтов (font linking).

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

Интерфейс IMLangFontLink2 предоставляет методы для такого разбиения. Метод GetStrCodePages берёт строку и делит её на части так, что символы в каждой части могут быть отображены с помощью одного шрифта, а MapFont создаёт шрифт.

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

function TForm1.TextOutFL(DC: HDC; X, Y: Integer; Str: PWideChar; Count: Integer): BOOL;
var
  pfl: IMLangFontLink2;
  dwActualCodePages: DWORD;
  cchActual: Integer;
  hfLinked, hfOrig: HFONT;
begin
  ...
  while Count > 0 do
  begin
    pfl.GetStrCodePages(Str, Count, 0, dwActualCodePages, cchActual);
    pfl.MapFont(DC, dwActualCodePages, 0, hfLinked);
    try
      hfOrig := SelectObject(DC, hfLinked);
      try
        TextOut(DC, ?, ?, Str, cchActual);
      finally
        SelectObject(DC, hfOrig);
      end;
    finally
      pfl.ReleaseFont(hfLinked);
    end;
    Inc(Str, cchActual);
    Dec(Count, cchActual);
  end;
  ...
end;

После определения кодовых страниц, поддерживаемых шрифтом по-умолчанию, мы проходим по строке, прося GetStrCodePages дать нам куски строки. По этому куску мы создаём соответствующий шрифт и рисуем символы с этим шрифтом в "нужном месте". Повторяем этот процесс, пока не закончатся символы в строке.

Остальное - это улучшения и аккуратная проработка деталей.

Для начала: что такое "нужное место"? Мы хотим, чтобы следующий кусок строки начал выводиться сразу же после предыдущего. Для этого мы можем воспользоваться преимуществами стиля выравнивания TA_UPDATECP, который указывает, что GDI следует выводить текст в текущей позиции и сдвигать текущую позицию на конец нарисованного текста (т.е. в позицию для вывода следующего блока текста).

Поэтому, нам нужно установить текущую позицию DC и переключить текстовый режим в TA_UPDATECP:

  SetTextAlign(DC, GetTextAlign(DC) or TA_UPDATECP);
  MoveToEx(DC, X, Y, nil);

Тогда мы можем просто передавать "0, 0" как координаты в TextOut, потому что координаты, передаваемые в TextOut игнорируются, если текстовый режим выравнивания включает в себя TA_UPDATECP; текст всегда рисуется в текущей позиции, игнорируя ваши координаты.

Конечно же, мы не можем вот так просто менять настройки DC. Если вызывающая сторона не включала режим TA_UPDATECP, то она будет очень сильно удивлена, когда этот режим будет включаться после вызова нашей функции (не говоря уже о смене текущей позиции). Поэтому, нам нужно сохранять оригинальную позицию и режим выравнивания текста и восстанавливать их после работы.

var
  ptOrig: TPoint;
  dwAlignOrig: DWORD;
  ...
  dwAlignOrig := GetTextAlign(DC);
  SetTextAlign(DC, dwAlignOrig or TA_UPDATECP);
  MoveToEx(DC, x, y, &ptOrig);
  while Count > 0 do
  begin
   ...
   TextOut(DC, 0, 0, Str, cchActual);
   ...
  end;
  // если вызывающий не хочет обновлять текущую позицию, то восстановим её,
  // и также восстановим режим выравнивания текста
  if (dwAlignOrig and TA_UPDATECP) = 0 then
  begin
    SetTextAlign(DC, dwAlignOrig);
    MoveToEx(DC, ptOrig.X, ptOrig.Y, nil);
  end;

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

var
  hfOrig: HFONT;
  dwFontCodePages: DWORD;
  ...
  hfOrig := GetCurrentObject(DC, OBJ_FONT);
  dwFontCodePages := 0;
  pfl.GetFontCodePages(DC, hfOrig, dwFontCodePages);
  ...
  while Count > 0 do
  begin
    pfl.GetStrCodePages(Str, Count, dwFontCodePages, dwActualCodePages, cchActual);
    if (dwActualCodePages and dwFontCodePages) <> 0 then
      // наш шрифт может обработать строку - рисуем сразу же
      TextOut(DC, 0, 0, Str, Count);
    else
    begin
      ... меняем шрифт и т.п. ...
    end;
  end;
  ...

Конечно же, вы, наверное, уже подумывали, откуда взялся этот волшебный pfl. Это Multilanguage Object в библиотеке mlang.dll (*).

var
  pfl: IMLangFontLink2;
  ...
  CoCreateInstance(CLSID_CMultiLanguage, nil, CLSCTX_ALL, IID_IMLangFontLink2, pfl);
  ...
  pfl := nil;

И, конечно же, все ошибки, что мы до сих пор игнорировали, должны быть обработаны соответствующим образом. Правда, это создаёт одну большую проблему: что если мы встретим ошибку после того, как мы уже отрисовали несколько кусков текста. Что тогда?

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

Сложите все эти фрагменты вместе и вы получите финальный вариант функции:

function TextOutFL(DC: HDC; X, Y: Integer; Str: PWideChar; Count: Integer): HRESULT;
var
  pfl: IMLangFontLink2;
  dwActualCodePages: DWord;
  dwFontCodePages: DWord;
  hfOrig, hfLinked: HFont;
  cchActual: Integer;
  ptOrig: TPoint;
  dwAlignOrig: DWord;
begin
  if Count <= 0 then   
  begin     
    Result := S_OK;     
    Exit;   
  end;   
  Result := CoCreateInstance(CLSID_CMultiLanguage, nil, CLSCTX_ALL, IID_IMLangFontLink2, pfl);   
  if SUCCEEDED(Result) then   
  begin     
    hfOrig := GetCurrentObject(DC, OBJ_FONT);     
    dwAlignOrig := GetTextAlign(DC);     
    if (dwAlignOrig and TA_UPDATECP) = 0 then       
      SetTextAlign(DC, dwAlignOrig or TA_UPDATECP);     
    MoveToEx(DC, X, Y, @ptOrig);     
    dwFontCodePages := 0;     
    Result := pfl.GetFontCodePages(DC, hfOrig, dwFontCodePages);     
    if SUCCEEDED(Result) then     
    begin       
      while Count > 0 do
      begin
        Result := pfl.GetStrCodePages(Str, Count, dwFontCodePages, dwActualCodePages, cchActual);
        if FAILED(Result) then
          Break;
        if (dwActualCodePages and dwFontCodePages) <> 0 then
          TextOutW(DC, 0, 0, Str, cchActual)
        else
        begin
          Result := pfl.MapFont(DC, dwActualCodePages, #0, hfLinked);
          if Failed(Result) then
            Break;
          SelectObject(DC, hfLinked);
          try
            TextOutW(DC, 0, 0, Str, cchActual);
          finally
            SelectObject(DC, hfOrig);
          end;
          pfl.ReleaseFont(hfLinked);
        end;
        Inc(Str, cchActual);
        Dec(Count, cchActual);
      end;
      if FAILED(Result) then
      begin
        // Мы уже что-то вывели, поэтому нам нужно завершить рисование до конца.
        // Остаток рисуем "как есть", без подстановок, т.к. у нас уже нет выбора.
        TextOutW(DC, 0, 0, Str, Count);
        Result := S_FALSE;
      end;
    end;

    pfl := nil;

    if (dwAlignOrig and TA_UPDATECP) = 0 then
    begin
      SetTextAlign(DC, dwAlignOrig);
      MoveToEx(DC, ptOrig.X, ptOrig.Y, nil);
    end;
  end;
end;

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

function TextOutTryFL(DC: HDC; X, Y: Integer; Str: PWideChar; Count: Integer): BOOL;
begin
  if Failed(TextOutFL(DC, X, Y, Str, Count)) then
    Result := TextOutW(DC, X, Y, Str, Count)
  else
    Result := True;
end;

Окей, теперь когда у нас есть эта улучшенная версия TextOut, мы можем переписать обработчик OnPaint, чтобы он использовал её.

procedure TForm1.FormPaint(Sender: TObject);
begin
  TextOutTryFL(Canvas.Handle, 5, 5, 'ABC'#$0410#$0411#$0412#$0E01#$0E02#$0E03, 9);
end;

Заметьте, что теперь строка отображается корректно (прим. пер.: при условии, что для каждого символа строки в системе есть хотя бы один шрифт с его поддержкой) (***).

Ещё одно улучшение, которое я не сделал - это избежание получения указателя IMlangFontLink2 каждый раз, когда мы хотим нарисовать текст. В настоящих программах вы, скорее всего, создадите интерфейс IMlangFontLink2 в FormCreate, а удалите в FormDestroy или даже сделаете его глобальным. Это повторное использование позволит вам избежать постоянных пересозданий объекта на каждую операцию вывода текста.

Примечания переводчика:
(*) Я нашёл вариант заголовочников для Delphi на RSDN, но он оказался немного кривоват, вот моя исправленная версия (я не правил всё - только используемые в примере выше объявления, поэтому в нём всё ещё могут быть ошибки).

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

(***) Вот пример работы функции. Я позволил себе добавить три японских иероглифа к тестовой строке. На рисунке вы видите вывод на системе, где нет ни одного шрифта с японскими иероглифами.

Одна и та же строка выводится различными шрифтами, первый раз (синий цвет) - с помощью TextOutTryFL, второй раз (красный) - с помощью обычной TextOut. Обратите внимание, как использование TextOutTryF позволяет убрать квадратики, если это возможно (в нашем случае - для тайских символов).

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

Второй блок выводится шрифтом Tahoma. Вы можете видеть, как GDI выполнил авто-подстановку шрифта даже при выводе простым TextOut.