unit HintCBx;
interface
uses
SysUtils, Classes, Controls, StdCtrls, Messages, Windows, Graphics;
const
WM_HINT = WM_USER + 1;
type
THintCBx =
class(TCheckBox)
private
{ Private-Deklarationen }
HintWnd : THintWindow;
protected
{ Protected-Deklarationen }
public
{ Public-Deklarationen }
procedure WMHint(
var Message: TMessage);
message WM_HINT;
procedure WMMouseHover(
var Message: TMessage);
message WM_MOUSELEAVE;
Constructor Create(AOwner:TComponent);
override;
Destructor Destroy;
override;
procedure Loaded;
override;
published
{ Published-Deklarationen }
end;
function MouseProc(nCode : Integer; wParam: WPARAM; lParam : LPARAM): LRESULT;
stdcall;
var
MouseHook : HHOOK;
{ ---------------------------------------------------------------------------- }
procedure Register;
{ ---------------------------------------------------------------------------- }
implementation
{ ---------------------------------------------------------------------------- }
procedure Register;
begin
RegisterComponents('
Beispiele', [THintCBx]);
end;
{ ---------------------------------------------------------------------------- }
{ THintCBx }
{ ---------------------------------------------------------------------------- }
function RealWindowFromPoint(pt: TPoint
{$IFDEF RWFPCHOICE}; swinvis: boolean = true
{$ENDIF}): HWND;
(*
Functionality:
This will get a windows handle from the position of the mouse, even if it is
for example inside the area occupied by a groupbox.
[GENERIC] It may be used as a substitute to "ChildWindowFromPoint" which
however doesn't work as well as this one ;)
Featured by Eugen, all credits go to him ...
Corrected version (by Eugen) - should work on 9x now ;)
I changed a few things more to have a more consistent behavior
*)
type
PCHILDS_ENUM = ^CHILDS_ENUM;
CHILDS_ENUM =
record
nDiff: integer;
hWndFound: HWND;
pt: TPoint;
{$IFDEF RWFPCHOICE}
showinvis: boolean;
{$ENDIF RWFPCHOICE}
end;
var
ce: CHILDS_ENUM;
function EnumProc(hwndChild: HWND; lParam: LPARAM): Boolean;
stdcall;
(*
Functionality:
This is the core of RealWindowFromPoint. It enumerates child windows of the
window given by handle.
[SPECIFIC] only useful in the context of this function.
*)
var
rc: TRECT;
begin
GetWindowRect(hwndChild, rc);
with PCHILDS_ENUM(lParam)^, rc
do
{$IFDEF RWFPCHOICE}
case showinvis
of
true:
if (pt.x >= Left)
and (pt.x < Right)
and (pt.y >= Top)
and (pt.y < Bottom)
and
(nDiff > (Right - Left) + (Bottom - Top))
then
begin
hWndFound := hwndChild;
nDiff := (Right - Left) + (Bottom - Top);
end;
else
if (pt.x >= Left)
and (pt.x < Right)
and (pt.y >= Top)
and (pt.y < Bottom)
and
(nDiff > (Right - Left) + (Bottom - Top))
and IsWindowVisible(hwndChild)
then
begin
hWndFound := hwndChild;
nDiff := (Right - Left) + (Bottom - Top);
end;
end;
{$ELSE RWFPCHOICE}
if (pt.x >= Left)
and (pt.x < Right)
and (pt.y >= Top)
and (pt.y < Bottom)
and
(nDiff > (Right - Left) + (Bottom - Top))
then
begin
hWndFound := hwndChild;
nDiff := (Right - Left) + (Bottom - Top);
end;
{$ENDIF RWFPCHOICE}
Result := True;
end;
begin
ce.nDiff := MAXLONG;
ce.hWndFound := WindowFromPoint(pt);
ce.pt.x := pt.x;
//scheiss-w9x
ce.pt.y := pt.y;
//scheiss-w9x
{$IFDEF RWFPCHOICE}
ce.showinvis := swinvis;
{$ENDIF RWFPCHOICE}
if (ce.hWndFound <> 0)
then
begin
// Windows 9x does not like NULL for a handle handed over to EnumChildWindows()
// The NT platform treats this just like EnumWindows()
if (GetWindowLong(ce.hWndFound, GWL_STYLE)
and WS_CHILD <> 0)
then
ce.hwndFound := GetParent(ce.hwndFound);
EnumChildWindows(ce.hWndFound, @EnumProc, Integer(@ce));
end;
Result := ce.hwndFound;
end;
{ ---------------------------------------------------------------------------- }
function MouseProc(nCode : Integer; wParam: WPARAM; lParam : LPARAM): LRESULT;
stdcall;
var
MPos : TPoint;
tmpHandle : HWND;
begin
Result := CallNextHookEx(MouseHook,nCode,wParam,lParam);
case nCode < 0
of
TRUE : Exit;
//wenn code kleiner 0 wird nix gemacht
FALSE:
begin
if (wParam = WM_MOUSEMOVE)
then
begin
GetCursorPos(MPos);
tmpHandle := RealWindowFromPoint(MPos);
if tmpHandle > 0
then
begin
SendMessage(tmpHandle, WM_HINT, wParam, lParam);
end;
end;
end;
end;
end;
{ ---------------------------------------------------------------------------- }
constructor THintCBx.Create(AOwner: TComponent);
begin
inherited;
HintWnd := THintWindow.Create(Self);
HintWnd.Color := clInfoBk;
ShowHint := True;
MouseHook := SetWindowsHookEx(WH_MOUSE, @MouseProc, 0, GetCurrentThreadId());
end;
{ ---------------------------------------------------------------------------- }
destructor THintCBx.Destroy;
begin
HintWnd.Free;
if MouseHook <> 0
then
UnhookWindowsHookEx(MouseHook);
inherited;
end;
{ ---------------------------------------------------------------------------- }
procedure THintCBx.Loaded;
var
tme: TTRACKMOUSEEVENT;
TrackMouseEvent_:
function(
var EventTrack: TTrackMouseEvent): BOOL;
stdcall;
begin
Inherited Loaded;
if ComponentState = [csDesigning]
then Exit;
tme.cbSize := sizeof(TTRACKMOUSEEVENT);
tme.dwFlags := TME_HOVER
or TME_LEAVE;
tme.dwHoverTime := 10;
tme.hwndTrack := Self.Handle;
@TrackMouseEvent_:= @TrackMouseEvent;
// nur eine Pointerzuweisung!!!
if TrackMouseEvent_(tme)
then
begin
end;
end;
{ ---------------------------------------------------------------------------- }
procedure THintCBx.WMHint(
var Message: TMessage);
var
rec : TRect;
MPos: TPoint;
tmpHint :
String;
begin
if Assigned(HintWnd)
then
begin
tmpHint := Hint;
GetCursorPos(MPos);
MPos := ScreenToClient(MPos);
rec := Rect(Self.Left, Self.Top, Self.Left + Self.Width, Self.Top + Self.Height);
if (PtInRect(rec, point(MPos.X + Self.Left, MPos.Y + Self.Top)))
and (
not Self.Enabled)
and (Self.ShowHint)
then
begin
GetCursorPos(MPos);
HintWnd.Color := clInfoBk;
HintWnd.ActivateHint(Rect(MPos.X + 15, MPos.Y, MPos.X + 20 + HintWnd.Canvas.TextWidth(tmpHint), MPos.Y + 15), tmpHint);
end
else
HintWnd.ReleaseHandle;
end;
Message.Result := 1;
end;
{ ---------------------------------------------------------------------------- }
procedure THintCBx.WMMouseHover(
var Message: TMessage);
begin
//DIES IST NUR ZU TESTZWECKEN DAMIT ICH SEHE OB ER IN DIE NACHRICHT "KOMMT"
HintWnd.ReleaseHandle;
end;
{ ---------------------------------------------------------------------------- }
end.