Ширина текста у произвольной канвы

[AnTe]

Подскажите, пожалуйста, может ли отличаться ширина выводимого текста (трутайп), при выводе её на разные канвы (разные устройства)?
как там в теории?

Моя программа строит таблицу и рисует в ячейках текст. Причём пользователь редактирует часть таблицы (добавляемый элемент), на одной форме, а результат будет выводиться в совершенно другое место (конкретно - компонент TPrintPreview, от Delphi AREA).

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

Более того - я попытался написать "универсальную" функцию для вычисления ширины текста.

function TcText.GetTextWidth(const Text: string): integer;
var bm: TBitmap;
begin
  bm := TBitmap.Create;

  State.Apply(bm.Canvas); // здесь я присваиваю шрифту следующие параметры, следующим образом (в Canvas передаётся bm.Canvas):
  {GetObject(Canvas.Font.Handle, SizeOf(TLogFont), @LogFont);
  LogFont.lfHeight := Height;
  LogFont.lfWidth := Width;
  LogFont.lfEscapement := Escapement;
  if Italic then LogFont.lfItalic := 1 else LogFont.lfItalic := 0;
  if Underline then LogFont.lfUnderline := 1 else LogFont.lfUnderline := 0;
  if StrikeOut then LogFont.lfStrikeOut := 1 else LogFont.lfStrikeOut := 0;
  StrCopy(LogFont.lfFaceName, PChar(Name)); }
  Canvas.Font.Handle := CreateFontIndirect(LogFont);

  Result := bm.Canvas.TextWidth(Text);
  bm.Free;
end;

Так вот, когда я устанавливаю эти же параметры перед отрисовкой на канве компонента TPrintView - расчётная ширина отличается, на несколько процентов: при расчёте - 6573 (у меня в хайметриках) при выводе 6162. Есть ли гарантия, что расчёты не "поплывут" ещё больше? т.е. на одной канве выводимый текст влезет в ячейку, а в другом - нет?

[mutabor]

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

По поводу ячейки, в вин апи есть функция к-рая красиво заканчивает строку точками если та не влазит в область. Также можно сделать показ хинта с полным текстом при наведении на ячейку, в нек-рых контролах (TListView например) это уже реализовано.

[AnTe]

Сообщение от mutabor

Не стал читать до конца.

Да, пожалуй, я загнул, уже вечером пока шёл домой, понял, что задвинул какую-то нудятину

Сделаю покороче, без воды:

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

procedure TfmTest.DrawOnAnyCanvas(Canvas: TCanvas);
begin
  Canvas.Rectangle(0, 0, 50, 20);
  Canvas.TextOut(5,5,'TestText');
end;

Для предпросмотра пользователем я вывожу фигуру на Image, лежащий на форме предпросмотра. Текст прекрасно умещается в прямоугольнике, пользователь доволен.

Есть ли у меня гарантии, что при подстановке в процедуру канвы другого объекта (принтер, например) - текст будет находиться в прямоугольнике?


ps Предполагаю, что у у каждой канвы свои настройки "по умолчанию", поэтому видоизменяю процедуру, устанавливая, по-моему, главные параметры:

procedure TfmTest.DrawOnAnyCanvas(Canvas: TCanvas);
var  LogFont: TLogFont;
begin
  Canvas.Pen.Width := 2;

  GetObject(Canvas.Font.Handle, SizeOf(TLogFont), @LogFont);
  LogFont.lfHeight := 10;
  LogFont.lfWidth := 5;
  LogFont.lfEscapement := 0;
  LogFont.lfItalic := 0;
  LogFont.lfUnderline := 0;
  LogFont.lfStrikeOut := 0;
  StrCopy(LogFont.lfFaceName, PChar('Arial'));
  Canvas.Font.Handle := CreateFontIndirect(LogFont);

  Canvas.Rectangle(0, 0, 50, 20);
  Canvas.TextOut(5,5,'TestText');
end;

[AnTe]

Сообщение от mutabor

у битмапа в Дельфи есть методы по определению размеров области занимаемой текстом.

наверное, не у битмапа, а у его канвы, что я и использовал в самом первом примере (Result := bm.Canvas.TextWidth(Text)), и именно эта процедура вдруг дала отличный результат, от попытки использовать Canvas.TextWidth(Text), с канвы объекта "отображателя" непосредственно перед выводом текста

Сообщение от mutabor

По поводу ячейки, в вин апи есть функция к-рая красиво заканчивает строку точками если та не влазит в область. Также можно сделать показ хинта с полным текстом при наведении на ячейку, в нек-рых контролах (TListView например) это уже реализовано.

к сожалению, эти варианты мне не подходят. Результат на выходе программы - бумажный документ, который выводится на печать, выполненный строго по ГОСТам. "невлезание" текста в ячейку, и тем более, замена части его точками, запрещена

[AnTe]

Плюнул, короче на это дело.

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

Вывод в разные канвы покамест даёт с виду одинаковые результаты.

[mutabor]

Немного не так я делал, хотя задача у меня была другая - динамичный лейбел. В этой функции как раз определение габаритов текста.

procedure TLabelEx.RunText;
var
  s: string;
  size: TSize;
begin
  FPos:=0;
  FShift:=1;
  s:=Caption;
  FBuf.Canvas.Font:=Font;
  size:=FBuf.Canvas.TextExtent(s);
  FBuf.Width:=size.cx;
  FBuf.Height:=size.cy;
  FBuf.Canvas.Brush.Color:=Color;
  FBuf.Canvas.TextOut(0,0,s);
  Height:=FBuf.Height;
  FTimer.Enabled:=Width < FBuf.Width;
end;

умножаю ширину шрифта, на количество букв

Это годится только для моноширинных шрифтов. Если вам так подходит вы можете решить проблему используя один из моноширинных шрифтов.

[AnTe]

Ну да, когда канва есть - можно и TextExtent использовать. Кстати, вроде его borland и вызывает, для расчёта Canvas.TextWidth

Сообщение от mutabor

Это годится только для моноширинных шрифтов. Если вам так подходит вы можете решить проблему используя один из моноширинных шрифтов.

Ну, это мне известно. Именно поэтому и заморачиваюсь с канвой: шрифт TrueType.

При сильных сплющиваниях погрешность "метода" возросла, в разы. Вернулся к старой схеме: создаю временный битмап, его канву использую, для вызова Canvas.TextWidth.

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

procedure Test_ShowTextWidthOnAnyCanvas(Canvas: TCanvas);
var LogFont: TLogFont;
  sText: string;
begin
  Canvas.Pen.Width := 2;
  GetObject(Canvas.Font.Handle, SizeOf(TLogFont), @LogFont);
  LogFont.lfHeight := 1000;
  LogFont.lfWidth := 500;
  LogFont.lfEscapement := 0;
  LogFont.lfItalic := 0;
  LogFont.lfUnderline := 0;
  LogFont.lfStrikeOut := 0;
  StrCopy(LogFont.lfFaceName, PChar('Arial'));
  Canvas.Font.Handle := CreateFontIndirect(LogFont);

  sText := 'TestTextTestText';

  ShowMessage(IntToStr(Canvas.TextWidth(sText)));
end;

Теперь - главное. Вот процедура, в которой два раза вызывается этот расчёт ширины текста:

procedure TMainForm.Test_WidthShow(Canvas: TCanvas);
var
  AMetafile : TMetafile;
  ACanvas : TMetafileCanvas;
begin
  AMetafile := TMetafile.Create;
  AMetafile.Width := 794;
  AMetafile.Height := 1123;
  ACanvas := TMetafileCanvas.Create(AMetafile, 0);

  Test_ShowTextWidthOnAnyCanvas(ACanvas); // первый раз, результат 8812

  SetMapMode(ACanvas.Handle, MM_ANISOTROPIC);
  SetWindowExtEx(ACanvas.Handle, 4313689, 10832644, nil);
  SetViewPortExtEx(ACanvas.Handle, 4314678, 4314697, nil);

  Test_ShowTextWidthOnAnyCanvas(ACanvas); // второй раз, результат 8798

end;

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

[mutabor]

Не берусь судить, вижу что вы мокнулись в это куда глубже чем я.

Однако вижу в коде TMetafileCanvas а не TCanvas. Возможно поэтому и разные результаты. Если использовать объект одного и того же типа, то по идее не должны отличаться результаты.

А если здесь параметр такого же типа применить?
procedure Test_ShowTextWidthOnAnyCanvas(Canvas: TMetafileCanvas);

Наверное, это всё-таки просто погрешность.

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

  Test_ShowTextWidthOnAnyCanvas(ACanvas); // первый раз, результат 8812

  SetMapMode(ACanvas.Handle, MM_ANISOTROPIC);
  SetWindowExtEx(ACanvas.Handle, 4313689, 10832644, nil);
  SetViewPortExtEx(ACanvas.Handle, 4314678, 4314697, nil);

  Test_ShowTextWidthOnAnyCanvas(ACanvas); // второй раз, результат 8798

Явно видно, что погрешность - результат вызова этих трех функций. Поместите второй вызов Test_ShowTextWidthOnAnyCanvas не в конец, а: 1) сразу после первого вызова, 2) после SetMapMode, и так далее. После этого на основе полученных результатов можно будет дальше анализировать ситуацию.

[AnTe]

Сообщение от mutabor

А если здесь параметр такого же типа применить?
procedure Test_ShowTextWidthOnAnyCanvas(Canvas: TMetafileCanvas);

Заменил, в объявлении, на всякий случай, результат не изменился

Сообщение от mutabor

Явно видно, что погрешность - результат вызова этих трех функций. Поместите второй вызов Test_ShowTextWidthOnAnyCanvas не в конец, а: 1) сразу после первого вызова, 2) после SetMapMode, и так далее. После этого на основе полученных результатов можно будет дальше анализировать ситуацию.

Тут телепатия сработала на все сто я эти варианты уже пробовал - в этих случаях значения равны.

Только после отработки всех трёх процедур начинаются чудеса.

[AnTe]

После длительных экспериментов, выяснилось, что значение меняется, если в SetViewPortExtEx передаются меньшие координаты, например:

SetMapMode(ACanvas.Handle, MM_ANISOTROPIC);
SetWindowExtEx(ACanvas.Handle, 10, 10, nil);
SetViewPortExtEx(ACanvas.Handle, 1, 1, nil);

В общем, перед ними ширина текста 8812
после них 8760

уменьшилась на 52 единицы