Question

如何在调整表单大小时自动调整标签高度？所有属性都已设置。对齐是最重要的。自动调整是真的。自动换行是真的。

当我更改表单大小时，标签会调整标题。但是，实际标签不会调整其高度。

当表单宽度增加或者字幕的底部部分不可读时，这会留下间隙。当标签下方的控件应根据标签的高度向上或向下移动时，会使其变得难看。

我不想使用表单的resize事件来执行此操作。太糟糕了没有形式＆＃34;调整大小结束＆＃34;事件

有任何帮助吗？感谢。

Answer 1

如果我没记错，将Autosize设置为true，标签的高度会自动设置为Caption中文字的实际高度。

您可以尝试将Autosize设置为false，看看它对您有何帮助。

Answer 2

我通过继承tlabel解决了问题。在这种情况下，自动调整大小有一个错误（autosize，wordwrap和alTop）

让它重新计算你需要的尺寸：

AutoSize := false;
AutoSize := true;

所以你可以像这样覆盖调整大小的过程：

procedure TResizableLabel.Resize;
begin
  AutoSize := false;
  AutoSize := true;
end;

然而，如果你在每次调整大小时都会这样做，它也会缩小宽度，所以你将从alTop中丢失父级的宽度，如果它刚刚对齐，它可能没问题，但如果你想要中心或者正确的对齐，你需要一个更好的解决方案。

这是完整的解决方案，只有在需要时才会调用自动调整大小：

TResizableLaber = class(TLabel)
  protected
    FTextHeight, FTextWidth : integer;
    function GetCaption : TCaption;
    procedure SetCaption(ACaption : TCaption);
    function GetFont : TFont;
    procedure SetFont(AFont : TFont);
  public
    procedure Resize; override;
    property Caption : TCaption read GetCaption write SetCaption;
    property Font : TFont read GetFont write SetFont;
end;

implementation 

procedure TResizableLaber.Resize;
var
  num : double;
begin
  inherited;
  if AutoSize then
    begin
      if (FTextHeight = 0) or (FTextWidth = 0) then
        begin
            //lazy evaluation, we re evaluate every time the caption or font changes
            FTextWidth := Utills.GetTextWidth(Caption, Font);
            FTextHeight := Utills.GetTextHeight(Caption,Font);
        end;

      //TODO: there is still one bug here, set alCenter and make the last word long enough so it cant always wrapped to the line before, even though there is globally enough space
      num := (  Height / FTextHeight) - (FTextWidth /Width );
      //if num is greater then 1 it means we need an extra line, if it is lower then zero it means there is an extra line
      if (num > 1) or (num < 0) then
        begin
          //just doing this all the time will cause it to really resize and will break alTop matching the whole space
          AutoSize := false;
          AutoSize := true;
        end;
    end;
end;

function TResizableLaber.GetCaption : TCaption;
begin
  Result := inherited Caption;
end;
procedure TResizableLaber.SetCaption(ACaption : TCaption);
begin
  FTextWidth := Utills.GetTextWidth(ACaption, Self.Font);
  FTextHeight := Utills.GetTextHeight(ACaption,Self.Font);
  inherited Caption := ACaption;
end;

function TResizableLaber.GetFont : TFont;
begin
  Result := inherited Font;
end;
procedure TResizableLaber.SetFont(AFont : TFont);
begin
  FTextWidth := Utills.GetTextWidth(Caption, AFont);
  FTextHeight := Utills.GetTextHeight(Caption,AFont);
  inherited Font := AFont;
end;


class function Utills.GetTextHeight(const Text:String; Font:TFont) : Integer;
var
  bitmap: TBitmap;
begin
  bitmap := TBitmap.Create;
  try
   bitmap.Canvas.Font := Font;
   Result := bitmap.Canvas.TextHeight(Text);
  finally
   bitmap.Free;
  end;
end;

class function Utills.GetTextWidth(const Text:String; Font:TFont) : Integer;
var
  bitmap: TBitmap;
begin
  bitmap := TBitmap.Create;
  try
   bitmap.Canvas.Font := Font;
   Result := bitmap.Canvas.TextWidth(Text);
  finally
   bitmap.Free;
  end;
end;

调整标签大小不会更改标签高度

2 个答案: