Hints on a Listbox

How about this


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure DoShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.DoShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
var
  MyItemIndex: Integer;
  MyString: String;
  MySize: TSize;
  MyPos: TPoint;
begin
  with HintInfo do
  begin
    if HintControl = ListBox1 then
        begin
      CanShow := False;
          MyItemIndex := ListBox1.ItemAtPos(Point(CursorPos.X, CursorPos.Y), True);
              if MyItemIndex <> -1 then
              begin
                MyString := ListBox1.Items[MyItemIndex];
                GetTextExtentPoint32(ListBox1.Canvas.Handle, PChar(MyString), Length(MyString), MySize);
        MyPos := Point(-1, (MySize.cy * MyItemIndex - 3)); //-3 and -1 to make offset identical to text placement in window
                if MySize.cx > ListBox1.ClientWidth then
                begin
                  HintPos := ListBox1.ClientToScreen(MyPos);
          HintMaxWidth := MySize.cx + 1;
          CursorRect := Rect(MyPos.x, MyPos.y, MyPos.x + MySize.cx, MyPos.y + MySize.cy);
          HintStr := MyString;
          CanShow := True;
                end;
              end;
        end;
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.ShowHint := True;
  Application.OnShowHint := DoShowHint;
end;

end.


All you need to do is set showhint to true in the listbox and set something (anything it doesnt matter) and the hint text.

Heath

This will only look right when the font used in the listbox is the same as what is used for the hints (this is usually true using the default font for the listbox but depends on the users current windows settings).  You could override this limitation by creating a custom HintWindow Class and setting its font to match your listbox font.  That is basically what microsoft does on there apps that have this feature.  But Ill leave that up to you.  You might also want to shorten the HIntPause when you are doing the hints in the listbox.  You would change the previous code like this:

procedure TForm1.DoShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
var
  MyItemIndex: Integer;
  MyString: String;
  MySize: TSize;
  MyPos: TPoint;
begin
  if Application.HintPause <> 500 then Application.HintPause := 500;
  with HintInfo do
  begin
    if HintControl = ListBox1 then
        begin
      if Application.HintPause <> 25 then Application.HintPause := 25;
      CanShow := False;
      ................

Hope this helps

Heath

Ooopps, I forgot something you need to change the following line

MyPos := Point(-1, (MySize.cy * MyItemIndex - 3));

to this

MyPos := Point(-1, (MySize.cy * (MyItemIndex - ListBox1.TopIndex) - 3));

I forgot about scrolling :)

Heath

heathprovost thank you very much.
It's a great tip.
The points are yours , so please reply with an answer.
Regards

heathprovost many thanks to you :-)