Delphi-PRAXiS - Delphi MouseWheel-Messages in Child-Komponente empfangen

(Ergänzung Titel: unter Berücksichtigung das die Child-Komponente keinen Fokus hat)

Ich habe hier zu meiner Frage auch gleich die Antwort parat. Allerdings finde ich die meinige Antwort recht unbefriedigend, da ich quasi mit Artillerie auf kleine Spatzen schieße. Vielleicht habe ich ja irgendetwas simples übersehen. Ich habe heute soviel rumprobiert, mir fällt nix anderes mehr ein.

Also hier erstmal zum Problem:
Ich bastel mir eine Komponente, die ich einfach mal von TPanel ableite. Darauf kommen noch weitere Kompos (z.B.: Buttons, Labels Images). Diese Komponente kann man natürlich dann auf irgend ein Formular setzen. Ich kann also derzeit nur die Komponente programmieren, auf das Formular habe ich keinen Einfluss.
Konkretes Problem: Ich brauche in meiner Komponente die Message "WM_MouseWheel".
Die bekomme ich aber nicht, da windows diese Message nur ans fokusierte Window schickt, also das übergeordnete Formular. Und auf das Formular habe ich keinen Einfluss.
Und hier ging meine Odyssee durch die VCL-Messageverarbeitung los. Weder WM_Mousewheel, noch CM_Mousewheel bringen irgendwie Erfolg (ausser natürlich im Formular selbst, was ich nicht will/kann; wobei da komischerweise auch nur cm_mousewheel ging :gruebel:)

Mein nächster Schritt war Subclassing. Ich dachte, wenn ich mich mit meiner Komponente einfach vor die WndProc-Funktion des Formulars setze, sollte ich ja alles Messages mitbekommen. Das ist auch fast passiert. "Fast'" bedeutet, wm_mousewheel war nicht dabei. Und ich weis auch nicht wieso.

Und dann habe ich die Artillerie namens lokalen Hook (wh_getmessage) rausgeholt und die trifft zuverlässig.
Was habe ich übersehen? Ich würde den Hook gerne vermeiden.

Ich hänge mal den Code für subclassing und für den lokalen hook hier rein. Vielleicht will sichs ja jemand ansehen. Oder, wenn es wirklich der einzige Weg ist, dann steht hier wenigstens eine Lösung:

Delphi-Quellcode:

			unit U_Mouse;

interface

uses

  Windows, Messages, SysUtils, Classes, Controls, Forms,

  StdCtrls, ExtCtrls;

type TmyPanel=class(TCustomPanel)

        constructor create(AOwner:TComponent; FocusedWindow:TWinControl); reintroduce;

        destructor Destroy;override;

      private

        FPage:pointer; //zeigt auf Adresse, die mit virtualalloc reserviert wird

        FSize:integer; //größe des reservierten Speichers

        //für Hookvariante

        FHook:hhook; //Handle des Hooks

        //für SubclassingVariante

        FFocusedWindowHandle:hwnd; //Handle des Windows (Formulars) zum subclassen

        FOldwndProc:integer; //alte WndProc des Formulars

        //Methode auf die alle Messages vom übergeordneten Formular gehen sollen

        procedure wndProcEx(var message:tmessage);

end;

type

  TForm1 = class(TForm)

    ListBox1: TListBox;

    procedure FormCreate(Sender: TObject);

  private

    { Private-Deklarationen }

    panel1:Tmypanel;

  public

    { Public-Deklarationen }

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

var Form:TCustomForm;

begin

  //erzeugen des Panels

  Form:=getparentform(self);

  panel1:=tmypanel.Create(self,Form);

  panel1.Parent:=self;

  panel1.Left:=10;

  panel1.Top:=10;

  panel1.width:=200;

  panel1.Height:=200;

end;

//jetzt folgen die zwei Varianten (subclassing und lokaler hook)

//EINE MUSS AUSKOMMENTIERT WERDEN

{********** Variante Subclassing ****************}

//vor scWndProc stehen noch folgende Variablen:

//@CallWindowProc

//FOldwindowproc

//@wndprocEx

//form1

function SCwndProc(wnd,msg,wparam,lparam:integer):integer;stdcall;

//Code (etwa):

//var x:Tmessage

//begin

//x.msg:=msg; x.wparam:=wparam; x.lparam:=lparam;

//wndprocex(x);

//if result<=0 then result:=CallWindowproc(FoldWindowProc,wnd,msg,wparam,lparam);

//end;

asm

  call @@n

@@n:

  pop ecx

  sub ecx,8

  mov eax,dword ptr [ecx-4]

  push ecx

  xor edx,edx

  push edx

  push lparam

  push wparam

  push msg

  mov edx,esp

  call [ecx-8]  //Methodenaufruf (wndprocEx) EAX=form1; EDX=x:Tmessage

  pop ecx

  pop ecx

  pop ecx

  pop eax

  pop ecx

  cmp eax,0

  jg @@1

  push ecx

  push lparam

  push wparam

  push msg

  push wnd

  push [ecx-12]

  call [ecx-16]

  pop ecx

@@1:

end;

procedure endpoint; asm nop end;

constructor tmypanel.create(AOwner:TComponent; FocusedWindow:TWinControl);

var size:integer;

    page:pointer;

    proc:pointer;

begin

  inherited create(AOwner);

  size:=integer(@endpoint)-integer(@SCwndProc);

  Fsize:=size+16;

  page:=virtualalloc(nil,Fsize,Mem_commit,Page_execute_readwrite);

  FPage:=page;

  FoldwndProc:=getwindowlong(FocusedWindow.Handle,gwl_wndproc);

  asm

    //Adresse von Callwindowproc in Win-API ermitteln

    push eax

    lea eax,dword ptr windows.Callwindowproc

    add eax,2

    mov eax,[eax]

    mov eax,[eax]

    mov proc,eax

    pop eax

  end;

  move(proc,page^,4);

  asm add page,4 end;

  move(Foldwndproc,page^,4);

  asm

    //Adresse aus Methodenzeiger holen

    push eax

    lea eax,dword ptr wndprocex

    mov proc,eax

    pop eax

  end;

  asm add page,4 end;

  move(proc,page^,4);

  asm add page,4 end;

  move(self,page^,4);

  asm add page,4 end;

  move(Scwndproc,page^,size);

  FfocusedwindowHandle:=focusedwindow.Handle;

  setwindowlong(focusedwindow.Handle,gwl_wndproc,integer(Page));

end;

destructor tmypanel.Destroy;

begin

  setwindowlong(FfocusedwindowHandle,gwl_wndproc,integer(FOldWndProc));

  virtualfree(fPage,Fsize,mem_decommit);

  inherited destroy;

end;

{******* Variante Hook **************}

////vor hookproc stehen noch folgende Variablen:

//form1

//@CallnextHookEx

//@wndprocEx

//hookhandle = Fhook

function realHookProc(addr:ppointer;code,wparam,lparam:integer):integer;stdcall;forward;

procedure HookProc;

//ergänzen von addr in der Parameterliste mit der Adresse der Funktion

//um auf die 4 Variablen vor der Funktion zugreifen zu können

asm

  call @@n

@@n:

  pop eax

  sub eax,5

  pop edx

  push eax

  push edx

  jmp realhookproc

end;

function realHookProc(addr:ppointer;code,wparam,lparam:integer):integer;stdcall;

var CallNexthook:function(hhk:hhook;code,wparam,lparam:integer):integer;stdcall;

    hookhandle:hhook;

    oldwindowproc:pointer;

    obj:Tobject;

    mymsg:pmsg;

    msg:Tmessage;

    wndprocresult:integer;

begin

  //die 4 Variablen von vor der Funktion holen

  dec(addr);

  obj:=addr^;

  dec(addr);

  callnexthook:=addr^;

  dec(addr);

  oldwindowproc:=addr^;

  dec(addr);

  hookhandle:=cardinal(addr^);

  if code=hc_action then begin

    mymsg:=pmsg(lparam);

    msg.Msg:=mymsg.message;

    msg.WParam:=mymsg.wParam;

    msg.LParam:=mymsg.lParam;

    msg.Result:=0;

    asm

      //aus Adressen wieder einen Methodenaufruf realisieren

      mov eax,dword ptr obj

      lea edx,dword ptr msg

      call oldwindowproc

      mov wndprocresult,eax

    end;

  end;

  if hookhandle<>0 then result:=callnexthook(hookhandle,code,wparam,lparam)

                   else result:=wndprocresult;

end;

procedure endpoint; asm nop end;

constructor tmypanel.create(AOwner:TComponent; FocusedWindow:TWinControl);

var size:integer;

    page:pointer;

    proc:pointer;

    hookhandle:hhook;

begin

  inherited create(AOwner);

  hookhandle:=0;

  size:=integer(@endpoint)-integer(@Hookproc);

  Fsize:=size+16;

  page:=virtualalloc(nil,Fsize,Mem_commit,Page_execute_readwrite);

  FPage:=page;

  move(hookhandle,page^,4);

  asm add page,4 end;

  asm

    push eax

    lea eax,dword ptr wndprocex

    mov proc,eax

    pop eax

  end;

  move(proc,page^,4);

  asm add page,4 end;

  asm

    push eax

    lea eax,dword ptr windows.CallNexthookEx

    add eax,2

    mov eax,[eax]

    mov eax,[eax]

    mov proc,eax

    pop eax

  end;

  move(proc,page^,4);

  asm add page,4 end;

  move(self,page^,4);

  asm add page,4 end;

  move(hookproc,page^,size);

  fhook:=setwindowshookex(wh_getmessage,page,0,getcurrentthreadid);

  move(fhook,fpage^,4);

end;

destructor tmypanel.Destroy;

begin

  unhookwindowshookex(fhook);

  virtualfree(fPage,Fsize,mem_decommit);

  inherited destroy;

end;

{**** meine neue/alternative WindowProc ************}

procedure tmypanel.wndProcEx(var message:Tmessage);

var form:tform1;

begin

  form:=tform1(self.Parent);

  if (message.Msg=wm_mousewheel)  then begin

    form.ListBox1.Items.Add('Wheel: '+inttostr(smallint(message.wparamhi)));

    while form.ListBox1.Items.count>30 do form.ListBox1.Items.Delete(0);

  end;

end;

end.

Ich habe beide Varianten im Code gelassen. Zum testen muss die nichtverwendete natürlich gelöscht/auskommentiert werden.
Edit: Beide Varianten bedeutet trotzdem noch, dass nur eine davon funktioniert (Hook).