2004. május 20., csütörtök
How to display hints always under the mouse cursor
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;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése