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;