能否让TMemo自适应其所包含的文本大小？

Question

能否让TMemo自适应其所包含的文本大小？

delphitmemo

11

在表单设计器中编辑 TLabel 的标题时，它会自动调整 TLabel 的大小。有没有办法让 TMemo 在运行时也做到这一点？

我想能够取一个 TMemo，给其 .lines.text 属性赋值，然后告诉它调整自己的大小并且不超过一定的宽度，但它可以尽可能的高。有人知道如何实现吗？

- Mason Wheeler

5个回答

6

将 TMemo 的 WordWrap 属性设置为 true，将文本倾倒到其中，计算行数，并将高度设置为行数和行高的乘积，但您需要知道行高。 TMemo 没有公开的行高属性，但如果您在运行时不更改字体或字体大小，则可以在设计时通过实验确定行高。

以下是我用来设置具有 13 像素行高的 TMemo 高度的代码。我还发现我需要一个小常量来解释 TMemo 的顶部和底部边框。我将高度限制为 30 行（396 像素），以使其保持在表单上。

// Memo.WordWrap = True (at design time)
Memo.Text := <ANY AMOUNT OF TEXT>;
Memo.Height := Min(19 + Memo.Lines.Count * 13, 396);

如果您必须在运行时从对象中提取行高度，则可以使用某人的答案。或者，您可以使用TRichEdit，它具有包含行高度的Height属性的SelAttributes属性。

-Al.

- A. I. Breveleri

我应该想到这一点。我太习惯使用TStringLists，它们在CRLF处换行，以至于我从未想过WordWrap属性实际上会将换行的行放在不同的.Lines字符串中。谢谢！ - Mason Wheeler

Font.Height保存着一个负数，表示文本行中像素的数量。此外，您可以调用Canvas.TextExtent来计算文本高度。 - Stijn Sanders

3

我已经实现了一个自动增长的TMemo，作为LiveBindings的一个很好的示例（在VCL中我能想到的少数几个有用的示例之一）。

来自我的Delphi XE2开发必备课件手册的引用：

“要构建此示例，请在VCL表单上放置一个TMemo组件，打开LiveBindings属性，并选择“新的LiveBinding”选项。选择TBindExpression选项。在对象检查器中打开BindExpressionMemo11并将SourceComponent设置为Memo1，将SourceExpression设置为Lines.Count * 22。为了在运行时获得更好的结果，请将SourceExpression设置为以下更精确的表达式

Font.Size - 4 + (Lines.Count + 1) * -1 * (Font.Height - 3)

最后，在TMemo的OnChange事件处理程序中编写一行代码：

BindingsList1.Notify(Sender, '');

这就是全部内容。编译并运行，即可看到自动增长的备忘录。

[screenshot]

最初，TMemo控件将是两行高（包括内容和下一行），每当我们按回车键或自动换行使我们进入下一行时，TMemo控件将增加高度（实际上是向下增长，因此请确保在表单上留出足够的空间让TMemo扩展自身）。"

问候，Bob Swart

- Bob Swart

我对这个答案感到非常兴奋，但自XE10 Berlin以来，它似乎不再是一个选项了。 - Tony

1

procedure TTmpMessage.edMsgChange (Sender: TObject);
var
    LineHeight : Integer;
    DC         : HDC;
    SaveFont   : HFont;
    Metrics    : TTextMetric;
begin
    DC := GetDC ( TRxRichEdit (Sender).Handle );
    SaveFont := SelectObject ( DC, TRxRichEdit (Sender).Font.Handle );
    GetTextMetrics (DC, Metrics);
    SelectObject (DC, SaveFont);
    ReleaseDC ( TRxRichEdit (Sender).Handle, DC );
    LineHeight := Metrics.tmHeight;
    Height := TRxRichEdit (Sender).Lines.Count * LineHeight + 32;
end;

- alisa

1

"为什么不只是这样：

"

Memo1.Height := Memo1.ContentBounds.Height + 5;

- user3223924

ContentBounds仅在FMX中存在，而在VCL中不存在。 - dredkin

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Someone · Accepted Answer

这对我来说完全有效。添加的常量（8）可能会因您是否使用边框和/或斜面而有所不同，请进行尝试。

procedure TForm1.Memo1Change(Sender: TObject);
var
  LineHeight: Integer;
  DC: HDC;
  SaveFont : HFont;
  Metrics : TTextMetric;
  Increase: Integer;
  LC: Integer;
begin
  DC := GetDC(Memo1.Handle);
  SaveFont := SelectObject(DC, Memo1.Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(Memo1.Handle, DC);
  LineHeight := Metrics.tmHeight;
  Increase := Memo1.Height;
  LC := Memo1.Lines.Count;
  if LC < 1 then
    LC := 1;
  Memo1.Height := LC * LineHeight + 8;
  Increase := Memo1.Height - Increase;
  Memo1.Parent.Height := Memo1.Parent.Height + Increase;
end;