Neue Checkbox die auch bei disabled Hint's anzeigt

[Alex_ITA01]

Also erstmal großen Dank an, Luckie, Ultimator und Assarbad.
Ich habe es jetzt endlich hinbekommen, eine CheckBox so abzuleiten, dass ich auch ein HINT sehe, wenn sie disabled ist.
Nun möchte ich euch natürlich auch den Source zeigen/geben...

Delphi-Quellcode:

unit HintCBx;

{ CheckBox, die auch bei NOT ENABLED Hint's anzeigt. Entworfen von: Alexander J. }

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;

    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
  HintWnd   : THintWindow;
  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 GetClassName(Wnd: HWND): String;
var
  szBuffer: array [0..255] of Char;
begin
  ZeroMemory(@szBuffer, SizeOf(szBuffer));
  Windows.GetClassName(Wnd, szBuffer, SizeOf(szBuffer));
  Result := String(szBuffer);
end;
{ ---------------------------------------------------------------------------- }
function MouseProc(nCode : Integer; wParam: WPARAM; lParam : LPARAM): LRESULT; stdcall;
var
  MPos      : TPoint;
  tmpHandle : HWND;
  tmpStr    : String;
begin
  Result := CallNextHookEx(MouseHook,nCode,wParam,lParam);
  if (wParam = WM_MOUSEMOVE) then
  begin
    GetCursorPos(MPos);
    tmpHandle := RealWindowFromPoint(MPos);
    tmpStr := GetClassName(tmpHandle);
    if tmpStr = 'THintCBx' then
    begin
      if tmpHandle > 0 then
      begin
        SendMessage(tmpHandle, WM_HINT, wParam, lParam);
      end;
    end
    else
    begin
      HintWnd.ReleaseHandle;
    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
  if HintWnd.HandleAllocated then
    HintWnd.Free;
  if MouseHook <> 0 then
    UnhookWindowsHookEx(MouseHook);
  inherited;
end;
{ ---------------------------------------------------------------------------- }
procedure THintCBx.Loaded;
begin
  Inherited Loaded;
  if ComponentState = [csDesigning] then Exit;
end;
{ ---------------------------------------------------------------------------- }
procedure THintCBx.WMHint(var Message: TMessage);
var
  rec : TRect;
  MPos: TPoint;
  tmpHint : String;
begin
  if Assigned(HintWnd) then
  begin
    if ComponentState = [csDesigning] then Exit;
    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;
{ ---------------------------------------------------------------------------- }
end.

[Luckie]

Und wenn du das jetzt noch für jedes Control hinbekommest, zu mindest für jedes von TWinControl abgeleitet sollte es kein Problem sein, dann ist es nicht schlecht.

[Alex_ITA01]

ich freu mich erstmal was positives von dir zu hören Luckie :-))
Könntest du mir noch sagen, wie ich das für "alle" TWinControls mache oder muss ich da jede Kompo neu ableiten? Bestimmt nicht oder?

MFG Alex

[Luckie]

Ich habe mir deinen Code nicht genauer angeguckt, aber wenn es mit TCheckbox geht, dann geht es auch mit TButton (Eine Checkbox ist nämlich auch nur ein Button mit einem speziellen Windowsstil.). Entweder Machst du dir deine eigene Komponentensammlung oder du versuchts es zu verallgemeinern.

[Alex_ITA01]

Achso meinst du das...
Okay das mit der Komponentensammlung wäre ja kein Problem.
Also erstmal klein Anfangen und nur für die Standardelemente in Delphi.
Hey die Idee gefällt mir richtig klasse...
Muss ich wirklich heute Abend bei mehr Zeit mal versuchen...
Danke nochmals
Alex

[Luckie]

Obwohl mit eine allgemeine Funktion besser gefallen würde. Man gibt den namen der Komponente an und den Hint und fertig:

Delphi-Quellcode:

SetDisabledHint(btnSave, 'Speichert die Einstellungen');

[Alex_ITA01]

ich verstehe nur nicht so ganz, wo oder besser gesagt wie ich das Package installieren muss, damit das funktioniert mit einer Allgemeinen Funktion...
Das ist ja dann keine Kompo mehr oder wie meinst du das? Stehe ich jetzt auf dem Schlauch? :-)

MFG

[Luckie]

Gar kein Package, sondern eine Funktion in einer eigenen Unit.

[Alex_ITA01]

achsooooo....
Jetzt hats klick gemacht :-)
Ich werde es mal versuchen.
MFG