Title: Adding tooltips to a TListBox
Question: Have you ever wanted to see the full contents of a ListBox entry if the entry is wider than the ListBox?
Answer:
Normally if you are using listboxes in your programs and the items that populate the listbox are wider than the width of the listbox, those items will be clipped. This could cause important information to be visually lost.
This acrticle provides a method to prevent this from being a major problem, by displaying a tooltip-like hint over items that are wider than the listbox.
The key to this problem is the THintWindow object. This is the same object that is used on the Windows Taskbar or System Tray to pop up a hint if the mouse hovers over an icon for a short amount of time. The TTreeView VCL component provides this capability built-in, while the TListBox component does not provide it at all. You will be responsible for creating, displaying and destroying the THintWindow yourself.
To begin, start a new project and add a single TListBox (named lstProducts) and a single TButton (named btnOK) component to it. You may also use the source code provided at the end of this document. Rearrange and resize the components as needed.
You will need to manually add the following definition to the private section of the main forms definition:
ThisHintWindow : THintWindow;
This is the object we will be using to provide the list item hints.
In the main forms OnCreate() event handler, we will need to do three things: (a) define a method to ensure we are display the hint over the correct component, (b) create the hint window, and (c) set the color of the hint window.
a. Define a method to ensure we are display the hint over the correct component. We do this by setting the OnShowHint() event handler to the procedure we want to use:
Application.OnShowHint := CheckHint;
The definition of the CheckHint() procedure is below:
procedure TfrmMain.CheckHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
begin
if (HintInfo.HintControl = lstProducts) then
HintInfo.HintPos.y := HintInfo.HintPos.y - 24;
end;
We want to make sure we are showing the hint over the correct component, the lstProducts listbox.
b. Create the hint window. Simple call the Create() constructor for the hint window, using the main form as the owner:
ThisHintWindow := THintWindow.Create(Self);
c. Set the color of the hint window. When the hint window is displayed, we want to make sure it is displayed in the colors defined by the user using the Appearance display properties on the Windows desktop. This is done by using Delphis predefined clInfoBk constant:
ThisHintWindow.Color := clInfoBk;
We will now want to display the hint window when the mouse is over items in the listbox that are wider than the listbox. The other, shorter items are OK as they are. We will take care of displaying the hint window in the OnMouseMove() event handler of the listbox, and below are the basic steps.
First we need to get the item that is under the mouse cursor, and the following lines accomplish this:
ThePoint.x := X;
ThePoint.y := Y;
Index := ListBox.ItemAtPos(ThePoint, true);
Index will return the zero-based index of the listbox item or 1 if it is not over an item. If we are over an item wider than the listbox, we will need to define the upper-left and lower-right corners of a rectangle that will be used as the dimensions of the hint window.
if ListBox.Canvas.TextWidth(ListBox.Items[Index]) ListBox.Width then begin
ScreenPointUpperLeft.x := ListBox.ItemRect(Index).left - 1;
ScreenPointUpperLeft.y := ListBox.ItemRect(Index).top - 3;
ScreenPointLowerRight.x := ScreenPointUpperLeft.x +
ThisHintWindow.Canvas.TextWidth(ListBox.Items[Index]) + 7;
ScreenPointLowerRight.y := ScreenPointUpperLeft.y +
ThisHintWindow.Canvas.TextHeight(ListBox.Items[Index]) + 2;
ScreenRect.TopLeft := ListBox.ClientToScreen(ScreenPointUpperLeft);
ScreenRect.BottomRight := ListBox.ClientToScreen(ScreenPointLowerRight);
Once we have the dimensions of the rectangle defined, we can finally display the hint window that is using it:
ThisHintWindow.ActivateHint(ScreenRect, ListBox.Items[Index]);
end;
As long as the mouse cursor remains hovering over the item, the hint will be displayed. If the mouse cursor moves to another long item, the window will still be displayed, but the contents of it will be replaced by the text of the item the cursor is over. You may be asking: How and when does the hint window go away?
Making the hint go away is the easy part. There are two conditions in which we want the hint window to not be displayed: when we move the mouse cursor to an item that is shorter than the width of the listbox, and also when we move the mouse cursor totally out of the listbox. In order to do this, however, we need some additional code that will tell us if the mouse cursor is over a specific component on the form:
function TfrmMain.IsMouseOverControl(Control: TWinControl): Boolean;
var P: TPoint;
begin
// Get the screen coordinates of the current mouse position
GetCursorPos(P);
// The mouse is over the control if : (a) the control is defined AND created, (b)
// it is a WINDOWED control, and (c) the handle of the window the mouse is
// currently over is the same as the handle of the control we passed in
Result := Assigned(Control) and IsWindow(Control.Handle) and
(WindowFromPoint(P) = Control.Handle);
end;
We can use this function to determine whether or not the mouse cursor is currently over the listbox. If we are not over the listbox, we want to destroy the hint window. We do this by calling the ReleaseHandle() procedure of the hint window:
if not IsMouseOverControl(lstProducts) and (ThisHintWindow nil) then
ThisHintWindow.ReleaseHandle;
We can do this because this procedure is used specifically for hint windows that are activated calling the ActivateHint() procedure, which we did in the OnMouseMove() event handler above.
In closing...
As you can see, displaying a hint for any listbox items that are too wide is quite trivial by using the techniques above. The default size of a listbox when it is dropped on a form is pretty small. If you do have space constraints, this method can be used to prevent information in your programs from being lost.
------------------------ SNIP -----------------------------
Project1.dpr:
program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' {frmMain};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TfrmMain, frmMain);
Application.Run;
end.
Unit1.dfm:
object frmMain: TfrmMain
Left = 270
Top = 396
Width = 238
Height = 351
Caption = 'Hints for long listbox items'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnMouseMove = FormMouseMove
PixelsPerInch = 96
TextHeight = 13
object lstProducts: TListBox
Left = 30
Top = 9
Width = 170
Height = 263
ItemHeight = 13
Items.Strings = (
'This is a short listbox item'
'This is a longer listbox item'
'This is an even longer listbox item'
'This is a really really really long listbox item'
'This is a stupendously long listbox item (Amazing, ain'#39't it?)')
TabOrder = 0
OnMouseMove = lstProductsMouseMove
end
object btnOK: TButton
Left = 78
Top = 286
Width = 75
Height = 25
Caption = '&Ok'
TabOrder = 1
OnClick = btnOKClick
end
end
Unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TfrmMain = class(TForm)
lstProducts: TListBox;
btnOK: TButton;
procedure lstProductsMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure btnOKClick(Sender: TObject);
private
{ Private declarations }
ThisHintWindow : THintWindow;
procedure CheckHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
function IsMouseOverControl(Control: TWinControl): Boolean;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.DFM}
procedure TfrmMain.CheckHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
begin
// If the control the hint window is over is our listbox ...
if (HintInfo.HintControl = lstProducts) then
// Back up the position of the hint window so it's not "stepping on" the text
HintInfo.HintPos.y := HintInfo.HintPos.y - 24;
end;
function TfrmMain.IsMouseOverControl(Control: TWinControl): Boolean;
var P: TPoint;
begin
// Get the screen coordinates of the current mouse position
GetCursorPos(P);
// The mouse is over the control if : (a) the control is defined AND created, (b) it is a WINDOWED
// control, and (c) the handle of the window the mouse is currently over is the same as the handle
// of the control we passed in
Result := Assigned(Control) and IsWindow(Control.Handle) and (WindowFromPoint(P) = Control.Handle);
end;
procedure TfrmMain.lstProductsMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var ThePoint : TPoint;
ScreenPointUpperLeft : TPoint;
ScreenPointLowerRight : TPoint;
ScreenRect : TRect;
ListBox : TListBox;
Index : integer;
begin
// Local variable so we don't have to typecast every time
ListBox := (Sender as TListBox);
// Get the current location of the mouse cursor
ThePoint.x := X;
ThePoint.y := Y;
// Get the index of the listbox item the mouse cursor is currently over
Index := ListBox.ItemAtPos(ThePoint, true);
// Make sure we're over a listbox item
if (Index -1) then begin
// If the text of the item the mouse is over is longer than the width of the listbox, we
// well want to pop up the hint window
if ListBox.Canvas.TextWidth(ListBox.Items[Index]) ListBox.Width then begin
// Find a decent place for the upper-left corner of the hint window to be displayed
ScreenPointUpperLeft.x := ListBox.ItemRect(Index).left - 1;
ScreenPointUpperLeft.y := ListBox.ItemRect(Index).top - 3;
// Find a decent place for the lower-right corner of the hint window to be displayed
ScreenPointLowerRight.x := ScreenPointUpperLeft.x + ThisHintWindow.Canvas.TextWidth(ListBox.Items[Index]) + 7;
ScreenPointLowerRight.y := ScreenPointUpperLeft.y + ThisHintWindow.Canvas.TextHeight(ListBox.Items[Index]) + 2;
// Define the boundaries of the hint windows rectangle using the two corners from above
ScreenRect.TopLeft := ListBox.ClientToScreen(ScreenPointUpperLeft);
ScreenRect.BottomRight := ListBox.ClientToScreen(ScreenPointLowerRight);
// Show the hint using the listbox item the mouse cursor is currently over
ThisHintWindow.ActivateHint(ScreenRect, ListBox.Items[Index]); end
else
ThisHintWindow.ReleaseHandle; end
else
ThisHintWindow.ReleaseHandle;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
// Defines the method to use when an application is to display the hint window
Application.OnShowHint := CheckHint;
// Create our own hint window
ThisHintWindow := THintWindow.Create(Self);
// Use the Windows-defined color. We don't want to force the user to use our color
ThisHintWindow.Color := clInfoBk;
end;
procedure TfrmMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
// This code is only used to 'disable' the hint window over long list items. We
// want to turn this off if (a) the mouse cursor is NOT currently over the list,
// and (b) the hint window is active
if not IsMouseOverControl(lstProducts) and (ThisHintWindow nil) then
ThisHintWindow.ReleaseHandle;
end;
procedure TfrmMain.btnOKClick(Sender: TObject);
begin
Close;
end;
end.