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

Delphi 调整标签大小不会更改标签高度,delphi,Delphi,如何在调整窗体大小时自动调整标签高度?所有属性都已设置。对齐是顶部。自动调整大小是正确的。单词包装是正确的 当我更改表单大小时,标签会很好地调整标题。但是,实际标签不会调整其高度 当表单宽度增加或标题底部不可读时,这会留下一个间隙。如果标签下方有控件,控件应根据标签的高度向上或向下移动,则会使其变得丑陋 我不喜欢使用窗体的调整大小事件来执行此操作。太糟糕了,没有表单“调整结束大小”事件 有什么帮助吗?谢谢。如果我没记错的话,当自动调整大小设置为真时,标签的高度会自动设置为标题中文本的实际高度 您

如何在调整窗体大小时自动调整标签高度?所有属性都已设置。对齐是顶部。自动调整大小是正确的。单词包装是正确的

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

当表单宽度增加或标题底部不可读时,这会留下一个间隙。如果标签下方有控件,控件应根据标签的高度向上或向下移动,则会使其变得丑陋

我不喜欢使用窗体的调整大小事件来执行此操作。太糟糕了,没有表单“调整结束大小”事件


有什么帮助吗?谢谢。

如果我没记错的话,当
自动调整大小
设置为
时,标签的高度会自动设置为
标题
中文本的实际高度


您可以尝试将
Autosize
设置为
false
,看看这对您有何作用。

我通过继承tlabel解决了这个问题。 在这种情况下,autosize有一个bug(autosize、wordwrap和alTop)

要使其重新计算其大小,您需要:

AutoSize := false;
AutoSize := true;
因此,您可以像这样覆盖调整大小过程:

procedure TResizableLabel.Resize;
begin
  AutoSize := false;
  AutoSize := true;
end;
但是,如果每次调整大小时都这样做,它也会缩小宽度,因此您将从alTop中丢失父对象的宽度,如果它只是左对齐,则可能没有问题,但如果您想要居中或右对齐,则需要更好的解决方案

这是完整的解决方案,它将仅在需要时调用autosize:

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;
TResizableLaber=class(TLabel)
受保护的
FTextHeight、FTextWidth:整数;
函数GetCaption:tcoption;
过程设置标题(A选项:T选项);
函数GetFont:TFont;
程序SetFont(前面的:TFont);
公众的
程序调整;推翻
属性标题:t选项读取GetCaption写入SetCaption;
属性字体:TFont read GetFont write SetFont;
结束;
实施
程序TResizableLaber.Resize;
变量
num:双倍;
开始
继承;
如果自动调整大小,则
开始
如果(FTextHeight=0)或(FTextWidth=0),则
开始
//惰性评估,我们在每次标题或字体更改时重新评估
FTextWidth:=Utills.GetTextWidth(标题,字体);
FTextHeight:=Utills.GetTextHeight(标题,字体);
结束;
//TODO:这里仍然有一个bug,设置alCenter并使最后一个单词足够长,这样即使全局空间足够大,它也不能总是在前面换行
num:=(高度/FTextHeight)-(FTextWidth/Width);
//如果num大于1,则表示需要一条额外的线;如果num小于0,则表示有一条额外的线
如果(num>1)或(num<0),则
开始
//一直这样做会使它真正调整大小,并会破坏整个空间的alTop匹配
自动调整大小:=假;
自动调整大小:=真;
结束;
结束;
结束;
函数TResizableLaber.GetCaption:tcoption;
开始
结果:=遗传性标题;
结束;
程序TResizableLaber.SetCaption(acoption:tcoption);
开始
FTextWidth:=Utills.GetTextWidth(acoption,Self.Font);
FTextHeight:=Utills.GetTextHeight(acoption,Self.Font);
继承的标题:=acoption;
结束;
函数TResizableLaber.GetFont:TFont;
开始
结果:=继承字体;
结束;
程序TResizableLaber.SetFont(前面的:TFont);
开始
FTextWidth:=Utills.GetTextWidth(标题,前面);
FTextHeight:=Utills.GetTextHeight(标题,前面);
继承字体:=AFont;
结束;
类函数Utills.GetTextHeight(常量文本:String;字体:TFont):整数;
变量
位图:TBitmap;
开始
位图:=TBitmap.Create;
尝试
bitmap.Canvas.Font:=字体;
结果:=位图.Canvas.TextHeight(文本);
最后
位图。免费;
结束;
结束;
类函数Utills.GetTextWidth(const Text:String;Font:TFont):整数;
变量
位图:TBitmap;
开始
位图:=TBitmap.Create;
尝试
bitmap.Canvas.Font:=字体;
结果:=位图.Canvas.TextWidth(文本);
最后
位图。免费;
结束;
结束;

<代码> > OnResiths是“RealSmithEnter”,我认为您需要<代码> WMXEXITSIZEMOF/<代码>。考虑使用标签的代码> ANCOBORS/CODEX>属性。您可以锚定标签的底部,使其随着父项的高度变化而移动。根据我的观察,每一个像素的变化都会改变火焰的大小。将“顶部对齐”标签更改为包含“底部锚定”不会持续工作-非常不稳定。@tj-它会在窗体调整大小后触发。如果“拖动时显示窗口内容”处于活动状态,它可以连续触发,因为随着每个像素的更改,窗体的大小都已调整。考虑对我评论的消息进行搜索。当AutoSIZE为false时,标签的高度不能自动调整,那么,当它为真时,也不会自动调整标签的高度。