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.