TLabel maximaler Font größe Berechnen, gelöst

[corpsman]

Servus zusammen,
ich bastle hier gerade eine Anwendung in der ich auf einem TLabel einen Text maximal groß anzeigen lassen möchte,
Dazu habe ich beim TLabel das Autosize weg genommen und dann das Label so groß gemacht wie es auf meiner Anwendung eben sein soll.

Der Nachfolgende Code funktioniert, ist aber super langsam, kennt da jemand einen Besseren Weg ?

Code: Alles auswählen

Procedure TForm1.FormResize(Sender: TObject);
Var
  maxwSize: integer;
Begin
  label1.Font.Size := 1;
  While Label1.Canvas.TextWidth('75') < label1.Width Do Begin
    label1.Font.Size := label1.Font.Size + 1;
  End;
  maxwSize := label1.Font.Size - 1;
  label1.Font.Size := 1;
  While Label1.Canvas.TextHeight('75') < label1.Height Do Begin
    label1.Font.Size := label1.Font.Size + 1;
  End;
  label1.Font.Size := min(label1.Font.Size - 1, maxwSize);
  label1.Invalidate;
End; 

[paweld]

etwa so:

Code: Alles auswählen

uses
  Types, Math;

procedure TForm1.FormResize(Sender: TObject);
var
  fsw, fsh: Integer;  //font sizes
  ts: TSize;  //text size for font size 10
begin
  Label1.Font.Size := 10;
  ts := Label1.Canvas.TextExtent(Label1.Caption);
  fsw := 10 + trunc((Label1.Width - ts.Width) * 72 * (ts.Height / ts.Width) / Screen.PixelsPerInch);
  fsh := 10 + trunc((Label1.Height - ts.Height) * 72 / Screen.PixelsPerInch);
  Label1.Font.Size := Min(fsw, fsh);
  ts := Label1.Canvas.TextExtent(Label1.Caption);
  while (Label1.Font.Size > 0) and ((ts.Width > Label1.Width) or (ts.Height > Label1.Height)) do
  begin
    Label1.Font.Size := Label1.Font.Size - 1;
    ts := Label1.Canvas.TextExtent(Label1.Caption);
  end;
end;            

[wp_xyz]

Hast du schon mal das OptimalFill eines Labels ausprobiert? https://dsiders.gitlab.io/lazdocsnext/l ... lfill.html

[af0815]

Hast du schon mal das OptimalFill eines Labels ausprobiert? https://dsiders.gitlab.io/lazdocsnext/l ... lfill.html

Das dürfte Lazarus main (vormals trunk) sein = daher Lazarus 4.99. Oder gibt es das schon länger ?

[wp_xyz]

Nein, das gibt es schon ewig, mein ältester Lazarus auf meiner Platte ist 1.4.4 und da ist es schon vorhanden.

[fliegermichl]

Ha, das kannte ich auch noch nicht.

[Mathias]

Ich habe es probiert.
Wen man im Opbjectinspector OptimalFill auf True stellt, und die Grösse des LAbels mit der Maus ändert, wird die Schriftgrösse angepasst.
Da habe ich mall versucht Align vom Label auf alClient zu stellen. Da wird die Grösse der Schrift nicht angepasst.

Ist dies so gewollt ?

[wp_xyz]

Weiß nicht. Wahrscheinlich: unvermeidbar, weil die ganze Größenänderung der Controls sehr kompliziert ist und da hat man wahrscheinlich darauf verzichtet, sich wegen eines wenig benutzen Features einen Haufen anderer Schwierigkeiten aufzuhalsen. Ich weiß, dass es zum OptimalFill einige Bug-Reports gibt, aber ich habe das nicht weiter verfolgt.

Per Code geht es dann trotzdem:

Code: Alles auswählen

procedure TForm1.FormResize(Sender: TObject);
begin
  Label1.Height := ClientHeight;  // Label1 hat OptimalFill=true und Align=alNone
  Label1.Width := ClientWidth;
end; 

[corpsman]

*g*, cool optimal Fill kannte ich noch nicht
Mein Label ist mittels anchors an das Form gekettet, ich schau mal ob es damit geht. Evtl gibt es ja eine Methode die man Triggern kann damit sich das Label neu "berechnet"

[corpsman]

Also hab nu ne Variante gefunden die funktioniert:

Code: Alles auswählen

Procedure TForm1.FormResize(Sender: TObject);
Begin
  label1.OptimalFill := false;
  Application.ProcessMessages;
  label1.OptimalFill := true;
End;

Danke.