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

[Alex_ITA01]

Hallo erstmal,
hier ist meine fertige Komponente...
Als erstes einmal eine Erklärung, warum sie nur als .dcu vorliegt:
Ich habe mich im Internet über bestimmte Funktionen schlau gemacht und musste ein paar anpassen bzw. ändern. Jetzt muss ich mich erstmal schlau machen, ob der Author des "ehemaligen" Sources damit einverstanden ist (aber ich denke schon, weil es nur eine Erweiterung bzw. Verbesserung seines Sources war).
Also falls ich das okay habe, dann werde ich alles nach OpenSource verschieben...

Jetzt die Erklärung der Komponente:
Ihr braucht sie nur ein einziges Mal pro Anwendung verwenden (es wird sowieso überprüft ob man diese Kompo mehrmals aufs Formular ablegen will...). Die Komponente ist ein Workaround für einige Delphi-Komponenten (Button,Edit,CheckBox,StringGrid,Panel usw.) die standardmäßig KEINEN Hint anzeigen wenn sie "not enabled" sind.
Also ganz einfaches Beispiel:

Mit meiner Kompo:
Neues Formular -> Button drauf -> ShowHint = True -> Hint = Button1 -> Enabled = False
Ergebnis: Hint wird angezeigt

Ohne meine Kompo:
Neues Formular -> Button drauf -> ShowHint = True -> Hint = Button1 -> Enabled = False
Ergebnis: Hint wird NICHT angezeigt

Also wer es gebrauchen kann solls nutzen
Wünsche euch viel Spaß...

MFG Alex

Download: ca. 5k

[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.

[toms]

Ich habe noch eine kürzere Möglichkeit gefunden bei experts-exchange.
Vorteil: Es ist keine Komponente. Unit kann eingebundenn werden und Hints werden bei
inaktiven Controls angezeigt.

Delphi-Quellcode:

unit ControlsHook;
////////////////////////////////////////////////////////////////////////////////
//
//   Unit        :  ControlsHook
//   Author      :  rllibby
//   Date        :  12.20.2005
//   Description :  Code for runtime hooking of the FindVCLWindow function in the
//                  controls unit.
//
////////////////////////////////////////////////////////////////////////////////
interface

////////////////////////////////////////////////////////////////////////////////
//   Include units
////////////////////////////////////////////////////////////////////////////////
uses
  Windows, Controls, Forms;

////////////////////////////////////////////////////////////////////////////////
//   ASM block structure for installing hook
////////////////////////////////////////////////////////////////////////////////
type
  TJmpBlock = packed record
    Code: Byte;
    Offset: Integer;
  end;

////////////////////////////////////////////////////////////////////////////////
//   Our replacement for the FindVCLWindow function
////////////////////////////////////////////////////////////////////////////////
function HookFindVCLWindow(const Pos: TPoint): TWinControl;

implementation

function HookFindVCLWindow(const Pos: TPoint): TWinControl;
var Form: TForm;
  Handle: HWND;
begin

  Result := nil;
  Form := Screen.ActiveForm;
  if Assigned(Form) then
  begin
    Handle := ChildWindowFromPoint(Form.Handle, Form.ScreenToClient(Pos));
    while (Handle <> 0) do
    begin
      Result := FindControl(Handle);
      if Assigned(Result) and Result.Visible then
        break
      else
        Result := nil;
      Handle := GetParent(Handle);
    end;
  end;

end;

procedure SetFunctionHook;
var jmpBlock: TJmpBlock;
  dwProtect: LongWord;
  lpFunc: Pointer;
begin

  // Get the address of the FindVCLWindow function
  lpFunc := @FindVCLWindow;

  // Calculate the jump offset
  jmpBlock.Code := $E9;
  jmpBlock.Offset := Integer(@HookFindVCLWindow) - (Integer(lpFunc) + SizeOf(TJmpBlock));

  // Unprotect the memory so we can add the new asm code
  VirtualProtect(lpFunc, SizeOf(TJmpBlock), PAGE_EXECUTE_READWRITE, dwProtect);

  // Update the FindVCLWindow with a jump to our hook
  Move(jmpBlock, lpFunc^, SizeOf(TJmpBlock));

end;

initialization

  // Set the function hook
  SetFunctionHook;

end.

[himitsu]

Hmmm, tom's Code hat in unserem XE irgendwie überhaupt nicht funktioniert.
Keine Fehlermeldungen oder so, aber es tauchten auch einfach keine hints auf. (hab aber nicht weitergesucht, nachdem der andere Code soweit eigentlich funktionierte)

Ich hab den Code von Alex_ITA01 aber nochmal überarbeitet und einige Bugs behoben.

Es ist jetzt keine Komponente mehr, da es eh nur einmal im Programm verwendet werden kann, reicht es, wenn man nur die Unit einbindet.
So könnten auch TDE-Besitzer es nutzen und es nängt nicht sinnlos in der IDE rum ... Tipp: Kennt ihr noch die sinnlose TXPManifest-Komponente?

EnumProc hatte z.B. den falschen Rückgabetypen. (Delphi-Boolean = 1 Byte und Windows-BOOL = 4 Byte, bzw. es ist so groß wie ein CPU-Register)

Das böse WITH ist auch raus.

Typkonvertierungen sind auch in Bezug auf andere Zielplattforem (vorallem Win64) überarbeitet.
Pointer <> Integer (nja, hätte man den Integer nicht eingefroren, wäre es fast richtig)

Und das Verhalten wurde etwas mehr an die anderen delphi-Hint angepaßt.
- die korrekte Hint-Klasse wird verwendet
- auch die Farbe wird ordentlich übernommen
- der Hint verfolgt den Zeiger nicht mehr so penetrant
- und was weiß ich was ich sonst noch alles gemacht hab



Hinweis: Es ist alles natürlich nur für die VCL (kein FMX) und ob es unter Win64 läuft, konnte ich nicht testen.