Как лучше всего программно сказать, обрезается ли заголовок TLabel (т. Е. Нарисован с помощью многоточия)?

Question

У меня есть TLabel с EllipsisPosition установлен в epEndEllipsis и я должен быть в состоянии сказать, обрезан ли текст в настоящее время или нет. Помимо расчета площади, необходимой для отображения текста, и сравнения ее с фактическими размерами этикетки, кто-нибудь придумал более простой / более элегантный способ сделать это?

На самом деле, вычисление требуемой области безаварийным способом также не кажется таким простым, как кажется... Например TCanvas.GetTextHeight не учитывает разрывы строк.

TCustomLabel.DoDrawText внутренне использует либо DrawTextW или же DrawThemeTextEx с DT_CALCRECT флаг, чтобы определить, следует ли использовать многоточие или нет. Там задействовано довольно много кода, весь из которых объявлен private , Простое дублирование всего этого кода в моей книге не может считаться "элегантным"...

Есть идеи?

(Я использую Delphi 2010 на случай, если кто-нибудь придумает решение для Delphi-версии)

Обновление 1: теперь я понял, что я могу просто позвонить TCustomLabel.DoDrawText(lRect, DT_CALCRECT) непосредственно (который просто объявлен protected) чтобы метка могла выполнить необходимый расчет размера без дублирования кода. Я просто должен убедиться, что либо временно установлен EllipsisPosition в epNone или вообще использовать временный экземпляр метки. Это на самом деле не так уж и плохо, и я мог бы просто пойти на это, если никто не может придумать еще более простое решение.

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

Answer 1

FWIW, вот что я придумал (это метод кастома TLabel-descendant):

function TMyLabel.IsTextClipped: Boolean;
const
  EllipsisStr = '...';
var
  lEllipBup: TEllipsisPosition;
  lRect: TRect;
begin
  lRect := ClientRect;
  Dec(lRect.Right, Canvas.TextWidth(EllipsisStr));

  lEllipBup := EllipsisPosition;
  EllipsisPosition := epNone;
  try
    DoDrawText(lRect, DT_CALCRECT or IfThen(WordWrap, DT_WORDBREAK));
  finally
    EllipsisPosition := lEllipBup;
  end;
  Result := ((lRect.Right - lRect.Left) > ClientWidth)
         or ((lRect.Bottom - lRect.Top) > ClientHeight);
end;

Поскольку это теперь использует точно такую ​​же логику, как TCustomLabel.DoDrawText (особенно искусственное заполнение и правильная настройка WordWrap), он также корректно работает с многострочными и переносимыми словами текстами. Обратите внимание, что "правильно" в данном случае означает "он всегда возвращает True когда TLabel нарисован с подрезанной надписью и False иначе".

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

Answer 2

В качестве отправной точки вы могли бы использовать

function DrawStringEllipsis(const DC: HDC; const ARect: TRect; const AStr: string): boolean;
var
  r: TRect;
  s: PChar;
begin
  r := ARect;
  GetMem(s, length(AStr)*sizeof(char) + 8);
  StrCopy(s, PChar(AStr));
  DrawText(DC, PChar(s), length(AStr), r, DT_LEFT or DT_END_ELLIPSIS or DT_MODIFYSTRING);
  result := not SameStr(AStr, s);
  FreeMem(s);
end;

Пример использования:

procedure TForm1.FormClick(Sender: TObject);
begin
  Caption := 'Clipped ' + BoolToStr(DrawStringEllipsis(Canvas.Handle, Rect(10, 100, 50, 50), 'This is a text.'), true);
end;

Было бы не сложно написать TExtLabel компонент, который имеет WasClipped собственность с использованием этой техники. Действительно, TLabel компонент является одним из самых простых компонентов в VCL - он просто рисует строку.