Hin und wieder muß man einen Text[meta]String[/meta] auf einer Zeichenfläche[meta]Canvas, Zeichen-Flächen[/meta] ausgeben[meta]zeichnen, malen[/meta]. Was nicht paßt, weil der Text vielleicht zu lang ist, wird dann abgeschnitten[meta]abschneiden[/meta]. Etwas professioneller ist es den Text vorher so zu kürzen, daß er reinpasst. Klar, was zu lang ist ist zu lang, aber man kann den Text am Ende mit den drei Punkten "..." abkürzen. Ein Zeichen dafür, daß da etwas fehlt.
Ich hab hier zwei Tipps. Der eine betrachtet die Clipping Länge einer Cavas als Breitenangabe. Der Text passt dann in die Canvas. Bei der anderen Funktion kann man selbst die Länge angeben:
Variante 1: Canvas-Breite
Es werden zwei Parameter benötigt:
- Canvas, als Fläche auf dem der Text ausgegeben wird
- der Text
Rückgabe ist der gekürzter Text mit drei Punkten.
Delphi-Quelltext
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16:
| function TextCutA(Canvas: TCanvas; Text: String): String; var k: Integer; begin Result := Text; with Canvas, ClipRect do if TextWidth(Text) > (Right - Left) then begin for k := Length(Text) downto 1 do if TextWidth(Copy(Text, 1, k) + '...') > (Right - Left) then Continue else begin Result := Copy(Text, 1, k) + '...'; Exit; end; end; end; |
Beispiel:
Es wird auf der PaintBox (TPaintBox Komponente) ein Text ausgegeben:
Delphi-Quelltext
1: 2: 3: 4: 5: 6: 7: 8:
| procedure TForm1.Button1Click(Sender: TObject); begin with PaintBox1 do begin Canvas.FillRect(Canvas.ClipRect); Canvas.TextOut(0, 0, TextCutA(Canvas, 'Das ist ein mittellanger Beispieltext, der etwas länger sein könnte.')); end; end; |
Variante 2: mit Längenangabe
Es werden drei Parameter benötigt:
- Canvas, als Fläche auf der der Text ausgegeben wird
- die Längenangabe in Pixel
- der Text
Rückgabe ist der gekürzter Text mit drei Punkten.
Delphi-Quelltext
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16:
| function TextCutB(Canvas: TCanvas; Len: Word; Text: String): String; var k: Integer; begin Result := Text; with Canvas do if TextWidth(Text) > Len then begin for k := Length(Text) downto 1 do if TextWidth(Copy(Text, 1, k) + '...') > Len then Continue else begin Result := Copy(Text, 1, k) + '...'; Exit; end; end; end; |
Beispiel:
Es wird auf der PaintBox (TPaintBox Komponente) ein Text ausgegeben. Hier wird aber nicht die ganze Länge ausgenutzt, sondern nur 60 Pixel:
Delphi-Quelltext
1: 2: 3: 4: 5: 6: 7: 8:
| procedure TForm1.Button1Click(Sender: TObject); begin with PaintBox1 do begin Canvas.FillRect(Canvas.ClipRect); Canvas.TextOut(0, 0, TextCutB(Canvas, 60, 'Das ist ein mittellanger Beispieltext, der etwas länger sein könnte.')); end; end; |
Moderiert von Christian S.: Meta-Tags und - Wörter eingefügt