Не помещается текст в ListBox

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Timer1: TTimer;
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
    RectT: TRect;
    ScrollDelay: integer;
    ScrollPos: integer;
    txtbmap: TBitmap;
    lbCanvas: TCanvas;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  txtbmap := TBitmap.Create;
  Timer1.Interval := 100;
  ListBox1.Style := lbOwnerDrawFixed; // Отрисовка пользователем
  ScrollDelay := 10;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  txtbmap.Free;
end;
 
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  txtw: integer;
begin
  RectT := Rect;
  ScrollPos := 0;
  with (Control as TListBox) do begin
//    if odSelected in State then // Поменял цвет выделенного - синий слишком тёмный
//      Canvas.Brush.Color := rgb(160, 160, 224);
    Canvas.FillRect(Rect); // Очистка строки
    Canvas.TextOut(Rect.Left, Rect.Top, Items.Strings[Index]); // Вывод текста
 
    // Подготовка промежуточного Bitmap.
    txtw := Canvas.TextWidth(Items.Strings[Index]);
    if txtw > (Rect.Right - Rect.Left) then txtbmap.Width  := txtw + 30
                                       else txtbmap.Width  := txtw;
    txtbmap.Height := Rect.Bottom - Rect.Top;
    txtbmap.Canvas.Brush.Color := Canvas.Brush.Color;
    txtbmap.Canvas.Pen.Color := Canvas.Pen.Color;
    txtbmap.Canvas.Font.Color := Canvas.Font.Color;
    txtbmap.Canvas.FillRect(Classes.Rect(0, 0, txtbmap.Width, txtbmap.Height));
    // На нём нарисовать всю строку для последующей прокрутки
    txtbmap.Canvas.TextOut(0, 0, Items.Strings[Index]);
    lbCanvas := Canvas; // Сохранить Canvas от ListBox, чтобы потом на нём рисовать
    // При создании потомка от TListBox этого не понадобится
  end;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  // Прокрутка текста по таймеру
  if Assigned(lbCanvas) then begin
    if ScrollPos > ScrollDelay then // Задержка прокрутки
      BitBlt(lbCanvas.Handle, RectT.Left - ScrollPos + ScrollDelay, RectT.Top,
             txtbmap.Width, RectT.Bottom, txtbmap.Canvas.Handle, 0, 0, srccopy);
    Inc(ScrollPos);
    if ScrollPos > txtbmap.Width - (RectT.Right - RectT.Left) then // Циклическая прокрутка
      ScrollPos := 0;
  end;
end;