1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

procedure TForm1.Button1Click(Sender: TObject);
var s : String;
    MaxBreite, Breite, Schriftgroesse : Integer;
begin
  MaxBreite:=Label1.Width;
  Schriftgroesse:=32;
  Label1.Font.Name:='Arial';
  Label1.Canvas.Font.Name:='Arial';
  s:='Das ist ein sehr, sehr langer Text für das Label';
  Label1.Caption:=s;
  repeat
    Label1.Font.Size:=Schriftgroesse;
    Label1.Canvas.Font.Size:=Schriftgroesse;
    Breite:=Label1.Canvas.TextWidth(s);
    Application.ProcessMessages;
    Dec(Schriftgroesse);
    Sleep(100);
  until Breite<MaxBreite;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:

var s : String;
    MaxHoehe, Hoehe, Schriftgroesse : Integer;
begin
  MaxHoehe:=Label1.Height;
  Schriftgroesse:=32;
  Label1.Font.Name:='Arial';
  Label2.Font.Name:='Arial';
  s:='Das ist ein sehr, sehr langer Text für das Label. Und der Text soll jetzt für das Label passend gemacht werden.';
  Label1.Caption:=s;
  // Das ist ein Dummy-Label, was man unsichtbar machen kann.
  Label2.Caption:=s;
  Label2.WordWrap:=True;
  Label2.Width:=Label1.Width;
  Label2.AutoSize:=True;
  //ShowMessage(IntToStr(Label2.Width));
  repeat
    Label2.Width:=Label1.Width;  // Die Zeile ist wichtig!
    Label2.Font.Size:=Schriftgroesse;
    Application.ProcessMessages;
    Dec(Schriftgroesse);
    Sleep(100);
    Hoehe:=Label2.Height;
  until Hoehe<MaxHoehe;
  Label1.Font.Size:=Schriftgroesse+1;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:

function TextFitsInRect(DestRect: TRect; const Text: string;
  DestCanvas: TCanvas): Boolean;
var
  tmpCanvas: TCanvas;
  R: TRect;
begin
  tmpCanvas := TCanvas.Create;
  try
    tmpCanvas.Handle := DestCanvas.Handle;
    tmpCanvas.Font.Assign(DestCanvas.Font);
    R := DestRect;
    DrawText(tmpCanvas.Handle, PChar(Text), -1, R, DT_TOP or DT_LEFT or
      DT_WORDBREAK or DT_CALCRECT);
    Result := R.Height <= DestRect.Height;
  finally
    tmpCanvas.Free;
  end;
end;

procedure TFormTest.ButtonTestClick(Sender: TObject);
begin
  while not TextFitsInRect(LabelTest.ClientRect, LabelTest.Caption, LabelTest.Canvas) do
    LabelTest.Font.Size := LabelTest.Font.Size - 1;
end;