1:
2:
3:
4:
5:
6:
7:
8:

while (not (ziel.canvas.textwidth(s)+bildoffset<=lexbitmap.width-17))
      and (pos(' ',s)<>0) do
begin
    rand:=length(s);
    rand2:=rand+1;
    while (s[rand]<>' ') and (rand>1) do dec(rand);
    if rand>1 then delete(s,rand,rand2-rand);
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:

unit Unit1;

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

interface

uses
{$IFNDEF FPC}
  Windows,
{$ELSE}
  LCLIntf, LCLType, LMessages,
{$ENDIF}
  Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    CheckBox1: TCheckBox;
    ScrollBar1: TScrollBar;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation
uses StrUtils;

{$IFNDEF FPC}
  {$R *.dfm}
{$ELSE}
  {$R *.lfm}
{$ENDIF}
const
  Vorlage1=
    'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ' +
    'ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo ' +
    'dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet.';
  Vorlage = Vorlage1+Vorlage1+Vorlage1+Vorlage1+Vorlage1+Vorlage1+Vorlage1+Vorlage1+
            Vorlage1+Vorlage1+Vorlage1+Vorlage1+Vorlage1+Vorlage1+Vorlage1+Vorlage1;

procedure TForm1.Button1Click(Sender: TObject);
const
  cTrenner = ' ';
  runden = 10;
var
  t1, t2: TDateTime;
  s,sZeile,sWort: string;
  leer, leerneu, MaxBreite,
  lineCnt,txtHeight,
  lenZeile,lenWort,lenTrenner: integer;
  j: integer;
  cB : boolean;

begin
  s:= Vorlage;
  T1 := time;
  txtHeight :=  Canvas.TextHeight('Xg')+1;
  lenTrenner := Canvas.TextWidth(cTrenner);
  MaxBreite:= ScrollBar1.Position;
  Canvas.FillRect(Rect(0,0, scrollBar1.Max+1, Form1.Height));
  //Wegen Lazarus ( unter wine 1.7), weil es aus 1.1 ms -> 7 ms macht :-(
  //was nichts mit der Programmperformance zu tuen haben sollte.
  cB := CheckBox1.Checked;
  IF cB then
    j := 0
  else
    j := runden-1;
For j := j downto 0 do
  begin
  leer:= 0;
  with Canvas do begin
    lineCnt:= 0;
    while (leer < length(s)) do begin                   // für jede Zeile
      sZeile := '';
      lenZeile := 0;
      repeat
        leerneu:= PosEx(' ', s, leer+1);                // naechstes leerzeichen
        if leerneu = 0 then                             // oder Ende wenn keins
          leerneu:= length(s);
        sWort :=Copy(s, leer+1, leerneu-leer-1);
        lenWort := TextWidth(sWort);
        if lenWort+lenZeile > MaxBreite then        // neu wäre zu lang
          break;
        leer:= leerneu;
        sZeile := sZeile+sWort+cTrenner;
        lenZeile:= lenZeile+lenWort+lenTrenner;
      until (leer >= length(s));
      // wenn ende erreicht, ausgeben
      // Zuviel angehaengtes Leerzeichen entfernen
      IF lenZeile > 0 then
        setlength(sZeile,length(sZeile)-length(cTrenner))
      else
        begin
        // -> wenigstens ein wort, also dahinter weitermachen
        sZeile := sWort;
        leer:= leerneu;
        end;
      IF cB then
        TextOut(0, lineCnt * TxtHeight, sZeile); // text ausgeben, neue zeile
      inc(lineCnt);
    end;
    // "Deko"
    MoveTo(MaxBreite, 0);
    LineTo(MaxBreite, Form1.Height);
  end;
end;
  T2 := time;
  IF CheckBox1.Checked then
    Caption:= Format('Breite %4d Zeilen: %d Zeit: %.3fms', [MaxBreite,lineCnt,(t2 - t1) * 86400*1000])
  else
    Caption:= Format('Breite %4d Zeilen: %d  :Ohne Ausgabe Zeit: %.3fms', [MaxBreite,lineCnt,(t2 - t1) * 86400*1000/runden]);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  s: string;
  leer, leerneu, MaxBreite, lineCnt,txtHeight: integer;
  t1, t2: TDateTime;
begin
  s:= Vorlage;
  T1 := Time;
  txtHeight :=  Canvas.TextHeight('Xg')+1;
  MaxBreite:= ScrollBar1.Position;

  with Canvas do begin
    // "Deko"
    FillRect(Rect(0,0, scrollbar1.max+1, Form1.height));
    MoveTo(MaxBreite, 0);
    LineTo(MaxBreite, Form1.height);
    lineCnt:= 0;
    while (s > '') do begin                                       // für jede Zeile
      leer:= 0;
      repeat
        leerneu:= PosEx(' ', s, leer + 1);                        // nächstes leerzeichen
        if leerneu = 0 then                                       // oder Ende wenn keins
          leerneu:= length(s);
        if TextWidth(Copy(s, 1, leerneu)) > MaxBreite then        // neu wäre zu lang
          break;
        leer:= leerneu;                                           // weiter ab da
      until (leer >= length(s));                                  // wenn ende erreicht, ausgeben

      if leer = 0 then                                            // schon das erste war zu lang?
        leer:= leerneu;                                           // -> wenigstens ein wort
      TextOut(0, lineCnt * txtHeight, Copy(s, 1, leer));                    // text ausgeben, löschen, neue zeile
      Delete(s, 1, leer);
      inc(lineCnt);
    end;
  end;
  T2 := Time;
  Caption:= Format('Breite %4d Zeilen: %d Zeit: %.3fms', [MaxBreite,lineCnt,(t2 - t1) * 86400*1000])
end;

end.                    

1:

maxzeichen:=2*(lexbitmap.width-bildoffset) div ziel.textwidth('ie');                    

1:
2:
3:

  with memo1 do
    Width := MaxBreite+Margins.Left+Margins.Right;
  memo1.Lines.add(Vorlage);