unit HintKompo;
interface
uses
SysUtils, Classes, Controls, Messages, Windows, Graphics, TypInfo;
type
THintKompo =
class(TComponent)
private
{ Private-Deklarationen }
protected
{ Protected-Deklarationen }
public
{ Public-Deklarationen }
Constructor Create(AOwner:TComponent);
override;
Destructor Destroy;
override;
procedure Loaded;
override;
published
{ Published-Deklarationen }
end;
procedure ShowText(Text :
String; X, Y : Integer);
function MouseProc(nCode : Integer; wParam: WPARAM; lParam : LPARAM): LRESULT;
stdcall;
{ MouseHook-Procedure }
var
HintWnd : THintWindow;
{ Instanz für das Anzeigen des Hint's }
MouseHook : HHOOK;
{ Instanz für den MouseHook }
InstanceCount : Integer = 0;
{ erlaubt nur eine Instanz der Komponente pro Anwendung }
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('
Jung', [THintKompo]);
end;
function RealWindowFromPoint(pt: TPoint): HWND;
type
PCHILDS_ENUM = ^CHILDS_ENUM;
CHILDS_ENUM =
record
nDiff : integer;
hWndFound : HWND;
pt : TPoint;
end;
var
ce: CHILDS_ENUM;
function EnumProc(hwndChild: HWND; lParam: LPARAM): Boolean;
stdcall;
var
rc: TRECT;
begin
GetWindowRect(hwndChild, rc);
with PCHILDS_ENUM(lParam)^, rc
do
begin
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;
end;
Result := True;
end;
begin
ce.nDiff := MAXLONG;
ce.hWndFound := WindowFromPoint(pt);
ce.pt.X := pt.X;
ce.pt.Y := pt.Y;
if (ce.hWndFound <> 0)
then
begin
if (GetWindowLong(ce.hWndFound, GWL_STYLE)
and WS_OVERLAPPED
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;
X, Y : Integer;
MousePos : PMOUSEHOOKSTRUCT;
begin
Result := CallNextHookEx(MouseHook,nCode,wParam,lParam);
case nCode < 0
of
TRUE: Exit;
FALSE:
begin
if (wParam = WM_MOUSEMOVE)
then
begin
MousePos := PMOUSEHOOKSTRUCT(lParam);
X := MousePos^.pt.X;
Y := MousePos^.pt.Y;
if not Assigned(HintWnd)
then Exit;
GetCursorPos(MPos);
tmpHandle := RealWindowFromPoint(MPos);
if FindControl(tmpHandle) =
Nil then Exit;
if IsPublishedProp(FindControl(tmpHandle), '
Enabled')
then
begin
if IsPublishedProp(FindControl(tmpHandle), '
ShowHint')
then
begin
if (FindControl(tmpHandle).Enabled = False)
and
(FindControl(tmpHandle).ShowHint = True)
then
begin
if FindControl(tmpHandle).Hint = '
'
then
ShowText('
Hint',X,Y)
else
ShowText(FindControl(tmpHandle).Hint,X,Y);
end
else
begin
if Assigned(HintWnd)
then
HintWnd.ReleaseHandle;
end;
end;
end;
end;
end;
end;
end;
procedure ShowText(Text:
String; X, Y : Integer);
begin
if Assigned(HintWnd)
then
begin
HintWnd.Color := clInfoBk;
HintWnd.ActivateHint(Rect(X + 15, Y, X + 20 + HintWnd.Canvas.TextWidth(Text), Y + 15), Text);
end;
end;
constructor THintKompo.Create(AOwner: TComponent);
begin
inherited;
HintWnd := THintWindow.Create(Self);
HintWnd.Color := clInfoBk;
Inc(InstanceCount);
if InstanceCount > 1
then
raise Exception.Create('
Diese Komponente darf nur einmal pro Anwendung existieren!');
end;
destructor THintKompo.Destroy;
begin
Dec(InstanceCount);
if MouseHook <> 0
then
UnhookWindowsHookEx(MouseHook);
inherited;
end;
procedure THintKompo.Loaded;
begin
Inherited Loaded;
if ComponentState = [csDesigning]
then Exit;
MouseHook := SetWindowsHookEx(WH_MOUSE, @MouseProc, 0, GetCurrentThreadId);
end;
end.