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.