How to display hints always under the mouse cursor

Mirror

How to display hints always under the mouse cursor (Views: 714)

Problem/Question/Abstract:

How to display hints always under the mouse cursor

Answer:

This code snippet shows how to make your popup hint windows behave more like normal windows apps. Instead of always being square under the control they belong to, they are based on where the mouse is. This uses the GetIconInfo API, which is only available for Win32.

Add the following to your main form's OnCreate event handler:

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Application.OnShowHint := GetHintInfo;
end;

Add the following declaration to your main form's protected declartion:

procedure GetHintInfo(var HintStr: string; var CanShow: boolean; var HintInfo: THintInfo);

And, finally, add this procedure to your main form:

procedure TMainForm.GetHintInfo(var HintStr: string; var CanShow: boolean; var HintInfo: THintInfo);
var
  II: TIconInfo;
  Bmp: Windows.TBitmap;
begin
  with HintInfo do
  begin
    {Make sure we have a control that fired the hint}
    if HintControl = nil then
      exit;
    {Convert the cursor's coordinates from relative to hint to relative to screen}
    HintPos := HintControl.ClientToScreen(CursorPos);
    {Get some information about the cursor that is used for the hint control}
    GetIconInfo(Screen.Cursors[HintControl.Cursor], II);
    {Get some information about the bitmap representing the cursor}
    GetObject(II.hbmMask, SizeOf(Windows.TBitmap), @Bmp);
    {If the info did not include a color bitmap then the mask bitmap is really two bitmaps, an AND & XOR mask. Increment our Y position by the bitmap's height}
    if II.hbmColor = 0 then
      inc(HintPos.Y, Bmp.bmHeight div 2)
    else
      inc(HintPos.Y, Bmp.bmHeight);
    {Subtract out the Y hotspot position}
    dec(HintPos.Y, II.yHotSpot);
    {We are responsible for cleaning up the bitmap handles returned by GetIconInfo}
    DeleteObject(II.hbmMask);
    DeleteObject(II.hbmColor);
  end;
end;

<< Back to main page