type
TAATextAccess = class(TAAText);
// 返回 AAText 控件在加载 ALines 文本后实际显示的有效高度
function GetAATextHeight(AAText: TAAText; ALines: TStrings): Integer;
var
i, j: Integer;
WrapLines: TStrings;
CurrText: string;
CurrAlign: TAlignment;
TextWidth: Integer;
TextHeight: Integer;
AWidth: Integer;
xFree: Boolean;
MaxCol: Integer;
begin
Result := 0;
WrapLines := TStringList.Create;
try
with TAATextAccess(AAText), AAText.Text do
begin
xFree := not WordWrap and AutoSize and (Align in [alNone, alLeft, alRight]);
if xFree then AWidth := 0
else AWidth := ClientWidth;
AAFont.Canvas := Canvas;
AAFont.Effect.Assign(FontEffect);
Canvas.Font.Assign(Font);
for i := 0 to ALines.Count - 1 do
begin
CurrText := ALines[i]; //当前处理字符串
if LabelEffect = leOnlyALine then
begin
Canvas.Font.Assign(Font);
AAFont.Effect.Assign(FontEffect);
end;
Fonts.Check(CurrText, Canvas.Font, AAFont.Effect); //检查字体标签
Labels.Check(CurrText, CurrAlign); //检查用户标签
TextWidth := AAFont.TextWidth(CurrText);
if WordWrap and (TextWidth > AWidth) then //自动换行
begin
MaxCol := AWidth * Length(CurrText) div TextWidth;
while AAFont.TextWidth(Copy(CurrText, 1, MaxCol)) > AWidth do
Dec(MaxCol);
WrapText(CurrText, WrapLines, MaxCol);
end else if CurrText <> '' then
WrapLines.Text := CurrText
else
WrapLines.Text := ' ';
if xFree and (TextWidth > AWidth) then //确定宽度
begin
AWidth := TextWidth;
end;
for j := 0 to WrapLines.Count - 1 do
begin
CurrText := WrapLines[j];
TextHeight := AAFont.TextHeight(CurrText + ' ');
Inc(Result, TextHeight);
if (i < ALines.Count - 1) or (j < WrapLines.Count - 1) then
Inc(Result, Round(TextHeight * RowPitch / 100));
end;
end;
Result := Result + 2 * Border;
end;
finally
WrapLines.Free;
end;
end;
使用时,将需要加载的文本先放到临时字符串列表中,逐行增加并调用该函数判断当前有效高度是否大于控件实际高度。
另外,如果在 BCB 下使用,可以将这个函数放到 AACtrls 单元或新建一个 pas 单元来调用。