Entwickler-Ecke

Sonstiges - ...Text so kürzen, daß er in eine Canvas-Breite passt?


Popov - Di 10.02.04 00:29
Titel: ...Text so kürzen, daß er in eine Canvas-Breite passt?
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:

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); // weiß löschen
    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:

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); // weiß löschen
    Canvas.TextOut(0, 0, TextCutB(Canvas, 60,
      'Das ist ein mittellanger Beispieltext, der etwas länger sein könnte.'));
  end;
end;


Moderiert von user profile iconChristian S.: Meta-Tags und - Wörter eingefügt


Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!