object MainForm: TMainForm
 Left = 7
   = 121
  Width = 200
  Height = 157
  Hint = '34534535'
  Caption = 'Long hints'
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  ShowHint = True
  OnCreate = FormCreate
  PixelsPerInch = 120
  TextHeight = 16
  object ListBox1: TListBox
  Left = 12
   = 12
  Width = 165
  Height = 97
  Hint = '1|2'
  ItemHeight = 16
  Items.Strings = (
  '1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ'
  'A1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ'
  '1234567890'
  'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
  'ABCD')
  ParentShowHint = False
  ShowHint = True
  TabOrder = 0
  OnMouseMove = ListBox1MouseMove
 end
end

unit Main;

interface

uses

 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

 StdCtrls;

type

 TMainForm = class(TForm)

  ListBox1: TListBox;

  procedure FormCreate(Sender: TObject);

  procedure ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

 private

  { Private declarations }

  FHintRow: Integer; // Номер строки в списке, на которую указывает мышь

 public

  { Public declarations }

  // Обработчик подсказок

  procedure OnShowHint(var HintStr: string;

  var CanShow: Boolean;

  var HintInfo: THintInfo);

 end;

var

 MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.FormCreate(Sender: TObject);

begin

 FHintRow := -1;

 Application.OnShowHint := OnShowHint; // Установка обработчика

end;

procedure TMainForm.OnShowHint(var HintStr: string;

 var CanShow: Boolean;

 var HintInfo: THintInfo);

var

 Pos: TPoint;

begin

 with HintInfo do

  if HintControl is TListBox then // Проверка на нужный объект

  with HintControl as TListBox do

  begin

  Pos.X := 0;

  Pos.Y := ListBox1.Tag;

  HintPos := ListBox1.ClientToScreen(Pos);

  HintStr := ListBox1.Hint;

  end;

end;

procedure TMainForm.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,

 Y: Integer);

var

 MousePos: TPoint;

 ItemPos: TRect;

 RowWidth,

  ItemNum: Integer;

 FHint: string;

begin

 MousePos.X := X;

 MousePos.Y := Y;

 ItemNum := ListBox1.ItemAtPos(MousePos, True);

  // Определение номера строки в списке

 if (ItemNum <> FHintRow) then // Проверка на перемещение мыши на другую строку

 begin

  FHintRow := ItemNum;

  if ItemNum <> -1 then // Проверка на наличие элементов в списке

  begin

  ItemPos := ListBox1.ItemRect(ItemNum);

  Application.CancelHint; // Снять текущую подсказку

  ListBox1.Tag := ItemPos.; // Запоминаем позицию строки по вертикали

  FHint := ListBox1.Items[ItemNum];

  // Проверка на ширину строки

  RowWidth := ListBox1.Canvas.TextWidth(FHint);

  if (RowWidth > ListBox1.ClientWidth) then

  FHint := FHint + '|'

  else

  FHint := '';

  ListBox1.Hint := FHint;

  end

  else

  begin

  ListBox1.Hint := '';

  Application.CancelHint;

  ListBox1.Tag := -1;

  end;

 end

end;

end.

program PrjHint;

uses

 Forms,

 Main in 'Main.pas' {MainForm};

{$R *.RES}

begin

 Application.Initialize;

 Application.CreateForm(TMainForm, MainForm);

 Application.ShowHint := True;

 Application.HintPause := 100;

 Application.HintHidePause := 999999;

 Application.Run;

end.