Probleme mit Hooks

[Assarbad]

Er benutzt ja keine DLL sondern einen lokalen Hook.

[Alex_ITA01]

jup, das ist richtig @Assarbad.
Ich hatte aber noch keine Zeit das zu testen was du mir geschickt hast (den Link).Werde es heute Abend mal probieren.
Hast du sowas schonmal gemacht mit dem "übergeben" einer Methode?

[Assarbad]

Ja, finde es aber nciht mehr. Ich hatte damals nur eine Lösung für eine einzige Instanz gemacht.

Apropos: vielleicht hilft dir auch WM_MOUSEHOVER und WM_MOUSELEAVE ... dann brauchst du nur diese beiden Nachrichten abfangen! Einziges Problem: es geht erst ab NT 4.0 und Windows 98. Also keine Lösung für Windows 95.

Kannst ja auch mal in den VCL-Sourcen schauen, wie die OnEnter und OnLeave implementiert haben.

[Alex_ITA01]

das Problem ist ja, dass eine "disabledte" Komponente keine WM_MOUSEMOVE, LEAVE oder ENTER-Events erhält...
Daher habe ich mir ja die eigene Nachricht erstellt, die auch nur ausgeführt wird, wenn eben die Komponente auch wirklich disabled ist.Ansonsten treffen ja alle anderen Windows-Nachrichten ein.
Weißt du zufällig wie man dieses Verhalten "abschalten" könnte? Das z.B. die Nachrichten nicht mehr eintreffen nur wenn die Kompo disabled ist?

MFG Alex

[Alex_ITA01]

Habs grade mal getestet:

Delphi-Quellcode:

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.

Das ist die kompo jetzt.Leider wird sie nicht richtig dargestellt. Ich habe auf der Form ein durchsichtigen Teil (wo sich im Designer die Kompo befindet) wo ich mein Desktop durchsehen kann.Und beim Beenden der Anwendung kommt ein Fehler.
Es wäre super nett von dir Assarbad, wenn du mal ein Blick drauf werfen könntest und mir vielleicht sagen könntest, wo der Fehler liegt...

MFg Alex

[Alex_ITA01]

@assarbad: Könntest du mir vielleicht ein kleines Testprogramm zeigen, wie man eine VCL Klassen-Funktion als Win32 callback verwendet?
Ich bekomme es einfach nicht hin...
Es wäre echt nett wenn mir da jemand helfen könnte...
MFG Alex

[stoxx]

Zitat:

Zitat von Alex_ITA01

Könntest du mir vielleicht ein kleines Testprogramm zeigen, wie man eine VCL Klassen-Funktion als Win32 callback verwendet?

MFG Alex

Schau hier Seite 2:

http://www.delphipraxis.net/internal...ct.php?t=17992
Gruß stoxx