Вывод текста на bitmap

[АНАТОЛИЙ249]

Есть bitmap , нужно вывести текст по центру ,если текст не влазит уменьшить размер и вывести в 2 строки и тоже по центру обе строки.

Тут нашел вроде но работает не так маленько .

Не уменьшает текст для вывода в 2 строки,размер шрифта постоянный не меняется.

procedure DrawRectEx(const Canvas: TCanvas; const Rect: TRect;
Text: string);
var
i, oldWidth, Width: Integer;
PoleWidth, PoleWidth2: Integer;
l, t: Integer;
CharHeight: Integer;
s, NewS, TextSpace: string;
begin
i := 1;
s := '';

TextSpace := Text + ' '; // Пробел в коне для правильной работы
// цикла while

CharHeight := Canvas.TextHeight('V'); // Высота символов

oldWidth := 0;

PoleWidth := Rect.Left + Rect.Right; // Длина всего поля для рисования
PoleWidth2 := PoleWidth div 2; // Половина длины поля
t := Rect.Top; // Высота, на которой выводится строка

while PosEx(' ', TextSpace, i) <> 0 do
begin
NewS := Copy(TextSpace, i, PosEx(' ', TextSpace, i) - i + 1);

Width := Canvas.TextWidth(NewS);
if Width + oldWidth < PoleWidth then
begin
s := s + NewS;
Inc(oldWidth, Width);
end
else
begin
if oldWidth > 0 then
begin
// Рисование буфера и очистка его
l := PoleWidth2 - oldWidth div 2 + Rect.Left;
Canvas.TextOut(l, t, s);
s := NewS;
oldWidth := Width;
end
else
begin
// Рисуем одно слово
oldWidth := 0;
s := '';

l := PoleWidth2 - Width div 2 + Rect.Left;
Canvas.TextOut(l, t, NewS);
end;

Inc(t, CharHeight);
if t + CharHeight > Rect.Bottom then
begin
oldWidth := 0;
Break;
end;
end;

// Следующее слово
i := PosEx(' ', TextSpace, i) + 1;
end;

// Вывод остатков текста
if oldWidth > 0 then
begin
l := PoleWidth2 - oldWidth div 2 + Rect.Left;
Canvas.TextOut(l, t, s);
end;
end;

Спасибо.