Как показать Hint для частично видимых элементов ListBox

procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
const
  oldidx : Longint = -1;
var
  idx : Longint;
begin
  with Sender as TListBox do begin
    idx := ItemAtPos(Point(x,y),True);
    if (idx < 0) or (idx = oldidx) then Exit;
    Application.ProcessMessages; 
    Application.CancelHint;
    oldidx := idx;
    Hint := '';
    if Canvas.TextWidth(Items[idx]) > Width - 4 then Hint:=Items[idx];
  end;
end;

procedure TfmDWMain.lbSearchMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  ItemNum: Integer;
begin
  ItemNum := lbSearch.ItemAtPos(Point(X, Y), True);
  if (ItemNum <> HintRow) then
  begin
    HintRow := ItemNum;
    Application.CancelHint;
    if HintRow > -1 then
    begin
      HintString := lbSearch.Items[ItemNum];
      if (lbSearch.Canvas.TextWidth(HintString) <= lbSearch.ClientWidth - 25) then
        HintString := '';
    end
    else
      HintString := '';
  end;
end;

procedure TfmDWMain.OnShowHint(var HintStr: string;
  var CanShow: Boolean; var HintInfo: THintInfo);
begin
  if not (HintInfo.HintControl is TListBox) then Exit;
  with HintInfo.HintControl as TListBox do begin
    HintInfo.HintPos := lbSearch.ClientToScreen(Point(21,
      lbSearch.ItemRect(HintRow).Top + 1));
    HintStr := HintString;
  end;
end;