String mit ... abkürzen

[Yheeky]

Hi,

ich möchte gerne einen String, wenn er eine gewisse Textbreite überschreitet, mit ... abkürzen. Wie kann ich das machen? Wenn ich mich nicht täusche gibt es dafür sogar eine Funktion, hab das aber leider nicht mehr richtig in Erinnerung.

Wäre gut, wenn mir jemand helfen könne.

Gruß Yheeky

[RomanK]

Die länge des Strings kannst du mit Length rausbekommen
und dann bis zu einer bestimmten Stelle kannst du den String ja mit Copy kopieren
-> Siehe Hilfe!!!!! zu Copy

[Luckie]

Oder mit DrawText:

Zitat:

DT_END_ELLIPSIS For displayed text, if the end of a string does not fit in the rectangle, it is truncated and ellipses are added. If a word that is not at the end of the string goes beyond the limits of the rectangle, it is truncated without ellipses.
The string is not modified unless the DT_MODIFYSTRING flag is specified.

Compare with DT_PATH_ELLIPSIS and DT_WORD_ELLIPSIS.

[Alfons_G]

:hi:
Genau richtig, Luckie - so bekommt man das Original-Ergebnis, wie bei MS-Anwendungen.
Für alle, die Angst vor dem bösen API haben :lol: gibt es auch zahlose Komponenten, die diese Funktion bieten - bei Torry oder VCL-Components mal mit dem Stichwort ellipsis suchen. Ich halte es aber nicht für sinnvoll, nur für diese Funktion extra eine Kompo zu installieren :roll:

:coder:

[Yheeky]

@FuckRacism: Soweit war ich auch schon von der Überlegung her, aber bei der Praxis hat sich da bei mir immer so ein komischer Fehler eingeschlichen. Ich probiere es aber nochmal.
@Luckie: Hätte mich auch gewundert, wenn du was gepostet hättest, was nichts mit API zu tun hat :wink: Ne quatsch...werde auch das mal testen.
@Alfons_G: Yo, eine eigene Komponente für das finde ich auch zu überzogen. Aber da muss ja drin stehen wie´s geht, deswegen wäre auch das ganz nützlich.

Danke für eure Tipps.

Gruß Yheeky

[Luckie]

Hier mal eine Unit die zu lange Pfadangebn verkürzt. Könnte man auch mir DrawText machen.

[Nuclear-Ping]

Hab auch grad das Problem. Allerdings funktioniert das mit DrawText nicht so recht ... :gruebel:

Ich habe einen langen Text, der in ein TRect gezeichnet werden soll. Funktioniert auch. Nur will ich den Text, der über die Grenzen des Rect geht, mit "..." abschneiden.

Hier hab ich ein Beispiel gefunden: http://vbnet.mvps.org/index.html?cod...strellipse.htm
Da macht er es so, dass er DrawText mit DT_CALCRECT or DT_MODIFYSTRING or DT_PATH_ELLIPSIS (oder DT_END_ELLIPSIS) aufruft, was scheinbar den modifizierten Text in die Variable zurückpackt. Funktioniert hier aber nicht ...

Delphi-Quellcode:

var
  colStr: PChar;
  Rect: TRect;
  x, y: Integer;
begin
  x := Item.Left - 4;
  y := Item.Top;
  for a := 0 to SubItem - 1 do
    x := x + FListView.Columns[a].Width;

  Rect.Left := x + 2;
  Rect.Top := y + 2;
  Rect.Bottom := y + FListView.SmallImages.Height - 2;
  Rect.Right := x + FListView.Columns[SubItem].Width - 2;

  GetMem (colStr, Length (Item.SubItems[SubItem - 1]));
  try
    StrPCopy (colStr, Item.SubItems[SubItem - 1]);
    DrawText (FListView.Canvas.Handle, colStr, Length (colStr),
              Rect, DT_CALCRECT or
                    DT_WORDBREAK or
                    DT_MODIFYSTRING or
                    DT_WORD_ELLIPSIS or
                    DT_NOPREFIX);
    DrawText (FListView.Canvas.Handle, colStr, Length (colStr),
              Rect, DT_WORDBREAK or
                    DT_NOPREFIX);
  finally
    FreeMem (colStr);
  end;
end;

colStr bleibt unverändert, auch wenn ich nur DrawText 1x aufrufe ohne DT_CALCRECT. Was mach ich falsch?

[stahli]

Ich hab´s mir selbst so gebastelt:

Delphi-Quellcode:

function TVCustom.PaintCanvas: TCanvas; // damit´s auch mit den AlphaSkins funktioniert
begin
  if SkinData.Skinned then
    Result := SkinData.FCacheBMP.Canvas
  else
    Result := Canvas;
end;

procedure TVCustom.WriteValue(X, Y: Integer; S: String; TextColor: TColor = clWindowText);
var Rect:  TRect;
    H, P: String;
    Flags: Longint;
begin
  if not (csDesigning in ComponentState) then
  begin
    if not (csDestroying in ComponentState) then
    begin
      with PaintCanvas do begin
        Font.Color := TextColor;
        Inc(X, 3);
        Brush.Style := bsClear;
        Rect := ClipRect;
{
... freien Bereich evtl. eingrenzen
        if CheckBoxVisible then Rect.Left := Rect.Left + CheckBoxData.Width;
        if ImageVisible then Rect.Right := Rect.Right - ImageData.Width;
}
        Rect.Left := Rect.Left + X;
        Rect.Top := Rect.Top + Y;
        H := S;
        P := '';
// hier wird die Länge ermittelt...
        while (TextWidth(S + P) >= Rect.Right - Rect.Left) and (S <> '') do
        begin
          Delete(S, Length(S), 1);
// ... evtl. mit 3 Punkten ersetzt
          if P = '' then P := '...';
        end;
        S := S + P;
        Flags := 0;
        DrawText(Handle, PChar(S), -1, Rect, Flags);
// ... und wenn der Platz nicht reicht, der Text im Hint angegeben
        if P <> '' then
        begin
          ShowHint := True;
          Hint := H;
        end
        else begin
          ShowHint := False;
          Hint := '';
        end;
      end;
    end;
  end;
end;

[Nuclear-Ping]

TextWidth berücksichtigt aber keine Zeilenumbrüche oder?

Habs aber glaube gleich. Wenn ich einen Breakpoint auf DrawText setze, kürzt er den String zwar, aber das Rect der Zelle ist irgendwie visuell viel kleiner, als da wo er kürzt ...
*weiterbastel* :coder2:

[edit]
Versteh das nicht ...

- Ohne DT_CALCRECT kürzt er mir den String zwar, aber viel zu spät.

- Mit DT_CALCRECT kürzt er mir den String nicht.
Was laut MSDN auch soweit Sinn macht:

Zitat:

If there are multiple lines of text, DrawText [...] extends the base of the rectangle to bound the last line of text [...]

Aber warum funktioniert das dann aber in dem Beispiel? Wahrsch. weil er nur eine Zeile hat?

- Die Maße des TRect passen. soweit ich das beurteilen kann. FListView.Canvas.DrawFocusRect(Rect) zeichnet genau um die Zelle das FocusRect.

- Also nochmal: Was mache ich falsch?
[/edit]

[nochmal edit]
Danke stahli, jetzt hats klick gemacht. ;)

Hab's jetzt auch so ähnlich gelöst.

Delphi-Quellcode:

//
          // Prüfen, ob Text ins Rect passt
          TextRect := Rect;
          colStr := PChar (Item.SubItems[SubItem - 1]);
          TruncateText := FALSE;
          repeat
            h := DrawText (FListView.Canvas.Handle, PChar (colStr), Length (colStr),
                           TextRect, DT_CALCRECT or
                                 DT_WORDBREAK or
                                 DT_NOPREFIX);
            if h > Rect.Bottom - Rect.Top then
              begin
                Delete (colStr, Length (colStr), 1);
                TruncateText := TRUE;
              end
            else break;
          until FALSE;

          // Wenn Text abgeschnitten wurde, letztes Wort finden und ... anhängen
          if TruncateText then
            begin
              Delete (colStr, Length (colStr) - 3, 4);
              h := 0;
              for a := Length (colStr) downto 1 do
                if (colStr[a] = ' ') then
                  break
                else inc (h);
              Delete (colStr, Length (colStr) - h, h + 1);
              if Length (colStr) > 0 then
                colStr := colStr + ' ...';
            end;

          DrawText (FListView.Canvas.Handle, PChar (colStr), Length (colStr),
                    Rect, DT_WORDBREAK or
                          DT_NOPREFIX);

Ist aber sicher in nem OnDraw-Event nicht das Performantest, aber erstmal 'ne Notlösung.

Würde mich trotzdem noch interessieren, warum das mit dem DrawText und DT_XYZ_ELLIPSIS nicht geklappt hat. :gruebel:
[/nochmal edit]

[marabu]

Hallo Mario,

wahrscheinlich verstehe ich dein Problem nicht, aber genügt nicht auch weniger Code?

Delphi-Quellcode:

 
procedure TDemoForm.ButtonClick(Sender: TObject);
var
  s: string;
  r: TRect;
begin
  s := DupeString('Der Affe den Sie meinen heißt Parmesan ', 5);
  r := Rect(20, 60, 180, 110);
  DrawText(Canvas.Handle, PChar(s), Length(s), r, DT_END_ELLIPSIS or DT_WORDBREAK);
end;

Freundliche Grüße

[Nuclear-Ping]

Hallo marabu,

ich denke du hast den Code getestet, sonst würdest du ihn sicher nicht hier reinstellen. Wahrscheinlich funktioniert er auch bei dir so, wie er soll. ;)

Aber wie oben im 1. Edit angemerkt, kürzt er mir den String zwar auch, allerdings viel zu weit hinten, obwohl das Rect genau passt, wenn ich es mir mit FListView.Canvas.DrawFocusRect (Rect) anzeigen lasse. :gruebel:

[marabu]

Kannst du mein Beispiel (Text und Rect) so anpassen, dass ich dein Problem erkenne?

[Rakshasa]

Wäre MinimizeName() nicht eine Alternative?

[marabu]

Eher nein - MinimizeName() arbeitet auf (einzeiligen) Pfadnamen. Ich glaube, hier geht es allgemein um Texte.

[Nuclear-Ping]

Zitat:

Zitat von marabu

Kannst du mein Beispiel (Text und Rect) so anpassen, dass ich dein Problem erkenne?

Hi marabu,

erstelle dir ein neues Projekt. Auf die Form packst du eine TListView und eine TImageList. Die ImageList setzt du auf Width 2 und Height 100. Den TListView auf vsReport, zwei Spalten. Spalte 1 Breite 32, Spalte 2 100. Die ImageList weißt du der SmallImages-Property der ListView zu.

Delphi-Quellcode:

unit LView_DrawText_TestU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, ComCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    ImageList1: TImageList;
    procedure ListView1CustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure ListView1CustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      var DefaultDraw: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    TestStr: String; 
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

uses
  StrUtils;

{$R *.dfm}

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  //
end;

procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  var DefaultDraw: Boolean);
var
  Rect: TRect;
  a, w: Integer;
begin
  DefaultDraw := FALSE;

  w := 0;
  for a := 0 to SubItem - 1 do
    w := w + ListView1.Columns[a].Width;

  Rect.Left := (Item.Left - 4 + w) + 2;
  Rect.Top  := Item.Top + 2;
  Rect.Right := Rect.Left + ListView1.Columns[SubItem].Width - 2;
  Rect.Bottom := Item.Top + ListView1.SmallImages.Height - 2;

  ListView1.Font.Style := [];

//  ListView1.Canvas.DrawFocusRect(Rect);
  case SubItem of
    1: begin
         ListView1.Canvas.FillRect (Rect);
         DrawText (ListView1.Canvas.Handle, PChar (TestStr), Length (TestStr),
                   Rect, DT_WORDBREAK or
                         DT_NOPREFIX or
                         DT_WORD_ELLIPSIS);
       end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  li: TListItem;
  a: Integer;
begin
  TestStr := DupeString('Der Affe den Sie meinen heißt Parmesan ', 5);
  for a := 1 to 10 do
    begin
      li := ListView1.Items.Add;  // Leak erstmal egal
      li.Caption := inttostr (a);
    end;
end;

end.

In dem Beispiel funktioniert DT_WORD_ELLIPSIS nicht. Er schneidet den Text nicht ab.
DT_END_ELLIPSIS hat hier allerdings funktioniert. Aber im richtigen Projekt gabs da auch Probleme.

[marabu]

Hallo,

was soll ich dazu noch schreiben? DT_WORD_ELLIPSIS ist nicht das, was du willst, verhält sich aber aus meiner Sicht erwartungsgemäß. DT_END_ELLIPSIS entspricht genau deinen Wünschen, aber der von dir früher beobachtete Fehler lässt sich mit deinem Beispiel nicht reproduzieren. Ich betrachte dieses Problem solange als gelöst, bis du eine Reproduktionsmöglichkeit gefunden hast und den Thread wieder aufnimmst.

Freundliche Grüße

[Nuclear-Ping]

Laut MSDN ist DT_WORDELLIPSIS schon das, was ich will, vorrausgesetzt ich verstehe das richtig: "Truncates any word that does not fit in the rectangle and adds ellipses." -> Er schneidet das ganze Wort weg, was nicht in das Rect passt und fügt "..." an. Und das funktioniert in dem Beispiel nicht erwartungsgemäß.

DT_END_ELLIPSIS schneidet dahingegen einfach ab, egal ob mitten im Wort oder nicht und hängt die "..." an. Und das ist nicht das, was ich will.

[marabu]

Hallo Mario,

vielleicht muss ich doch etwas mehr schreiben. Betrachten wir zwei Beispieltexte:

Delphi-Quellcode:

Text1 := 'Gallia est omnis divisa in partes tres, '
       + 'quarum unam incolunt Belgae, aliam Aquitani, '
       + 'tertiam qui ipsorum lingua Celtae, nostra Galli appellantur.';
Text2 := 'Alles hat ein Ende'#13#10'nur die Wurst hat zwei';

Man beachte: Text2 enthält einen harten Zeilenumbruch. Ich brauche diese zwei Texte, denn DT_WORD_ELLIPSIS betrachtet Zeilenenden, DT_END_ELLIPSIS betrachtet das Textende. Ich habe dein Beispielprogramm leicht verändert, so dass alle mir wichtigen Szenarien behandelt werden.

Item 1 und 2 (DT_WORD_ELLIPSIS)
Jede Zeile erhält eine Ellipsis.

Item 3 und 4 (DT_WORD_ELLIPSIS or DT_WORDBREAK)
Durch den weichen Zeilenumbruch entfällt eine Ellipsis am physischen Zeilenende.

Item 5 und 6 (DT_END_ELLIPSIS)
Eine Ellipsis gibt es nur am Textende, nicht am Zeilenende.

Item 7 und 8 (DT_END_ELLIPSIS or DT_WORDBREAK)
Eine Ellipsis am Textende wird auch durch einen automatischen Umbruch nicht verhindert.

So lieber Mario, nun musst du dich entscheiden...

Freundliche Grüße

[DeddyH]

[OT] "De Bello Gallico" von Gaius Julius Caesar... ich bin einigermaßen angemessen beeindruckt :shock: :thumb: [/OT]

[turboPASCAL]

[OT] Sapienti sat. :mrgreen: [/OT]

[Nuclear-Ping]

Hallo marabu,

danke für die Veranschaulichung. Hat nun Klick gemacht.

Errare humanum est ... in errore perseverare stultum! ;)

Grüße