Kompo um bei "disabled" Delphi-Kompos ein Hint's zu zeigen

[Alex_ITA01]

Hallo erstmal,
nach langer Zeit wurde ich angesprochen, ob ich nicht den Source für diese Kompo auch posten könnte.
Es spricht nichts dagegen. Die Funktion EnumProc ist glaube ich von Eugen gewesen. Ich habe diese im Netz gefunden.
Ich hoffe, falls es nicht Eugen war, dass sich der richtige Author jetzt nicht angegriffen fühlt
Viel Spaß damit.
MFG Alex

PS: Es wird alles über einen Maushook gemacht

Delphi-Quellcode:

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.