Text zur Anzeige kürzen mit Punkten hinten

[Guido Eisenbeis]

Hier nun meine Variante.

Delphi-Quellcode:

// Routine zum Kürzen eines Textes und Anhängen von Punkten an den Text.
function SetShortenedTextWithDots(AFont: TFont; AText: String;
  AMaxWidth: Integer): string;
const
  Dots = ' ...';
var
  ShortTxt: String;
  Cnvs: TCanvas;
  RightSpace: Integer;
begin
  Cnvs := TCanvas.Create;
  try
    Cnvs.Font.Assign(AFont);
    Cnvs.Handle := GetDC(GetDesktopWindow);

    ShortTxt := AText;
    RightSpace := (Cnvs.TextWidth(Dots) * 2); // Platz schaffen für die Dots.

    // Text kürzen, bis er ins Control passt.
    while (AMaxWidth < (Cnvs.TextWidth(ShortTxt) + RightSpace)) do
    begin
      if Length(ShortTxt) < 2 then Break;
      ShortTxt := UTF8ToAnsi(ShortTxt); // Nur benötigt in Lazarus, wegen Umlauten.
      ShortTxt := LeftStr(ShortTxt, Length(ShortTxt) - 1);
      ShortTxt := AnsiToUtf8(ShortTxt); // Nur benötigt in Lazarus, wegen Umlauten.
    end;

    // Prüfen, ob der gekürzte oder der komplette Text angezeigt werden soll.
    if Length(ShortTxt) < Length(AText) then
      Result := ShortTxt + Dots
    else
      Result := AText;
  finally
    ReleaseDC(0, Cnvs.Handle);
    Cnvs.Free;
  end;
end;

Aufruf-Beispiel im FormResize:

Delphi-Quellcode:

// 1 TLabel, 1 TPanel und 1 TEdit auf die Form,
// bei Label1 AutoSize auf false setzen,
// bei Panel1 Alignment = taLeftJustify setzen,
// bei allen die Anchors = [akLeft, akRight, akTop] setzen,
// und alle seitlich vergrößern bis fast an den Form-Rand.
procedure TForm1.FormResize(Sender: TObject);
var
  Txt: String;
begin
  Txt := 'Beispiel-Text für FormResize';
  Label1.Caption := SetShortenedTextWithDots(Label1.Font, Txt, Label1.Width);
  Panel1.Caption := SetShortenedTextWithDots(Panel1.Font, Txt, Panel1.Width);
  Edit1.Text := SetShortenedTextWithDots(Edit1.Font, Txt, Edit1.Width);
end;

Das sollte in Delphi und in Lazarus funktionieren. Ich würde mich freuen, wenn ihr das testen würdet und über Anregungen. Falls Fehler drin sind, dürft ihr mir das auch sagen.

Guido.


Edit: Source-Codes zum Testen hinzugefügt.