Использование Hints

Code:

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.Top; // Запоминаем позицию строки по вертикали

     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.