1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:

procedure gettextblock(line:integer; canvas:TCanvas; var drawrect:TRect; fontname:string;
  textheight:integer);
var
  r:TRect;
begin
  if (line>=0) and (line<textlist.Count) then 
  begin
    r:=drawrect;
    canvas.font.name:=fontname;
    Canvas.font.size:=textheight;
    //Drawrect ist hier mit der Breite, sowie der Left/Top-Koordinate initialisiert.
    //Die Höhe liegt bei 0
    DrawText(Canvas.Handle,PChar(textlist[line]),length(textlist[line]),r,
      dt_wordwrap or dt_left or dt_calcrect);
    //Hier sollte jetzt R berechnet sein, die Breite gleichgeblieben sein,
    //aber da TEXTLIST[Line] keine Zeilenumbrüche enthält, wird
    //offenbar (laut Debugger) auch die Zeilenbreite von R geändert.
    //Z.B. vorher: Left:354, Top: 354, Width: 6601; height:0
    //    nachher: Left:354, Top: 354, Width: 14000; height:21100
    drawrect:=r;
  end;
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:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Mask, JvExMask, JvSpin, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    TextEdit: TEdit;
    widthedit: TJvSpinEdit;
    heightedit: TJvSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    textheightedit: TJvSpinEdit;
    Label3: TLabel;
    procedure CommonEditChange(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  wordchars:set of char=['a'..'z','A'..'Z','0'..'9','$','_'];

function getwordlength(const t:string):integer;
var
  i:integer;
begin
  result:=0;
  for i := 1 to length(t) do
    if t[i] in wordchars then inc(result)
      else break;
end;

function getspacelength(const t:string):integer;
var
  i:integer;
begin
  result:=0;
  for i := 1 to length(t) do
    if t[i]=' ' then inc(result)
      else break;
end;

function CalculateTextinRect(canvas:TCanvas; var destrect:TRect; t:string):boolean;
var
  wordlen,wordwidth,i,x,y,w:integer;
  wd:string;
  textheight:integer;
begin
  result:=true;
  x:=destrect.left;
  y:=destrect.Top;
  w:=destrect.Right-destrect.Left;
  if length(t)>0 then begin
    textheight:=canvas.TextHeight(t[1]);
    while length(t)>0 do begin
      case t[1] of
        'a'..'z','A'..'Z','0'..'9','_':begin
          //Wort gefunden:
          wordlen:=getwordlength(t);
          wd:=copy(t,1,wordlen);
        end; {Zeichen eines Wortes}
        ' ':begin
          wordlen:=getspacelength(t);
          wd:=stringofchar(' ',wordlen);
        end; {Leerzeichen}
        else begin
          wordlen:=1;
          wd:=t[1];
        end; {else}
      end; {case}
      wordwidth:=canvas.TextWidth(wd);
      if x+wordwidth<=destrect.Right then begin
        //Word/Leerzeichen/Sonderzeichen passt vollständig hinein:
        canvas.TextOut(x,y,wd);
        inc(x,wordwidth);
        if x>=destrect.Right then begin
          inc(y,textheight);
          x:=destrect.Left;
        end; {if}
      end
        else begin
          //Wort passt nicht vollständig hinein:
          if wordwidth>w then begin
            if wordlen>1 then begin
              //Wenn das Wort selbst nicht hineinpasst, dann einen passenden
              //Teil vom Anfang abschneiden, aber in aktueller Zeile noch
              //damit beginnen:
              for i := wordlen-1 downto 1 do begin
                wordwidth:=canvas.TextWidth(copy(wd,1,i));
                if wordwidth+x<=destrect.right then begin
                  //Abschnitt passt jetzt rein:
                  wd:=copy(wd,1,i);
                  wordlen:=length(wd);
                  break;
                end; {if}
              end; {for}
              if i>0 then begin
                canvas.TextOut(x,y,wd);
                inc(x,wordwidth);
                if x>=destrect.right then begin
                  inc(y,textheight);
                  x:=destrect.Left;
                end; {if}
              end
                else begin
                  //Auch ein vorderer Abschnitt passt nicht an das Ende.
                  //Also nächste Zeile beginnen und es erneut versuchen:
                  if x>destrect.left then begin
                    inc(y,textheight);
                    x:=destrect.Left;
                    wordlen:=0;
                  end
                    else begin
                      result:=false;
                      exit; //Abfangen einer Endlosschleife, weil ein oder
                      //mehrere Zeichen zu Breit für den Bereich ist/sind
                    end;
                end; {else}
            end
              else begin
                result:=false;
                exit; //Ein Zeichen muss reinpassen, sonst Abbruch!
              end; {else}
          end
            else begin
              //Wort länger als der Platz in der aktuellen Zeile zulässt.
              //Daher in einer neuen Zeile beginnen:
              inc(y,textheight);
              x:=destrect.Left;
              canvas.TextOut(x,y,wd);
              inc(x,wordwidth);
              if x>=destrect.right then begin
                inc(y,textheight);
                x:=destrect.Left;
              end; {if}
            end; {else}
        end; {else}
      delete(t,1,wordlen);
    end; {while}
    //Wenn eine neu angefangene Zeile existiert, ohne dass was
    //reingeschrieben wurde, dann die letzte Zeile wieder löschen:
    if x=destrect.left then dec(y,textheight);
    destrect.Bottom:=y+textheight;
  end; {if}
end;

procedure TForm1.CommonEditChange(Sender: TObject);
var
  r:TRect;
  w,h,textheight:integer;
begin
  //Oberen Fensterinhalt leeren:
  canvas.Brush.Style:=bsSolid;
  canvas.Brush.Color:=clBtnFace;
  canvas.FillRect(clientrect);
  //Die %-Einstellungen der zwei SpinEdits auswerten und Rechteckbereich
  //bilden:
  w:=round(clientwidth*widthedit.value/100);
  h:=round((clientheight-Panel1.Height)*heightedit.Value/100);
  r:=bounds((clientwidth-w) div 2,(clientheight-Panel1.Height-h) div 2,w,h);
  //Rechteck (unten ist quasi durch die Texthöhe variabel) zeichnen:
  canvas.Pen.Color:=clRed;
  canvas.Brush.Style:=bsClear;
  canvas.Rectangle(r);
  //Texteinstellungen lesen:
  textheight:=round(textheightedit.value*h/100);
  canvas.Font.Color:=clMaroon;
  canvas.Font.Height:=textheight;
  //Textbegrenzungen ermitteln:
  (*
  if DrawText(canvas.Handle,PChar(TextEdit.Text),length(TextEdit.Text),r,
    dt_calcrect or dt_wordbreak or dt_left)>0 then
  begin
    canvas.Pen.Color:=clblack;
    canvas.DrawFocusRect(r);
    drawtext(canvas.Handle,pchar(Textedit.Text),length(textedit.Text),r,
      dt_wordbreak or dt_left);
  end
    else showmessage('Fehler: '+inttostr(getlasterror));
  *)
  CalculateTextInRect(canvas,r,textedit.Text);
  canvas.Pen.Color:=clblue;
  canvas.Rectangle(r);
end;

end.