AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Text kürzen (Ellipsis...)

Ein Thema von himitsu · begonnen am 30. Okt 2011 · letzter Beitrag vom 2. Nov 2011
Antwort Antwort
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
42.982 Beiträge
 
Delphi 12 Athens
 
#1

Text kürzen (Ellipsis...)

  Alt 30. Okt 2011, 12:01
Da man es doch ab und zu mal braucht
und da Delphi-Referenz durchsuchenMinimizeName 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 MSDN-Library durchsuchenDrawTextEx, Delphi-Referenz durchsuchenTCanvas.DrawText und in neueren Delphis das Delphi-Referenz durchsuchenTLabel.EllipsisPosition verwenden.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests

Geändert von himitsu (30. Okt 2011 um 12:25 Uhr)
  Mit Zitat antworten Zitat
Guido Eisenbeis

Registriert seit: 9. Apr 2006
389 Beiträge
 
Delphi 10.3 Rio
 
#2

AW: Text kürzen (Ellipsis...)

  Alt 2. Nov 2011, 07:46
Hallo himitsu,

danke für den Code, funktioniert prima.

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.

Geändert von Guido Eisenbeis ( 4. Nov 2011 um 06:02 Uhr) Grund: Nachtrag hinzugefügt.
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 03:37 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz