MouseWheel-Messages in Child-Komponente empfangen

[sirius]

(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 )

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

[bitsetter]

Hallo,

die Listbox auf deinem Formular hat bestimmt den Focus, wenn man die Listbox herunter nimmt oder mit form1.SetFocus den Focus auf das Formular setzt funktioniert dein Code mit Subclassing.
Oder soll das dann trotzdem funktionieren?

Edit: Über application.OnMessage könnte man wm_mousewheel ansonsten auch abfangen, dann wäre es egal welches Control den Fokus hat.

[sirius]

Danke!
Der Fokus lag nicht auf form1 sondern auf der Listbox
Wenn ich also keine Listbox, kein Memo ... kein sonstiges Wincontrol, was sich den Fokus schnappt benutze funktioniert das Subcalssing. ansonsten reicht es auch aus als "Focusedwindow einfach die Listbox zu übergeben:
  panel1:=tmypanel.Create(self,self.listbox1); Da ich aber nie weis, was auf dem Formular alles so drauf ist, bzw, was grad den Fokus hat, wäre ja das subclassen umständlicher als ein Hook. Und den Fokus immer auf mein Panel zu lenken ist auch nicht die Lösung.

Jetzt ist mir auch klar (und meine Welt ist wieder in Ordnung) warum in der Abarbeitung der Msg ständig diese CustomListbox auftaucht. Die Reihenfolge ging so:

Zitat:

user32.dll
stdwndProc (in Unit Classes)
TWincontrol.MainWndProc
TCustomListbox.WndProc
TWincontrol.WndProc
TControl.WndProc
TControl.WMMouseWheel

Und dann wurde das Mausrad bearbeitet. Und ich habe mich immer gefragt, wenn ich doch vor der StdWndProc sitze, müsste ich die Message auch bekommen. Aber nix kam an. Jetzt ist es klar. Ich saß vor der Falschen.
Also, das Subclassing führt nicht zum Ziel, da ich nie weis, wo ich grad subclassen muss. Und dafür ist ein Hook besser geeignet.

Aber jetzt kommt der Clou
Mich hat ja schon die ganze Zeit gewundert, dass die VCL sowas nicht anbietet. Bzw. ich habe es einfach nicht gefunden. TApplication.onMessage hat mich auf die Spur gebracht. TApplication.onMessage selber geht allerdings nicht. Da ich ja nur eine autarke Komponente schreiben will und nicht weis, was sonst noch so in der Anwendung passiert. Nicht das das Programm woanders noch Tapplication.OnMessage benutzt und ich es dann mit meiner Komponente netterweise überschreibe. Oder die Kompoente wird zweimal benutzt, weswegen ich ja auch umständlich versucht habe globale Variablen in der Unit zu vermeiden und diese Assemblerzeilen etc. entstanden. Deswegen ist Tapplication ungeeignet.

==> Solution
TApplicationEvents.OnMessage
So Simpel kann es sein.
Hier noch kurz der relevante Ausschnitt, er ist deutlich kürzer geworden

Delphi-Quellcode:

onstructor Tmypanel.create(AOwner:Tcomponent);
begin
  inherited create(Aowner);
  Appevent:=TApplicationEvents.Create(self);
  appevent.OnMessage:=DoOnMessage;
  label1:=tlabel.Create(self);
  label1.parent:=self;
  label1.top:=10;
  label1.Left:=10;
end;

procedure TmyPanel.DoOnMessage(var Msg: TMsg; var Handled: Boolean);
begin
  if msg.message=wm_mousewheel then begin
    label1.Caption:='Wheel: '+inttostr(smallint(hiword(msg.wParam)));
    form1.ListBox1.Items.Add('Wheel: '+inttostr(smallint(hiword(msg.wParam))));
  end;
end;

Danke bitsetter! Manchmal brauch man halt jemanden, der einem das Brett vorm Kopf entfernt