unit HintCBx;
interface
uses
SysUtils, Classes, Controls, StdCtrls, Messages, Windows, Graphics, ExtCtrls;
const
WM_HINT = WM_USER + 1;
type
THintCBx =
class(TCheckBox)
private
{ Private-Deklarationen }
HintWnd : THintWindow;
OldWndProc: Pointer;
NewWndProc: Pointer;
protected
{ Protected-Deklarationen }
public
{ Public-Deklarationen }
function GetHandle : HWND;
procedure WMHint(
var Message: TMessage);
message WM_HINT;
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 MouseProc(nCode : Integer; wParam: WPARAM; lParam : LPARAM): LRESULT;
stdcall;
var
MPos : TPoint;
Komp : TControl;
Test : THintCBx;
begin
if (wParam = WM_MOUSEMOVE)
then
begin
//GetCursorPos(MPos);
MPos.X := 105;
MPos.Y := 18;
Komp := FindDragTarget(MPos, True);
if Komp
is THintCBx
then
begin
Test := Komp
as THintCBx;
if Test.GetHandle <> 0
then
begin
//SendMessage(ControlHandle,WM_MOUSEMOVE,wParam,lParam);
SendMessage(Test.GetHandle,WM_HINT,wParam,lParam);
end;
end;
end;
Result := CallNextHookEx(MouseHook,nCode,wParam,lParam);
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
SetWindowLong(Self.Handle, GWL_WNDPROC, Longint(OldWndProc));
FreeObjectInstance(NewWndProc);
HintWnd.Free;
if MouseHook <> 0
then
UnhookWindowsHookEx(MouseHook);
inherited;
end;
{ ---------------------------------------------------------------------------- }
function THintCBx.GetHandle: HWND;
begin
Result := Self.Handle;
end;
{ ---------------------------------------------------------------------------- }
procedure THintCBx.Loaded;
begin
Inherited Loaded;
if ComponentState = [csDesigning]
then Exit;
NewWndProc := MakeObjectInstance(WMHint);
OldWndProc := TFNWndProc(GetWindowLong(Self.Handle, GWL_WNDPROC));
SetWindowLong(Self.Handle, GWL_WNDPROC, Longint(NewWndProc));
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;
Message.Result := DefWindowProc(Self.Handle,
Message.Msg,
Message.WParam,
Message.LParam);
end;
{ ---------------------------------------------------------------------------- }
{ ---------------------------------------------------------------------------- }
end.