Text kürzen (Ellipsis...)

[himitsu]

Da man es doch ab und zu mal braucht
und da MinimizeName nicht immer das gewünschte Ergebnis liefert (http://www.delphipraxis.net/164086-t...te-hinten.html),

hab ich das Ganze mal in einer kleinen Funktion verpackt.

Header:

Delphi-Quellcode:

function GetEllipsisText(S: String; MaxWidth: Integer; MaxHeight: Integer = 0; Canvas: TCanvas = nil; Font: TFont = nil;
  PathEllipsis: Boolean = False; TextFormat: TTextFormat = []): String; overload;

function GetEllipsisText(S: String; MaxWidth: Integer; Canvas: TCanvas; Font: TFont = nil;
  PathEllipsis: Boolean = False; TextFormat: TTextFormat = []): String; overload;

function GetEllipsisText(S: String; MaxWidth: Integer; Font: TFont;
  PathEllipsis: Boolean = False; TextFormat: TTextFormat = []): String; overload;

function GetEllipsisText(Handle: HDC; S: String; MaxWidth: Integer; MaxHeight: Integer = 0;
  PathEllipsis: Boolean = False; TextFormat: LongWord = 0): String; overload;

Code:

Delphi-Quellcode:

function GetEllipsisText(S: String; MaxWidth: Integer; MaxHeight: Integer = 0; Canvas: TCanvas = nil; Font: TFont = nil;
  PathEllipsis: Boolean = False; TextFormat: TTextFormat = []): String;
var
  R: TRect;
  C: TCanvas;
begin
  C := nil;
  try
    Result := S;
    UniqueString(Result);
    if MaxHeight <= 0 then
      MaxHeight := 1000;
    R := Rect(1, 1, MaxWidth, MaxHeight);
    if not Assigned(Canvas) then begin
      C := TCanvas.Create;
      Canvas := C;
    end;
    if Assigned(Font) then
      Canvas.Font.Assign(Font);
    TextFormat := TextFormat + [tfCalcRect, tfModifyString];
    if PathEllipsis then
      TextFormat := TextFormat + [tfPathEllipsis];
    if TextFormat * [tfEndEllipsis, tfPathEllipsis] = [] then
      TextFormat := TextFormat + [tfEndEllipsis];
    Canvas.TextRect(R, Result, TextFormat);
  finally
    C.Free;
  end;
end;

function GetEllipsisText(S: String; MaxWidth: Integer; Canvas: TCanvas; Font: TFont = nil;
  PathEllipsis: Boolean = False; TextFormat: TTextFormat = []): String;
begin
  Result := GetEllipsisText(S, MaxWidth, 0, Canvas, Font, PathEllipsis, TextFormat);
end;

function GetEllipsisText(S: String; MaxWidth: Integer; Font: TFont;
  PathEllipsis: Boolean = False; TextFormat: TTextFormat = []): String;
begin
  Result := GetEllipsisText(S, MaxWidth, 0, nil, Font, PathEllipsis, TextFormat);
end;

function GetEllipsisText(Handle: HDC; S: String; MaxWidth: Integer; MaxHeight: Integer = 0;
  PathEllipsis: Boolean = False; TextFormat: LongWord = 0): String;
var
  R: TRect;
begin
  Result := S;
  UniqueString(Result);
  if MaxHeight <= 0 then
    MaxHeight := 1000;
  R := Rect(1, 1, MaxWidth, MaxHeight);
  TextFormat := TextFormat or DT_CALCRECT or DT_MODIFYSTRING;
  if PathEllipsis then
    TextFormat := TextFormat or DT_PATH_ELLIPSIS;
  if TextFormat and (DT_END_ELLIPSIS or DT_PATH_ELLIPSIS) = 0 then
    TextFormat := TextFormat or DT_END_ELLIPSIS;
  DrawTextEx(Handle, PChar(Result), Length(Result), R, TextFormat, nil);
  SetLength(Result, StrLen(PChar(Result)));
end;

Beispiel:

Delphi-Quellcode:

// Edit1 (TEdit), sowie Label1 und Label2 (TLabel) auf die Form und Folgendes ins OnChange des Edits

procedure TForm1.Edit1Change(Sender: TObject);
begin
  Label1.Caption := GetEllipsisText(Edit1.Text, 75, Label1.Canvas);

  //Edit2.Text := GetEllipsisText(Edit2.Handle, Edit1.Text, 50);
  Label2.Caption := GetEllipsisText(Label2.Canvas.Handle, Edit1.Text, 50);
end;

Und noch etwas für die VCL-Puristen:

Delphi-Quellcode:

procedure TForm1.Edit1Change(Sender: TObject);
var
  S: String;
  R: TRect;
begin
  S := Edit1.Text;
  R := MyControl.ClientRect;
  MyControl.Canvas.TextRect(R, S, [tfCalcRect, tfEndEllipsis, tfModifyString]);
  MyControl.Caption := S;
end;

Will man es nur angezeigt haben, dann kann man auch direkt DrawTextEx, TCanvas.DrawText und in neueren Delphis das TLabel.EllipsisPosition verwenden.

[Guido Eisenbeis]

Hallo himitsu,

danke für den Code, funktioniert prima.

Zitat von himitsu:

Nja, die letzte Variante, also die mit dem Handle (HDC), sollte dann wohl auch unter Lazarus laufen. (hoff ich einfach mal, und wenn nicht, dann müßt ihr's halt noch etwas anpassen)

Kann ich bestätigen. In Lazarus sollte man darauf achten, für die Rect-Funktion die richtige Unit ("Classes") einzubinden und vor den Rect-Befehl zu setzen. (Ein Fehler kann z. B. auftreten, wenn man auch die Unit "Windows" eingebunden hat.) Das wäre dann in deinem Code die neunt-letzte Zeile:

  R := Classes.Rect(1, 1, MaxWidth, MaxHeight);


Und hier noch ein Aufruf-Beispiel, das den Text kürzt, wenn die Form "resizet" wird.

Delphi-Quellcode:

  // Label1 (TLabel) auf die Form, Label1.AutoSize = False setzen und z. B.
  // links und rechts bis fast an den Form-Rand vergrößern.
  // Der Effekt wird sichbar beim Verkleinern der Form, wenn der Text länger
  // als das Label ist.

  procedure TForm1.FormResize(Sender: TObject);
  begin
    Label1.Caption := GetEllipsisText(
      Label1.Canvas.Handle, 'Beispiel-Text für FormResize.', Label1.Width);
  end;

Guido.


Nachtrag 02.11.2011: Habe gerade festgestellt, dass die Funktion in Lazarus beim Kürzen von Umlauten ein "?" an der Stelle des Umlauts zeigt. Hab dies als Frage im anderen Thread im Posting #28 gestellt.

Nachtrag 04.11.2011: Hier die angepasste Routine für Lazarus:

Delphi-Quellcode:

function GetEllipsisText(Handle: HDC; S: String; MaxWidth: Integer; MaxHeight: Integer = 0;
  PathEllipsis: Boolean = False; TextFormat: LongWord = 0): String;
var
  R: TRect;
begin
  Result := UTF8ToAnsi(S);  // <-- Konvertieren zu Ansi ...
  UniqueString(Result);
  if MaxHeight <= 0 then
    MaxHeight := 1000;
  R := Classes.Rect(1, 1, MaxWidth, MaxHeight);
  TextFormat := TextFormat or DT_CALCRECT or DT_MODIFYSTRING;
  if PathEllipsis then
    TextFormat := TextFormat or DT_PATH_ELLIPSIS;
  if TextFormat and (DT_END_ELLIPSIS or DT_PATH_ELLIPSIS) = 0 then
    TextFormat := TextFormat or DT_END_ELLIPSIS;
  DrawTextEx(Handle, PChar(Result), Length(Result), R, TextFormat, nil);
  SetLength(Result, StrLen(PChar(Result)));
  Result := AnsiToUTF8(Result); // <-- und zurück.
end;

Guido.