A если все ручками сделать то как-то так получится... 
	Код:
	Function WordWrapTextToCanvas(aCanvas:TCanvas; aText:String; X,Y,RigthBord:Integer; LS:Real):boolean;
var
  i,W,W1,Spc,XX:Integer;
  S:String;
  aT:array of String;
begin
W:=aCanvas.TextWidth(aText);
Spc:=aCanvas.TextWidth(' ');
XX:=X;
W1:=0;
S:='';
aText:=aText+' ';
if W>RigthBord then
  begin
    for i:=1 to Length(aText) do
      begin
        if aText[i]<>' ' then
          S:=S+aText[i]
        else begin
          SetLength(aT,Length(aT)+1);
          aT[Length(aT)-1]:=S;
          S:='';
        end;
      end;
    for i:=0 to Length(aT)-1 do
      begin
        W1:=W1+aCanvas.TextWidth(aT[i]);
        if W1>RigthBord then
          begin
            Y:=Round(Y+(aCanvas.TextHeight(aT[i])*LS));
            X:=XX;
            W1:=0;
          end;
        aCanvas.textOut(X,Y,aT[i]);
        X:=X+Spc+aCanvas.TextWidth(aT[i]);
      end;
    Result:=true;
  end else aCanvas.TextWidth(aText);
end; 
 
Использовать так:
	Код:
	procedure TForm1.Button1Click(Sender: TObject);
var
  S: String;
  X,Y,L: Integer;
begin
Image1.Width:=583;
Image1.Canvas.Font.Size:=14;
X:=20;
L:=Image1.Width-60;
Y:=20;
S:='Это очень длинная строка, возможно самая длинная, которую когда либо писали в Delphi';
WordWrapTextToCanvas(Image1.Canvas,S,X,Y,L,1.1); //Отрисовка текста
end;
 
 
Параметры:
aCanvas = Канва на которую выносим текст
aText = Текст
X = Отступ от левой границы канвы
Y = Отступ от верхней границы канвы
RigthBord = Отступ от правой границы канвы
LS = Межстрочный интервал