Возвращаясь к вопросу о подсчете высоты текста TListView

[HyperZen]

Добрый вечер! Все-таки, как корректно подсчитывать высоту итемов данного компонента, если учитывать, что текст может быть достаточно большим.

Использую код с данного сайта, все работает корректно, пока не встречается текст, чуть больше одного абзаца:

function TextHeight(const AText: string; aTextSettings: TTextSettings; const MaxWidth: Single): Single;
// uses FMX.Graphics, FMX.TextLayout, FMX.Types, Math
var
  Layout: TTextLayout;
  aRect: TRectF;
  aWW: Boolean;
begin
  Result := 24;
  if AText.IsEmpty then
    Exit;

  aWW := Pos(#13#10, AText) > 0;
  if (aTextSettings.WordWrap) or (aWW) then
    aRect := RectF(0, 0, MaxWidth, MaxSingle)
  else
    aRect := RectF(0, 0, MaxSingle, MaxSingle);
  Layout := TTextLayoutManager.DefaultTextLayout.Create;
  try
    Layout.BeginUpdate;
    Layout.TopLeft := aRect.TopLeft;
    Layout.MaxSize := PointF(aRect.Width, aRect.Height);
    Layout.Text := AText;
    Layout.WordWrap := aTextSettings.WordWrap;
    Layout.HorizontalAlign := TTextAlign.Leading;
    Layout.VerticalAlign := TTextAlign.Leading;
    Layout.Font.Assign(aTextSettings.Font);
    Layout.Color := aTextSettings.FontColor;
    Layout.RightToLeft := false;
    Layout.EndUpdate;
    aRect := Layout.TextRect;
  finally
    FreeAndNil(Layout);
  end;
  Result := aRect.Bottom;
end;

И вызов в onUpdateObject:

procedure TForm12.ListView1UpdateObjects(const Sender: TObject; const AItem: TListViewItem);
var
  TS: TTextSettings;
begin
  TS := TTextSettings.Create(nil);
  // задаем параметры текста для расчета "Text"
  TS.WordWrap:= True;
  TS.Font.Assign(ListView1.ItemAppearanceObjects.ItemObjects.Text.Font);
  AItem.Height := Trunc(TextHeight(AItem.Text, TS, ListView1.Width));
  FreeAndNil(TS);
end;

Получаем:

Изменено 6 июня, 2016 пользователем HyperZen

[AngryOwl]

Добрый вечер!

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

TextHeight(AItem.Text, TS, ListView1.Width)

В качестве "ширины" по умолчанию Вы передаете значение ширины всего объекта TListView. При том как Ваш объект TListView имеет еще видимый TScrollBar (полосу прокрутки), ширину которой Вы не учитываете и не вычитаете из общей ширины TListView соответственно.

Изменено 6 июня, 2016 пользователем AlexG

[AngryOwl]

Что же касается самой функции, кажется можно чуть проще (где-то на форуме уже вроде был такой код) и он прекрасно работает:

function GetTextHeight(AText: string; AMaxWidth: Single; AFont: TFont; ATextAlign: TTextAlign): Single;
var
  txt: TText;
begin
  txt := TText.Create(nil);
  try
    txt.Align := TAlignLayout.None;
    txt.VertTextAlign := ATextAlign;
    txt.HorzTextAlign := TTextAlign.Leading;
    txt.Font := AFont;
    txt.WordWrap := True;
    txt.Width := AMaxWidth;
    txt.BeginUpdate;
    txt.Text := AText;
    txt.EndUpdate;
    txt.AutoSize := True;
    Result := txt.Height;
  finally
    FreeAndNil(txt);
  end;
end;

 

[Равиль Зарипов (ZuBy)]

5 часов назад, AlexG сказал:

Добрый вечер!

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

TextHeight(AItem.Text, TS, ListView1.Width)

В качестве "ширины" по умолчанию Вы передаете значение ширины всего объекта TListView. При том как Ваш объект TListView имеет еще видимый TScrollBar (полосу прокрутки), ширину которой Вы не учитываете и не вычитаете из общей ширины TListView соответственно.

Да все верно, нужно отнять ширину скрола если он показан.

Для IOS/MacOS/Android ширина составляет 7 пикселей, для Windows - 16. узнать показан ли сейчас скрол думаю не сложно определить, высота контента > высоты компонента

[HyperZen]

9 часов назад, AlexG сказал:

Что же касается самой функции, кажется можно чуть проще (где-то на форуме уже вроде был такой код) и он прекрасно работает:

function GetTextHeight(AText: string; AMaxWidth: Single; AFont: TFont; ATextAlign: TTextAlign): Single;
var
  txt: TText;
begin
  txt := TText.Create(nil);
  try
    txt.Align := TAlignLayout.None;
    txt.VertTextAlign := ATextAlign;
    txt.HorzTextAlign := TTextAlign.Leading;
    txt.Font := AFont;
    txt.WordWrap := True;
    txt.Width := AMaxWidth;
    txt.BeginUpdate;
    txt.Text := AText;
    txt.EndUpdate;
    txt.AutoSize := True;
    Result := txt.Height;
  finally
    FreeAndNil(txt);
  end;
end;

 

А в данном случае что необходимо передавать в качестве AMaxWidth? При передаче width текущего ListView картина наблюдается та же, что и на скриншоте выше. При вычитании из размера ListView 7 или 16 пикселей, как писал ZuBy, все равно картина остается той же...

procedure TForm12.ListView1UpdateObjects(const Sender: TObject; const AItem: TListViewItem);
var
  h: Single;
begin
  h := GetTextHeight(AItem.Text, ListView1.Width - 16, ListView1.ItemAppearanceObjects.ItemObjects.Text.Font, TTextAlign.Leading);
  AItem.Height := Trunc(h);
end;

 

[HyperZen]

4 часа назад, ZuBy сказал:

высота контента > высоты компонента

В этом месте можно чуть-чуть подробнее? На сколько контент больше по размеру относительно компонента?

Добавив в расчеты 30 пикселей к текущему результату, получил то, что хотел. Но эти 30 пикселей были найдены путем подбора, хотелось бы как то математически обосновать эти цифры:

  h := GetTextHeight(AItem.Text, ListView1.Width-16, ListView1.ItemAppearanceObjects.ItemObjects.Text.Font, TTextAlign.Leading);
  AItem.Height := Trunc(h) + 30;

И какой максимальный текст можно вместить в итем ListView?

Изменено 7 июня, 2016 пользователем HyperZen

[Равиль Зарипов (ZuBy)]

3 минуты назад, HyperZen сказал:

В этом месте можно чуть-чуть подробнее? На сколько контент больше по размеру относительно компонента?

<TListView>.Items.Count * на_высоту_одного_айтема = высота контента

<TListView>.Height = высота компонента

[HyperZen]

1 час назад, ZuBy сказал:

<TListView>.Items.Count * на_высоту_одного_айтема = высота контента

<TListView>.Height = высота компонента

Спасибо. Но высота каждого Item'а разная, я думал высоту контента конкретного Item'а необходимо учитывать при подсчете.

[Равиль Зарипов (ZuBy)]

Только что, HyperZen сказал:

Спасибо. Но высота каждого Item'а разная, я думал высоту контента конкретного Item'а необходимо учитывать при подсчете.

ну так циклом по списку и плюсуйте)

[HyperZen]

1 час назад, ZuBy сказал:

ну так циклом по списку и плюсуйте)

Это понятно  Мне как бы размер всего компонента и не нужен. Мне бы правильно размер Итема научиться выставлять

Иногда половина текста обрезается, не понятно от чего зависит. Иногда большой текст помещается полностью в итеме, иногда отсекается и появляется это многозначное многоточие...

Изменено 7 июня, 2016 пользователем HyperZen

[HyperZen]

Многоуважаемый ZuBy, вот, к примеру текст:

    with ListView1.Items.Add do
    begin
      Text :=
            'FMX.Dialogs.MessageDlg - RAD Studio API Documentation ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            '11 февр. 2016 г. - function MessageDlg(const AMessage: string; const ADialogType: TMsgDlgType; const ... extern DELPHI_PACKAGE int __fastcall MessageDlg _DEPRECATED_ATTRIBUTE1("Use FMX.DialogService methods") ' +            'Перевести эту страницу ' +
            '11 февр. 2016 г. - function MessageDlg(const AMessage: string; const ADialogType: TMsgDlgType; const ... extern DELPHI_PACKAGE int __fastcall MessageDlg _DEPRECATED_ATTRIBUTE1("Use FMX.DialogService methods") ' +            'Перевести эту страницу ' +
            '11 февр. 2016 г. - function MessageDlg(const AMessage: string; const ADialogType: TMsgDlgType; const ... extern DELPHI_PACKAGE int __fastcall MessageDlg _DEPRECATED_ATTRIBUTE1("Use FMX.DialogService methods") ' +            'Перевести эту страницу ' +
            '11 февр. 2016 г. - function MessageDlg(const AMessage: string; const ADialogType: TMsgDlgType; const ... extern DELPHI_PACKAGE int __fastcall MessageDlg _DEPRECATED_ATTRIBUTE1("Use FMX.DialogService methods") ' +
            '(const System::UnicodeString AMessage, const ... Warning: MessageDlg is deprecated. ***';

поместите его целиком в итем компонента  

[Евгений Корепов]

Возможно вы не учитывате  свойство Trimming, а судя по скринам оно у вас включено.

Я пользуюсь вот таким кодом, работает идеально на всех платформах.

procedure TFormMain.CalculateTListViewItemHeight(Sender: TObject);
var AListItem: TListViewItem;
    AListView: TListView;
begin
  if (Sender is TListViewItem) then
  begin
    AListItem := Sender as TListViewItem;
    if (AListItem.Parent is TListView) then
      AListView:=AListItem.Parent as TListView
    Else
      Exit;
    FTextLayout.BeginUpdate;
    try
      FTextLayout.Text:=AListItem.Text;
      FTextLayout.MaxSize:=TPointF.Create(AListView.Width -
        AListView.ItemSpaces.Left - AListView.ItemSpaces.Right, 1000);
      FTextLayout.Font:=AListView.ItemAppearanceObjects.ItemObjects.Text.Font;
      FTextLayout.WordWrap:=AListView.ItemAppearanceObjects.ItemObjects.Text.WordWrap;
      FTextLayout.Trimming:=AListView.ItemAppearanceObjects.ItemObjects.Text.Trimming;
      FTextLayout.HorizontalAlign:=AListView.ItemAppearanceObjects.ItemObjects.Text.TextAlign;
      FTextLayout.VerticalAlign:=AListView.ItemAppearanceObjects.ItemObjects.Text.TextVertAlign;
    finally
      FTextLayout.EndUpdate;
    end;
    AListItem.Height:=Round(FTextLayout.Height + AListView.ItemSpaces.Top + AListView.ItemSpaces.Bottom);
  end;
end;

При создании формы не забудьте FTextLayout := TTextLayoutManager.DefaultTextLayout.Create;

Применять вот так:

procedure TFormMain.ListViewNewsUpdateObjects(const Sender: TObject;
  const AItem: TListViewItem);
begin
  CalculateTListViewItemHeight(AItem);
end;

 

[Равиль Зарипов (ZuBy)]

20 минут назад, HyperZen сказал:

поместите его целиком в итем компонента  

да поместить то не проблема, проблема избавиться от пустого места

LVItemHeight.rar

[Евгений Корепов]

Делать было нечего, дело было вечером... Вот попробовал, свою процедуру чуть изменил, добавил константы ширины скроллбара из ListView

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.ListView.Types, FMX.ListView, FMX.TextLayout, System.StrUtils;

const
{$IFDEF IOS}
  DefaultScrollBarWidth = 7;
{$ELSE}
{$IFDEF MACOS}
  DefaultScrollBarWidth = 7;
{$ENDIF}
{$ENDIF}
{$IFDEF MSWINDOWS}
  DefaultScrollBarWidth = 16;
{$ENDIF}
{$IFDEF ANDROID}
  DefaultScrollBarWidth = 7;
{$ENDIF}

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure ListView1UpdateObjects(const Sender: TObject;
      const AItem: TListViewItem);
  private
    { Private declarations }
  public
    { Public declarations }
    FTextLayout : TTextLayout;
    procedure CalculateTListViewItemHeight(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
Var AText : String;
begin
  FTextLayout := TTextLayoutManager.DefaultTextLayout.Create;
  AText:=
            'FMX.Dialogs.MessageDlg - RAD Studio API Documentation ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            'docwiki.embarcadero.com/.../en/FMX.Dialogs.MessageDlg ' +
            'Перевести эту страницу ' +
            '11 февр. 2016 г. - function MessageDlg(const AMessage: string; const ADialogType: TMsgDlgType; const ... extern DELPHI_PACKAGE int __fastcall MessageDlg _DEPRECATED_ATTRIBUTE1("Use FMX.DialogService methods") ' +            'Перевести эту страницу ' +
            '11 февр. 2016 г. - function MessageDlg(const AMessage: string; const ADialogType: TMsgDlgType; const ... extern DELPHI_PACKAGE int __fastcall MessageDlg _DEPRECATED_ATTRIBUTE1("Use FMX.DialogService methods") ' +            'Перевести эту страницу ' +
            '11 февр. 2016 г. - function MessageDlg(const AMessage: string; const ADialogType: TMsgDlgType; const ... extern DELPHI_PACKAGE int __fastcall MessageDlg _DEPRECATED_ATTRIBUTE1("Use FMX.DialogService methods") ' +            'Перевести эту страницу ' +
            '11 февр. 2016 г. - function MessageDlg(const AMessage: string; const ADialogType: TMsgDlgType; const ... extern DELPHI_PACKAGE int __fastcall MessageDlg _DEPRECATED_ATTRIBUTE1("Use FMX.DialogService methods") ' +
            '(const System::UnicodeString AMessage, const ... Warning: MessageDlg is deprecated. ***';

  with ListView1.Items.Add do
    Text:=AText;
  with ListView1.Items.Add do
    Text:= ReverseString(AText);
  with ListView1.Items.Add do
    Text:= AText;
end;

procedure TForm1.ListView1UpdateObjects(const Sender: TObject;
  const AItem: TListViewItem);
begin
  CalculateTListViewItemHeight(AItem);
end;

procedure TForm1.CalculateTListViewItemHeight(Sender: TObject);
var AListItem: TListViewItem;
    AListView: TListView;
begin
  if (Sender is TListViewItem) then
  begin
    AListItem := Sender as TListViewItem;
    if (AListItem.Parent is TListView) then
      AListView:=AListItem.Parent as TListView
    Else
      Exit;
    FTextLayout.BeginUpdate;
    try
      FTextLayout.Text:=AListItem.Text;
      FTextLayout.MaxSize:=TPointF.Create(AListView.Width -
        AListView.ItemSpaces.Left - AListView.ItemSpaces.Right - DefaultScrollBarWidth, 1000);
      FTextLayout.Font:=AListView.ItemAppearanceObjects.ItemObjects.Text.Font;
      FTextLayout.WordWrap:=AListView.ItemAppearanceObjects.ItemObjects.Text.WordWrap;
      FTextLayout.Trimming:=AListView.ItemAppearanceObjects.ItemObjects.Text.Trimming;
      FTextLayout.HorizontalAlign:=AListView.ItemAppearanceObjects.ItemObjects.Text.TextAlign;
      FTextLayout.VerticalAlign:=AListView.ItemAppearanceObjects.ItemObjects.Text.TextVertAlign;
    finally
      FTextLayout.EndUpdate;
    end;
    AListItem.Height:=Round(FTextLayout.Height + AListView.ItemSpaces.Top + AListView.ItemSpaces.Bottom);
  end;
end;

end.

 

[HyperZen]

1 час назад, Евгений Корепов сказал:

 

Делать было нечего, дело было вечером... Вот попробовал, свою процедуру чуть изменил, добавил константы ширины скроллбара из ListView

 

Можно проект целиком? Berlin ругается на свойство Parent... хм...

[Евгений Корепов]

1 час назад, HyperZen сказал:

Можно проект целиком? Berlin ругается на свойство Parent... хм...

Так весь проект целиков и выложил. В форме только апперанс у ListView выставил в Custom. А куда дели Parent? Это важное свойство хранящее родителя. Может как то переименовали?

 

P.S. Вы можете AListView заменить за свой конкретный ListView, доступ через парент сделал для красоты и универсальности, если несколько ListView в проекте...

Изменено 7 июня, 2016 пользователем Евгений Корепов

[HyperZen]

1 час назад, Евгений Корепов сказал:

P.S. Вы можете AListView заменить за свой конкретный ListView, доступ через парент сделал для красоты и универсальности, если несколько ListView в проекте...

Так работает корректно... Но в проекте, действительно, несколько ListView, хочется решить все-таки универсальным путем. Ищу информацию про Parent

[HyperZen]

Немецкие друзья тоже задаются этим вопросом:

http://www.delphipraxis.net/188970-berlin-tlistviewitem-parent.html

[AngryOwl]

Не помню как там TListView, но наверняка есть что-то типа TListView(_ваш_список_).VScrollBar.Width

Точно не буду утверждать, что так. Но получить текущую ширину скрола, думаю, можно. И обойтись без констант.

З.Ы. Кстати, они все-равно прописаны в константах, где-то в глобальных модулях...

[HyperZen]

Проблема решена! Всем спасибо!

type
  TAppearanceObjectsHelper = class helper for TAppearanceObjects
    function GetParentControl: TControl;
    property ParentControl: TControl read GetParentControl;
  end;

function TAppearanceObjectsHelper.GetParentControl: TControl;
begin
  Result := OwnerControl;
end;

Function GetParent(const AListItem: TListViewItem): TListView;
begin
  result := AListItem.Objects.Appearance.ParentControl as TListView;
end;

И, соответственно, код уважаемого Евгения Корепова претерпевает незначительные изменения:

  if (Sender is TListViewItem) then
  begin
    AListItem := Sender as TListViewItem;
    if (GetParent(AListItem) is TListView) then
      AListView:=GetParent(AListItem) as TListView
    Else
      Exit;
....

 

[HyperZen]

Рановато праздновать  Все-таки в Андроиде некорректный подсчет:

[Равиль Зарипов (ZuBy)]

54 минуты назад, HyperZen сказал:

Рановато праздновать  Все-таки в Андроиде некорректный подсчет:

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

[Евгений Корепов]

Подтверждаю что на андроиде этот код косячит, выдает высоту процентов на 10-15 меньше нужной. Осталось разобраться почему в других моих проектах все работает нормально. Может действительно из за большого текста с сплошными строками накапливается ошибка?

P.S. Заменил текст на кусок из книги, та же самая фигня, обрезает снизу.

Изменено 7 июня, 2016 пользователем Евгений Корепов

[Brovin Yaroslav]

Вот пример вычисления высоты итема. ListViewVariableHeightItems2.zip

Я этот пример показывал на лонче в питере.

[Евгений Корепов]

13 минуты назад, Brovin Yaroslav сказал:

Вот пример вычисления высоты итема. ListViewVariableHeightItems2.zip

Я этот пример показывал на лонче в питере.

У меня не заработал на XE8 к сожалению код. Но принцип тот же самый, разве что не совсем понятно что за "m"

    // Get layout height
    Result := Round(Layout.Height);
    // Add one em to the height
    Layout.Text := 'm';
    Result := Result + Round(Layout.Height);

 

Заметил странность, если установить размер шрифта отличный от стандартного, к примеру 11,99 или 12,01, то все начинает нормально работать, текст влазит. Но размер шрифта на экране в полтора раза меньше "стандартного". Не знаю какой стандартный, но точно не 12, больше похож на 14 или 15. Может из за этого и косяк? В недрах FMX расчет ведется с "стандартным" шрифтом 12, а на экране отрисовывается гораздо более крупным.

[HyperZen]

1 час назад, Евгений Корепов сказал:

Заметил странность, если установить размер шрифта отличный от стандартного, к примеру 11,99 или 12,01, то все начинает нормально работать, текст влазит. Но размер шрифта на экране в полтора раза меньше "стандартного". Не знаю какой стандартный, но точно не 12, больше похож на 14 или 15. Может из за этого и косяк? В недрах FMX расчет ведется с "стандартным" шрифтом 12, а на экране отрисовывается гораздо более крупным.

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