Text zur Anzeige kürzen mit Punkten hinten

[Guido Eisenbeis]

Ich benutze Lazarus im {$mode delphi} für Win 32.

Hier geht es um einen Workaround, der vom Thread Verschiedene Controls an Procedur übergeben "abstammt".

Wenn eine Form in der TitleBar einen langen Text anzeigt und man die Form seitlich verkleinert (zusammenschiebt), wird der Text gekürzt und mit Punkten am Ende dargestellt, sobald der gesamte Text nicht mehr in die TitleBar passt. Dieses Verhalten will ich für verschiedene Controls nachbilden, die man z. B. als TitleBar für eine rahmenlose Form verwenden kann.

Bei meiner Recherche (Google, Foren-SF) habe ich zu diesem Thema nur Beiträge gefunden, die sich auf Pfade beziehen und die Punkte in der Mitte haben. Mir geht es aber um beliebigen Text, dem die Punkte hinten angehängt werden. (Wer einen fertigen Code kennt, kann ihn gerne posten.)

Für die Anzeige des gekürzten Textes mit Punkten kommen verschiedene Controls in Frage, die auch nicht unbedingt eine TitleBar darstellen müssen (TitleBar war nur ein Beispiel). Wichtig ist nur, dass das Control eine Caption- oder Text-Eigenschaft hat.

Hier eine Übersicht der Bedingungen, die in einer einzigen Procedure erfüllt werden sollen:

- Im Procedure-Kopf wird ein Control und der Text übergeben.

- Es wird geprüft, ob das Control eine Caption- oder Text-Eigenschaft besitzt.

- Die Textlänge wird in Pixel ermittelt und mit der Width des Controls verglichen.
. . . dabei wird die Schrift, Schrift-Größe, Fett-Schrift, usw. berücksichtigt.

- Ist der Text zu lang, um komplett im Control dargestellt zu werden,
. . . a) wird er gekürzt, sodass er ins Control passt und "..." angehängt,
. . . b) wird der komplette Text im Tooltipp des Controls angezeigt.


Nun werd ich mich daran machen, das Ganze in Code umzusetzen. Einige Ansätze wurden schon im o. g. "Abstamm"-Thread gezeigt. Über weitere Ideen und Anregungen würde ich mich freuen!

Guido.

[BUG]

Der schönste Ansatz ist es nicht gerade, aber vielleicht kannst du damit was anfangen:

Delphi-Quellcode:

function shortenString(c: TCanvas; s: string; w: integer; dots: boolean): string;
var
  exploder: TStringList;
  appendDots: boolean;
begin
  exploder := TStringList.Create;
  exploder.Delimiter := ' ';
  exploder.DelimitedText := trim(s);
  appendDots := False;
  while exploder.Count > 0 do
  begin
    if appendDots then
      s := exploder.DelimitedText + ' ...'
    else
      s := exploder.DelimitedText;
    if c.TextWidth(s) > w then
    begin
      exploder.Delete(exploder.Count - 1);
      appendDots := dots;
    end
    else
    begin
      break;
    end;
  end;
  exploder.Free;
  Result := s;
end;

[himitsu]

Zumindestens in Delphi gibt es da irgendwo eine Funktion dafür, aber ich glaub das war sogar eine WinAPI, also sollte es sie auch in Lazarus geben. :gruebel:

PS: Bei den TLabel (Delphi) kann man das jetzt auch über den OI regeln.
Wobei es intern schon viel länger möglich war.
(ich weiß nicht wie dieses in Lazarus arbeitet, aber vermutlich ähnlich)

Stichwort: DrawTextW und DT_PATH_ELLIPSIS, DT_END_ELLIPSIS oder DT_WORD_ELLIPSIS.

[Guido Eisenbeis]

@BUG

Dein Ansatz ist zwar etwas grob, aber schon ganz gut. :) Mit grob meine ich, dass das Kürzen immer ganze Wörter weg nimmt. Bei längeren Wörtern (z. B. "Weltwirtschaftskrise") wäre das schon jeweils ein ziemlich krasser Sprung. An sich aber eine interessante Idee.

Zitat:

Zitat von himitsu (Beitrag 1133085)

Zumindestens in Delphi gibt es da irgendwo eine Funktion dafür, aber ich glaub das war sogar eine WinAPI, also sollte es sie auch in Lazarus geben. :gruebel:

Welche Funktion ist das denn? Die von dir erwähnte DrawText? DrawText will ich nicht. :P
Nee, Spaß beiseite, für DrawText wird ein hdc benötigt, was nicht bei allen in Frage kommenden Controls der Fall ist. Außerdem soll der gekürzte Text als string vorliegen, um in z. B. weiterverarbeiten zu können.

Falls du eine andere Funktion meintest, dann raus damit. :wink:

Zitat:

Zitat von himitsu (Beitrag 1133085)

Bei den TLabel (Delphi) kann man das jetzt auch über den OI regeln.
Wobei es intern schon viel länger möglich war.
(ich weiß nicht wie dieses in Lazarus arbeitet, aber vermutlich ähnlich)

Denke ich auch. Wie heißt die Eigenschaft denn? Ab welcher Delphi-Version?


Ansonsten, eine Routine zum kürzen habe ich mittlerweile selbst geschrieben. Funktioniert ganz gut. Hier ein Code-Ausschnitt:

Delphi-Quellcode:

  // Text kürzen, bis er ins Control passt.
  while (ACtrl.Width < (TmpCanvas.TextWidth(TmpTxt) + 50)) do
  begin
    if Length(TmpTxt) < 2 then exit;
    TmpTxt := LeftStr(TmpTxt, Length(TmpTxt) - 1);
  end;

[jaenicke]

Zitat:

Zitat von Guido Eisenbeis (Beitrag 1133088)

Denke ich auch. Wie heißt die Eigenschaft denn? Ab welcher Delphi-Version?

EllipsisPosition, siehe Doku:
http://docwiki.embarcadero.com/VCL/d...lipsisPosition
Das sieht dann so aus:

Anhang 35447

Geben tut es das ab Delphi 2006. Intern wird das 1:1 auf die entsprechenden Konstanten gemappt und an DrawText übergeben. Auch Canvas.TextRect kennt ein entsprechendes Flag. Aber das sind eben alles nur für die Ausgabe vorhandene Funktionen.

Wenn du also den gekürzten Text benötigst, musst du das selbst machen.

// EDIT:

Zitat:

Zitat von Guido Eisenbeis (Beitrag 1133088)

Nee, Spaß beiseite, für DrawText wird ein hdc benötigt, was nicht bei allen in Frage kommenden Controls der Fall ist.

Bei welchen denn? Nicht bei allen kommst du direkt heran, aber eigentlich haben alle einen Device Context.

[DeddyH]

Vielleicht geht es mit MinimizeName, obwohl das AFAIK nur für Pfadangaben gedacht ist.

[himitsu]

Ahhh, MinimizeName war das ... nichts gefunden, aber doch erinnert, daß vor Jahren mal gesehn zu haben :shock:

Schade, hatte gehofft das nutzt die gleiche Funktion, welche auch DrawText nutzt.

[Guido Eisenbeis]

Zitat:

Zitat von DeddyH (Beitrag 1133095)

Vielleicht geht es mit MinimizeName, obwohl das AFAIK nur für Pfadangaben gedacht ist.

Stimmt, ist nur für Pfade. :(

Zitat:

Zitat von jaenicke (Beitrag 1133090)

EllipsisPosition
...
Geben tut es das ab Delphi 2006. Intern wird das 1:1 auf die entsprechenden Konstanten gemappt und an DrawText übergeben. Auch Canvas.TextRect kennt ein entsprechendes Flag. Aber das sind eben alles nur für die Ausgabe vorhandene Funktionen.

Danke für die Info. Hab EllipsisPosition gefunden beim TLabel in TurboDelphi. In Lazarus scheint's das nicht zu geben. In Delphi scheinbar nur im TLabel?

Zitat:

Zitat von jaenicke (Beitrag 1133090)

Zitat:

Zitat von Guido Eisenbeis (Beitrag 1133088)

... für DrawText wird ein hdc benötigt, was nicht bei allen in Frage kommenden Controls der Fall ist.

Bei welchen denn? Nicht bei allen kommst du direkt heran, aber eigentlich haben alle einen Device Context.

Ok, ich sitze jetzt schon über eine halbe Stunde nur daran, ein blöden Text mit DrawText auf ein Panel zu bekommen. (Habs auch mit Form1 versucht.) Ich habe bestimmt 1 Mio. Codes von MSDN bis Was-weiß-ich-was-WebSites und Foren (auch hier) probiert und bin am verzweifen! Ich krieg ums Verrecken keinen Text mit Panel zu sehen!! Das kenn ich von "damals", als ich noch mit VB (Classic) programmierte. Und genau aus diesem Grund wollte ich DrawTest nicht haben. Das nervt einfach nur.

Es folgt ein Beispiel-Code, den ich ausprobiert habe. Bitte zeig mir doch den Fehler, oder einen funktionierenden Code. :wall: Und glaub mir, ich hab zig verschieden Kombinationen der Paramter und Funktionen probiert!

Delphi-Quellcode:

procedure TForm1.FormResize(Sender: TObject);
var
  Txt: String;
  h: HDC;
  Rct: TRect;
begin
  Txt := 'Dies ist ein Beispiel-Text.';
  //h := GetDC(Panel1.Handle);
  //h := GetWindowDC(Panel1.Handle);
  GetWindowRect(Panel1.Handle, Rct);

  DrawText(Panel1.Canvas.Handle, PChar(Txt), Length(Txt), Rct,
    DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS);
end;

Guido.

[stahli]

Das wird so nix werden.
Wenn sich das Panel dann zeichnet übermalt es seinen Canvas ja wieder.
Du musst also ein eigenen Panel ableiten und die Paint-Methode mit override überschreiben.
Dazu kannst Du alles machen wie das originale Panel (Fläche füllen, Rahmen zeichnen etc.) und nur die Textausgabe an Deine Zwecke anpassen.

[Guido Eisenbeis]

Vielen Dank Stahli! :-D

Das hat mir jetzt eine riesen Stein von der Seele purzeln lassen. :thumb: Ich dachte schon, ich wär zu blöd, um ein "Hallo Welt" in ein Panel zu bekommen.

Zitat:

Zitat von stahli (Beitrag 1133327)

Das wird so nix werden.
Wenn sich das Panel dann zeichnet übermalt es seinen Canvas ja wieder.
Du musst also ein eigenen Panel ableiten und die Paint-Methode mit override überschreiben.
Dazu kannst Du alles machen wie das originale Panel (Fläche füllen, Rahmen zeichnen etc.) und nur die Textausgabe an Deine Zwecke anpassen.

Von Anfang an hatte ich das Gefühl, dass das so läuft. Aus Urzeiten hatte ich diese Probleme noch im Hinterkopf und mein Gefühl hat mich nicht getrogen. Siehe hier:

Zitat:

Zitat von Guido Eisenbeis (Beitrag 1133088)

DrawText will ich nicht. :P

Und deshalb habe ich auch auf einem String als Resultat bestanden, der problemlos weiterverarbeitet werden kann. DrawText ist also hinfällig, denn es sollen ja verschiedene Controls übergeben werden können, ohne jedes einzelne auf seinen Typ zu prüfen. Dementsprechend ist es vom Aufwand her ja unsinnig, was-weiß-ich-wieviele Controls abzuleiten und Methoden zu überschreiben.

Vielen Dank für diese Info André!

Guido.

[himitsu]

Ist dir schonmal aufgefallen, daß TCanvas.TextRect für den Text einen Var-Parameter nutzt?

Tipp:

tfModifyString, tfEndEllipsis oder tfPathEllipsis und tfCalcRect > TTextFormat

oder DT_MODIFYSTRING, DT_END_ELLIPSIS oder DT_PATH_ELLIPSIS und DT_CALCRECT > DrawTextEx

Delphi-Quellcode:

Text := DeinText;
Rect.Left := 1;
Rect.Top := 1;
Rect.Right := MaximaleBreite;
Rect.Bottom := MaximaleHöhe;
DrawTextEx(Handle, PChar(Text), Length(Text), Rect, ... or DT_END_ELLIPSIS or DT_MODIFYSTRING, nil);
SetLength(Text, StrLen(PChar(Text)));

siehe MSDN: DT_CALCRECT > but does not draw the text

[Luckie]

Geht doch:

Delphi-Quellcode:

procedure TForm1.FormPaint(Sender: TObject);
var
  Txt: String;
  Rct: TRect;
begin
  Txt := 'Dies ist ein Beispiel-Text.';
  GetWindowRect(Self.Handle, Rct);
  DrawText(Self.Canvas.Handle, PChar(Txt), Length(Txt), Rct, DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS);
end;

Mein Panel (D7) hat übrigens kein Canvas.

[DeddyH]

Zitat:

Zitat von Luckie (Beitrag 1133530)

Mein Panel (D7) hat übrigens kein Canvas.

Wetten, dass doch? Allerdings ist das protected, Du brauchst also eine Cracker-Klasse, um da ranzukommen.

[Bummi]

das kennst Du schon, oder?

Delphi-Quellcode:

type
  TPanel = Class(ExtCtrls.TPanel)
    Public Property Canvas;
  End;
  TForm1 = class(TForm)
    Panel1: TPanel;
    procedure Panel1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Panel1Click(Sender: TObject);
begin
  Panel1.Canvas.Rectangle(1,1,100,100);
end;

[Luckie]

Ja, natürlich hat es einen. Aber ich meinte ein Canvas dem man so nutzen kann.

[JamesTKirk]

Zitat:

Zitat von himitsu (Beitrag 1133527)

Ist dir schonmal aufgefallen, daß TCanvas.TextRect für den Text einen Var-Parameter nutzt?

Tipp:

tfModifyString, tfEndEllipsis oder tfPathEllipsis und tfCalcRect > TTextFormat

Zitat aus dem TCanvas der LCL:

Delphi-Quellcode:

procedure TextRect(const ARect: TRect; X, Y: integer; const Text: string);
procedure TextRect(ARect: TRect; X, Y: integer; const Text: string;
                    const Style: TTextStyle); virtual;

Diese unterstützt das nicht.

Gruß,
Sven

[himitsu]

Ich dachte die Lazarusleute hätten am Anfang erstmal alles kopiert? :stupid:

Wollte schon Fragen, wie TTextStyle dort aussieht, aber das hat sich grade erledigt.
Da hat man sich mit einem IMHO etwas umständlichen Record begnügt. (Das SET wurde wohl erst später erfunden?)
Wäre ja zu witzig gewesen, wenn dort tfModifyString und Co. mit enthalten wäre. :roll:




http://www.delphipraxis.net/164139-t...-ellipsis.html
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)

[Furtbichler]

Mein Delphi hat ein TControlCanvas. Das instantiiert man, verbindet es mit einem Control und -wupps- kann man auf dem Control zeichnen.

[Guido Eisenbeis]

Zitat:

Zitat von Furtbichler (Beitrag 1133552)

Mein Delphi hat ein TControlCanvas. Das instantiiert man, verbindet es mit einem Control und -wupps- kann man auf dem Control zeichnen.

Kannst du mir das Package umschreiben für Lazarus? :wink:

Ansonsten:

Was ist da nur so interessant an DrawText? Mein oben genannter 5-Zeiler erledigt das doch gut:

+ Anwendbar auf die Caption-Eigenschaft
+ gibt eine String zurück
+ evtl. Plattformunabhängig ???
- Abhängigkeit von Caption (bzw Text)
+ keine Abhängigkeit von Canvas
+ kein Publizieren des Canvas (für jede Control-Klasse!)
+ kein Überschreiben von Paint (für jede Control-Klasse!)

Zitat:

Zitat von Luckie (Beitrag 1133530)

Geht doch:

Delphi-Quellcode:

procedure TForm1.FormPaint(Sender: TObject);
var
  Txt: String;
  Rct: TRect;
begin
  Txt := 'Dies ist ein Beispiel-Text.';
  GetWindowRect(Form1.Handle, Rct);
  DrawText(Form1.Canvas.Handle, PChar(Txt), Length(Txt), Rct, DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS);
end;

Bei mir nicht. :( Ist nichts zu sehen weder in Delphi, noch in Lazarus. Liegt an den von Stahli genannten Gründen, denke ich.


Guido.

[Luckie]

Zitat:

Zitat von Guido Eisenbeis (Beitrag 1133583)

Zitat:

Zitat von Luckie (Beitrag 1133530)

Geht doch:

Delphi-Quellcode:

procedure TForm1.FormPaint(Sender: TObject);
var
  Txt: String;
  Rct: TRect;
begin
  Txt := 'Dies ist ein Beispiel-Text.';
  GetWindowRect(Form1.Handle, Rct);
  DrawText(Form1.Canvas.Handle, PChar(Txt), Length(Txt), Rct, DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS);
end;

Bei mir nicht. :( Ist nichts zu sehen weder in Delphi, noch in Lazarus. Liegt an den von Stahli genannten Gründen, denke ich.

Guck mal genau hin. Ich gebe den Text nicht auf einem Panel aus, sondern auf der Form selber, wo du aber auch gesagt hast, das würde nicht funktionieren.

[DeddyH]

[Stimme aus dem Off] Naja, das "Form1" ist aber nicht so geschickt, self wäre wohl besser ;) [/Stimme aus dem Off]

[Luckie]

Stimmt. Geändert.

[himitsu]

Sobald man etwas Systemspezifisches macht, ist es nicht mehr plattformunabhängig.

Hier wird ja eine WinAPI direkt verwendet, welche irgendein HDC (bei Microsofts das Handle für einen Device Context) haben will und dann entweder den Text zeichnet und/oder berechnet.
Wie man sieht, ginge das auch ohne ein Canvas, aber bei den Beispielkomponenten kommt man an dieses Handle nunmal über das Canvas sehr leicht dran.
Ein Canvas ist ja auch nur eine Schnittstelle, welche den Zugriff auf den HDC und damit zusammenhängene Befehle vereint/vereinfacht.

GetDC(Edit.Handle) und schon hat man aus den Window-Handle ein DC-Handle gemacht, welches man direkt nutzen,
oder über ein Canvas verwenden könnte.
das erwähnte TControlCanvas ist auch nur ein TCanvas, welches das GetDC noch mit eingebaut hat.



So, nochmal zum plattformunabhängig.
Jetzt mußt du nur noch Schnittstellen/APIs für die anderen OS suchen und könntest das in einer Komponente verpacken, bzw. mehreren Komponenten mit der selben Schnittstelle.

Vorteil: plattformunabhängig
Nachteil: da es schwer sein wird, überall etwas mit genau dem selben Funktionsumfang zu finden, wird diese unabhängige Komonente nur noch das beinhalten dürfen, was überall möglich ist ... sie wird also nur noch einen "kleinen" Teil dessen bieten, was eigentlich möglich wäre, denn sonst wäre es nicht mehr unabhängig.

Oder man "emuliert" einige der fehlenden Funktionen, auf den jeweils anderen Systemen => eventuell aufwändiger/langsamer.



Also beschwer dich nicht über das arme TCanvas, denn eigentlich ist es ganz lieb/nützlich ... denn ich wette du willst nicht immer direkt mit WinAPI oder den APIs der anderen OS zu tun haben.
Das wäre teilweise sehr aufwändig ... das was diese Wrapper für dich schön handlich zusammengefaßt haben.

[Guido Eisenbeis]

Zitat:

Zitat von Luckie (Beitrag 1133584)

Guck mal genau hin. Ich gebe den Text nicht auf einem Panel aus, sondern auf der Form selber, wo du aber auch gesagt hast, das würde nicht funktionieren.

Warum sollte ich da nicht genau hingesehen haben? Ich habs sogar genau hier rauskopiert, zwei neue Projekte erstellt (1x Delphi, 1x Lazarus), ein Paint-Ereignis für Form1 erstellt und deinen Code hinein kopiert. Nix zu sehen.

Guido.

[jaenicke]

Bis Windows XP sollte das funktionieren. Und ab Vista sollte der Text zumindest am Anfang auch sichtbar sein.

Durch die neuen Grafiktechniken von Vista und Windows 7 kann es sein, dass die Ressourcenoptimierung da einen Strich durch die Rechnung macht. Denn da wird WM_PAINT schlicht nicht mehr so oft an das Fenster geschickt. Dass der Text durch das DT_VCENTER aber an anderer Stelle neu gezeichnet werden müsste, weiß Windows nicht. Deshalb kann es passieren, dass der Text nicht zu sehen ist.

Dieses neue Verhalten führt zwar zu einer teilweise deutlich flüssigeren Oberfläche unter insbesondere Windows 7 gegenüber XP, aber eben auch manchmal zu Problemen, wenn man nicht auch auf das Resizen reagiert.

Lösung zum Testen:
Ersetze DT_VCENTER durch DT_TOP und schiebe das Fenster ganz nach oben links auf den Bildschirm. ;-)

Der eigentliche Fehler ist nämlich, dass das Window-Rect sich auf Bildschirmkoordinaten bezieht, DrawText hingegen auf Fenster-Koordinaten. ;-)

[Guido Eisenbeis]

Danke für die ausführliche Beschreibung. Werd ich heute abend testen.

O.T. Wie kann ich denn den Thread-Titel ändern? Der Bearbeiten-Button ist nicht mehr da (Zeitlimit). Hab nämlich erst jetzt gesehen, dass ich "Punkten" ohne "n" geschrieben habe. Wenn's nicht geht, bleibt's so. :mrgreen:

Guido.

[jaenicke]

Zitat:

Zitat von Guido Eisenbeis (Beitrag 1133668)

O.T. Wie kann ich denn den Thread-Titel ändern? Der Bearbeiten-Button ist nicht mehr da (Zeitlimit). Hab nämlich erst jetzt gesehen, dass ich "Punkten" ohne "n" geschrieben habe. Wenn's nicht geht, bleibt's so. :mrgreen:

In diesem Forum kannst du den Thread dafür nur melden, damit es ein Moderator macht.

[Guido Eisenbeis]

Den Thread-Titel wurde schon von einem netter Moderator geändert! :-D Danke.

Zitat:

Zitat von jaenicke (Beitrag 1133627)

Lösung zum Testen:
Ersetze DT_VCENTER durch DT_TOP und schiebe das Fenster ganz nach oben links auf den Bildschirm. ;-)

Der eigentliche Fehler ist nämlich, dass das Window-Rect sich auf Bildschirmkoordinaten bezieht, DrawText hingegen auf Fenster-Koordinaten. ;-)

Das war's! :) Ich wundere mich nur, dass das Lucky nicht aufgefallen ist. Hast du (Lucky) deine Form ganz links oben platziert? Der Text müsste bei dir doch auch verschwinden, wenn die Form woanders ist, oder? :gruebel:

Somit sollte DrawText jetzt abgehandelt sein.


Mit DrawTextEx kann man eine Rückgabe als String erhalten. Siehe die letzte Variante, also die mit dem Handle (HDC), in Text kürzen (Ellipsis...) von himitsu.


----------------------------------- Nachtrag Anfang -----------------------------------

Habe gerade festgestellt, dass die Funktion von himitsu in Lazarus beim Kürzen von Umlauten ein "?" an der Stelle des Umlauts zeigt. Zum Testen habe ich den Code-Teil von himitsu hier als kompaktes Beispiel zusamengestellt.

Einfach ein TLabel (Label1) auf die Form setzen, AutoSize ausschalten, Label1 links und rechts bis knapp vor den Rand vergrößern. Dann ein FormCreate und ein FormResize erstellen und folgenden Code einfügen. Für ganz Bequeme häng ich ein Beispiel-Projekt an.

Wird die Form langsam verkleinert, bis gerade so das "ü" verschwindet, taucht an dessen Stelle ein "?" auf. Muss da irgendwas auf UniCode umgestellt, oder Lazarus neu kompiliert werden?

Delphi-Quellcode:

// "Classes" und "Windows" zu den uses hinzufügen.

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Label1.AutoSize muss zur Design-Zeit = False gestellt werden;

  Label1.Anchors := [akLeft, akRight, akTop];
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 := 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)));
end;

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

------------------------------------- Nachtrag Ende -------------------------------------


Meine Variante "SetShortenedTextWithDots" folgt alsbald. :-D . . . Nachtrag: Das Umlautproblem tritt hier auch auf.

Guido.


Edit: Nachtrag und Beispiel-Projekt hinzugefügt.

[jaenicke]

Das Problem mit dem Umlauten liegt jedenfalls an Lazarus, mit Delphi geht es problemlos. Da musst du wohl schauen was da intern passiert...

[himitsu]

Also entweder 'nen WideString (gibt's den auch in Lazarus? ) und DrawTextExW verwenden, oder DrawTextExA mit AnsiString.

DrawTextExA könnte man zwar auch auf einen UTF-8-String loslassen, aber da könnte es passieren, daß er die Umlaute zerlegt, wenn er mitten drin die "..." einfügen will.

Eine UTF-8-Variante wird es von DrawTextEx wohl nicht geben? (Von Windows nicht, es sei denn man stellt UTF-8 als DefaultCodepage ein oder Lazarus konvertiert es nach Unicode)

[Guido Eisenbeis]

Zitat:

Zitat von jaenicke (Beitrag 1133994)

Das Problem mit dem Umlauten liegt jedenfalls an Lazarus, mit Delphi geht es problemlos.

Klar, hab ich ja auch geschrieben: "... die Funktion von himitsu in Lazarus ..." . :wink: . Dennoch danke für die Bestätigung. :-D

Zitat:

Zitat von himitsu (Beitrag 1134025)

... Eine UTF-8-Variante wird es von DrawTextEx wohl nicht geben? (Von Windows nicht, es sei denn man stellt UTF-8 als DefaultCodepage ein oder Lazarus konvertiert es nach Unicode) ...

Ich hab jetzt einige Variationen mit WideString, Unicodestring, UTF8..., usw. probiert, hat sich aber nichts getan. Ich vermute auch viel eher, dass da in der IDE selbst eine Schalter ist, um das einzustellen. Ich hab schon einiges durchsucht (und probiert), aber das ist die sprichwörtliche "Naddel" im Heuhaufen. Wenn da ein Lazarus-Fachmann mitliest, wird er das wahrscheinlich als Kleinigkeit ansehen!?

Auf jeden Fall wird z. B. das "ü" intern ("Lokale Variablen"-Fenster) als "#195#188" angezeigt. Wird nun um ein Zeichen gekürzt, steht da noch "#195". Es wird also intern das "halbe ü" weggenommen, was im String als "?" dargestellt wird.

Guido.


Nachtrag:

OK, hab jetzt Folgedes herausgefunden:

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;

Kann das jemand testen?

Guido.

[Guido Eisenbeis]

Hier nun meine Variante. :-D

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. :-D Falls Fehler drin sind, dürft ihr mir das auch sagen. :mrgreen:

Guido.


Edit: Source-Codes zum Testen hinzugefügt.