* Fixed the mouse wheel support under Windows.

3 files changed, 41 insertions, 21 deletions

diff --git a/prototypes/fpgui2/examples/core/eventtest/eventtest.lpr b/prototypes/fpgui2/examples/core/eventtest/eventtest.lpr
index 56cadd16..30ed822e 100644
--- a/prototypes/fpgui2/examples/core/eventtest/eventtest.lpr
+++ b/prototypes/fpgui2/examples/core/eventtest/eventtest.lpr
@@ -167,8 +167,11 @@ begin
 end;
 
 procedure TMainForm.MsgScroll(var msg: TfpgMessageRec);
+var
+  delta: smallint;
 begin
-  Writeln('Mouse scroll delta=' + IntToStr(msg.Params.mouse.x) + ' button=' + IntToStr(msg.Params.mouse.Buttons));
+  delta := msg.Params.mouse.delta;
+  Writeln('Mouse scroll delta=' + IntToStr(delta) + ' button=' + IntToStr(msg.Params.mouse.Buttons));
 end;
 
 constructor TMainForm.Create(aowner: TComponent);
diff --git a/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas b/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas
index 465f8818..58f3d611 100644
--- a/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas
+++ b/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas
@@ -278,8 +278,10 @@ end;
 function fpgWindowProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
 var
   w: TfpgWindowImpl;
-  kwg, mwg: TfpgWidget;
-  kcode, i: integer;
+  kwg: TfpgWidget;
+  mw: TfpgWindowImpl;
+  kcode: integer;
+  i: integer;
   sstate: integer;
   h: THANDLE;
   p: PChar;
@@ -483,27 +485,42 @@ begin
       fpgSendMessage(nil, w, FPGM_MOVE, msgp);
     end;
 
-    (*
     WM_MOUSEWHEEL:
     begin
       //writeln('MWHEEL: wp=',IntToHex(wparam,8), ' lp=',IntToHex(lparam,8)); // and $FF00) shr 8);
-
-      pt.x := (lParam and $FFFF);
-      pt.y := ((lParam and $FFFF0000) shr 16);
-
-      h := WindowFromPoint(pt); //, CWP_SKIPINVISIBLE or CWP_SKIPDISABLED);
-      if h > 0 then
-      begin
-        wg := TWidget(Windows.GetWindowLong(h, GWL_USERDATA));
-      end;
-
-      if wg <> nil then
+      pt.x := LoWord(lparam);
+      pt.y := HiWord(lparam);
+      mw   := nil;
+      h    := WindowFromPoint(pt);
+      if h > 0 then  // get window mouse is hovering over
+        mw := TfpgWindowImpl(Windows.GetWindowLong(h, GWL_USERDATA));
+
+      if mw <> nil then
       begin
-        if int(wParam) < 0 then SendMessage(nil, wg, MSG_SCROLL, 1, 3, 0)
-                           else SendMessage(nil, wg, MSG_SCROLL, 0, 3, 0);
+        msgp.mouse.x := pt.x;
+        msgp.mouse.y := pt.y;
+        msgp.mouse.delta := SmallInt(HiWord(wParam)) div -120;
+        
+        i := 0;
+        if (wParam and MK_LBUTTON) <> 0 then
+          i := i or MOUSE_LEFT;
+        if (wParam and MK_RBUTTON) <> 0 then
+          i := i or MOUSE_RIGHT;
+        if (wParam and MK_MBUTTON) <> 0 then
+          i := i or MOUSE_MIDDLE;
+        msgp.mouse.Buttons := i;
+
+        sstate := 0;
+        if (wParam and MK_CONTROL) <> 0 then
+          sstate := sstate or ss_control;
+        if (wParam and MK_SHIFT) <> 0 then
+          sstate := sstate or ss_shift;
+        msgp.mouse.shiftstate := sstate;
+
+        fpgSendMessage(nil, mw, FPGM_SCROLL, msgp)
       end;
     end;
-*)
+
     WM_ACTIVATE:
       if ((wParam and $FFFF) = WA_INACTIVE) then
         fpgSendMessage(nil, w, FPGM_DEACTIVATE)
@@ -694,11 +711,10 @@ begin
     //finally
       //Event.Free;
     //end;
-//    msgp.mouse.x := LoWord(lParam);
-//    msgp.mouse.y := HiWord(lParam);
     fpgSendMessage(nil, AWindow, FPGM_MOUSEENTER, msgp);
     Result := uMsg <> WM_MOUSEMOVE;
-  end else
+  end
+  else
   begin
     pt.x := LoWord(lParam);
     pt.y := HiWord(lParam);
diff --git a/prototypes/fpgui2/source/core/gfxbase.pas b/prototypes/fpgui2/source/core/gfxbase.pas
index a245a033..b01e63fb 100644
--- a/prototypes/fpgui2/source/core/gfxbase.pas
+++ b/prototypes/fpgui2/source/core/gfxbase.pas
@@ -115,6 +115,7 @@ type
     y: TfpgCoord;
     Buttons: word;
     shiftstate: word;
+    delta: word;
   end;