如何调整ListBox项的高度以适合Firemonkey（android）中的文本？

Question

我正在使用此代码将项目添加到列表框中，但是我不知道如何动态调整项目的高度以适合文本：

procedure TmForm.AddItemBtnClick(Sender: TObject);
var
  Item: TListBoxItem;
begin
  Item := TListBoxItem.Create(nil);
  Item.Parent := SomeListBox;
  Item.StyleLookup := 'listboxitemstyle';
  Item.Text :=
              'Pe cararea lunga scurta se ducea un om venind, si-n tacerea lui ' +
              'profunda se auzea borborosind. Cantr-o noapte intunecoasa soarel' +
              'e lucea pe cer, iara eu cu barca in casa ma plimbam ca un boier.';
  Item.WordWrap := true;
  Item.StyledSettings := [TStyledSetting.ssFamily] + [TStyledSetting.ssStyle] + [TStyledSetting.ssFontColor];
  Item.Font.Size := 14;
end;

我尝试使用此示例中的代码（已针对TListBoxItem进行了修改），但没有用。

编辑： ListBoxItem的高度可以通过添加Item.Height := 100;来设置Item.Height := 100; 在上面的代码的末尾，但是我需要知道文本的高度来决定ListBoxItem的大小，因此，为了澄清我的问题，如何获取列表框项目中文本的高度？

Answer 1

在OnApplyStyleLookup事件中弹出调整大小的代码。

写在睡觉前我的头顶和路：

procedure TForm1.ListBoxItemApplyStyleLookup(Sender: TObject);
var O: TFMXObject;
begin
  O := (Sender as TListBoxItem).FindStyleResource('text');
  if O is TText then
    (Sender as TListBoxItem).Height := (O as TText).Height;
end;

当然，您将需要为创建的每个项目设置事件。

Answer 2

正如Mike Sutton所提到的，可以通过OnApplyStyleLookup事件来完成。 我使用TTextLayout做到这TTextLayout ：

uses 
... ,FMX.TextLayout;

procedure TfrmForm1.ListBoxItem1ApplyStyleLookup(Sender: TObject);
var
  myLayout: TTextLayout;
  aPoint: TPointF;
begin

  myLayout := TTextLayoutManager.DefaultTextLayout.Create;
  myLayout.BeginUpdate;

  // Setting the layout MaxSize
  aPoint.X := ListBoxItem1.Width;
  aPoint.Y := TfrmForm1.Height;
  myLayout.MaxSize := aPoint;

  myLayout.Text := ListBoxItem1.Text;
  myLayout.WordWrap := True ;
  myLayout.Font := ListBoxItem1.Font;
  myLayout.HorizontalAlign := ListBoxItem1.TextSettings.HorzAlign;
  myLayout.VerticalAlign := ListBoxItem1.TextSettings.VertAlign;
  myLayout.Padding := ListBoxItem1.Padding;
  // set other properties as needed        

  myLayout.EndUpdate;

  ListBoxItem1.Height := Trunc(myLayout.TextHeight) + 3 ; // +3px to be sure to see entire text

end;

请注意， MaxSize是有限制的。 例如， aPoint.Y将限制最终的TextHeight 。 您应该将其设置为大，因为无论TextHeight是什么，如果myLayout.TextHeight大于myLayout.MaxSize.Y那么myLayout.TextHeight将被设置为myLayout.MaxSize.Y 。

这是TTextLayout属性的列表 。

Answer 3

这是Mike Sutton的代码，由我改进和测试。 适用于带有明细文本（.ItemData.Detail）的项目的情况。 TextLayout的变体不适用于我。

此代码已针对Windows和Android应用程序进行了测试。

procedure TTestForm.ListBoxItem1ApplyStyleLookup(Sender: TObject);
var item: TListBoxItem absolute Sender;

  function CalcHeight( SubStyle: String ): Single;
  var Obj: TFMXObject; T: TText absolute Obj;
  begin
    Obj := item.FindStyleResource(SubStyle);
    if Obj is TText
    then Result := T.Canvas.TextHeight(T.Text)
                 + T.Margins.Top + T.Margins.Bottom
                 + T.Padding.Top + T.Padding.Bottom
    else Result := 0;
  end;

begin
  item.Height := CalcHeight('text')
               + CalcHeight('detail');
end;

Answer 4

更改控件的大小有一件重要的事情： “对于移动平台，firemonkey固定高度并带有某些控件” 。 因为：

1. 每个平台的UI样式指南定义有关标准控件大小的规则。
2. Firemonkey使用栅格样式，因此您无法更改某些控件的大小，因为您将失去视图的质量

但是，您可以删除此约束。 看看我的解决方案（自动翻译为Google）： 无法增加高度TProgressBar

有关TProgressBar的本文，但您也可以对TListBoxItem使用此方法。