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