Use the (almost) omnipotent DrawText
function using an initial rectangle, and the flags DT_WORDBREAK
(meaning that the string should be word-wrapped) and DT_CALCRECT
:
procedure TForm1.FormPaint(Sender: TObject);
const
S = 'This is a sample text, I think, is it not?';
var
r: TRect;
begin
r := Rect(10, 10, 60, 60);
DrawText(Canvas.Handle,
PChar(S),
Length(S),
r,
DT_LEFT or DT_WORDBREAK or DT_CALCRECT);
DrawText(Canvas.Handle,
PChar(S),
Length(S),
r,
DT_LEFT or DT_WORDBREAK);
end;
Due to the flag DT_CALCRECT
, the first DrawText
will not draw anything, but only alter the height of r
so that it can contain the entire string S
(or reduce the width of r
if S
happens to fit on a single line; in addition, if S
contains a word that does not fit on a single line, the width of r
will be increased). Then you can do whatever you wish with r
, and then you can draw the string for real.
Try this, for example:
procedure TForm1.FormPaint(Sender: TObject);
const
S: array[0..3] of string = ('Hi! How are you?',
'I am fine, thanks. How are you? How are your kids?',
'Fine!',
'Glad to hear that!');
Colors: array[boolean] of TColor = (clMoneyGreen, clSkyBlue);
Aligns: array[boolean] of integer = (DT_RIGHT, DT_LEFT);
var
i, y, MaxWidth, RectWidth: integer;
r, r2: TRect;
begin
y := 10;
MaxWidth := ClientWidth div 2;
for i := low(S) to high(S) do
begin
Canvas.Brush.Color := Colors[Odd(i)];
r := Rect(10, y, MaxWidth, 16);
DrawText(Canvas.Handle,
PChar(S[i]),
Length(S[i]),
r,
Aligns[Odd(i)] or DT_WORDBREAK or DT_CALCRECT);
if not Odd(i) then
begin
RectWidth := r.Right - r.Left;
r.Right := ClientWidth - 10;
r.Left := r.Right - RectWidth;
end;
r2 := Rect(r.Left - 4, r.Top - 4, r.Right + 4, r.Bottom + 4);
Canvas.RoundRect(r2, 5, 5);
DrawText(Canvas.Handle,
PChar(S[i]),
Length(S[i]),
r,
Aligns[Odd(i)] or DT_WORDBREAK);
y := r.Bottom + 10;
end;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
Invalidate;
end;