Merge remote-tracking branch 'demerson/scroll-frame' into 'develop'

5 files changed, 59 insertions, 17 deletions

diff --git a/src/corelib/fpg_base.pas b/src/corelib/fpg_base.pas
index ea108b61..eee90d4a 100644
--- a/src/corelib/fpg_base.pas
+++ b/src/corelib/fpg_base.pas
@@ -121,6 +121,7 @@ const
   FPGM_FREEME      = 19;
   FPGM_DROPENTER   = 20;
   FPGM_DROPEXIT    = 21;
+  FPGM_HSCROLL      = 22;
   FPGM_USER        = 50000;
   FPGM_KILLME      = MaxInt;
 
diff --git a/src/corelib/fpg_widget.pas b/src/corelib/fpg_widget.pas
index 8fb68a04..527e2987 100644
--- a/src/corelib/fpg_widget.pas
+++ b/src/corelib/fpg_widget.pas
@@ -39,6 +39,8 @@ type
   TfpgDragDropEvent = procedure(Sender, Source: TObject; X, Y: integer; AData: variant) of object;
 
 
+  { TfpgWidget }
+
   TfpgWidget = class(TfpgWindow)
   private
     FAcceptDrops: boolean;
@@ -57,6 +59,7 @@ type
     FOnMouseMove: TMouseMoveEvent;
     FOnMouseUp: TMouseButtonEvent;
     FOnMouseScroll: TMouseWheelEvent;
+    FOnMouseHorizScroll: TMouseWheelEvent;
     FOnPaint: TPaintEvent;
     FOnKeyPress: TKeyPressEvent;
     FOnResize: TNotifyEvent;
@@ -82,6 +85,7 @@ type
     procedure   MsgMouseEnter(var msg: TfpgMessageRec); message FPGM_MOUSEENTER;
     procedure   MsgMouseExit(var msg: TfpgMessageRec); message FPGM_MOUSEEXIT;
     procedure   MsgMouseScroll(var msg: TfpgMessageRec); message FPGM_SCROLL;
+    procedure   MsgMouseHorizScroll(var msg: TfpgMessageRec); message FPGM_HSCROLL;
     procedure   MsgDropEnter(var msg: TfpgMessageRec); message FPGM_DROPENTER;
     procedure   MsgDropExit(var msg: TfpgMessageRec); message FPGM_DROPEXIT;
   protected
@@ -135,6 +139,7 @@ type
     procedure   HandleMouseEnter; virtual;
     procedure   HandleMouseExit; virtual;
     procedure   HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); virtual;
+    procedure   HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); virtual;
     function    FindFocusWidget(startwg: TfpgWidget; direction: TFocusSearchDirection): TfpgWidget;
     procedure   HandleAlignments(const dwidth, dheight: TfpgCoord); virtual;
     procedure   HandleShow; virtual;
@@ -155,6 +160,7 @@ type
     property    OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
     property    OnMouseUp: TMouseButtonEvent read FOnMouseUp write FOnMouseUp;
     property    OnMouseScroll: TMouseWheelEvent read FOnMouseScroll write FOnMouseScroll;
+    property    OnMouseHorizScroll: TMouseWheelEvent read FOnMouseHorizScroll write FOnMouseHorizScroll;
     property    OnPaint: TPaintEvent read FOnPaint write FOnPaint;
     property    OnResize: TNotifyEvent read FOnResize write FOnResize;
     property    OnShowHint: THintEvent read GetOnShowHint write SetOnShowHint;
@@ -862,6 +868,12 @@ begin
       msg.Params.mouse.shiftstate, msg.Params.mouse.delta);
 end;
 
+procedure TfpgWidget.MsgMouseHorizScroll(var msg: TfpgMessageRec);
+begin
+  HandleMouseHorizScroll(msg.Params.mouse.x, msg.Params.mouse.y,
+      msg.Params.mouse.shiftstate, msg.Params.mouse.delta);
+end;
+
 procedure TfpgWidget.MsgDropEnter(var msg: TfpgMessageRec);
 begin
   // do nothing
@@ -1201,6 +1213,12 @@ begin
     FOnMouseScroll(self, shiftstate, delta, Point(x, y));
 end;
 
+procedure TfpgWidget.HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint);
+begin
+  if Assigned(FOnMouseHorizScroll) then
+    FOnMouseHorizScroll(self, shiftstate, delta, Point(x, y));
+end;
+
 function TfpgWidget.FindFocusWidget(startwg: TfpgWidget; direction: TFocusSearchDirection): TfpgWidget;
 var
   w: TfpgWidget;
diff --git a/src/corelib/x11/fpg_x11.pas b/src/corelib/x11/fpg_x11.pas
index ca147772..569772ae 100644
--- a/src/corelib/x11/fpg_x11.pas
+++ b/src/corelib/x11/fpg_x11.pas
@@ -1842,31 +1842,50 @@ begin
           if not blockmsg then
           begin
             if (ev.xbutton.button >= 4) and (ev.xbutton.button <= 7) then  // mouse wheel
+            // 4=up, 5=down, 6=left, 7=right
             begin
               // generate scroll events:
               if ev._type = X.ButtonPress then
               begin
-                if ev.xbutton.button = Button4 then
+                if (ev.xbutton.button = Button4) or (ev.xbutton.button = 6) then // x.pp lacks Button6, Button7
                   i := -1
                 else
                   i := 1;
 
         	      // Check for other mouse wheel messages in the queue
-                while XCheckTypedWindowEvent(display, ev.xbutton.window, X.ButtonPress, @NewEvent) do
-                begin
-      	          if NewEvent.xbutton.Button = 4 then
-      	            Dec(i)
-                  else if NewEvent.xbutton.Button = 5 then
-      	            Inc(i)
-                  else
-            	    begin
-            	      XPutBackEvent(display, @NewEvent);
-                    break;
-            	    end;
-                end;
+                if ev.xbutton.button in [Button4,Button5] then
+                  while XCheckTypedWindowEvent(display, ev.xbutton.window, X.ButtonPress, @NewEvent) do
+                  begin
+      	            if NewEvent.xbutton.Button = 4 then
+      	              Dec(i)
+                    else if NewEvent.xbutton.Button = 5 then
+      	              Inc(i)
+                    else
+            	      begin
+            	        XPutBackEvent(display, @NewEvent);
+                      break;
+            	      end;
+                  end
+                else // button is 6 or 7
+                  while XCheckTypedWindowEvent(display, ev.xbutton.window, X.ButtonPress, @NewEvent) do
+                  begin
+    	              if NewEvent.xbutton.Button = 6 then
+    	                Dec(i)
+                    else if NewEvent.xbutton.Button = 7 then
+    	                Inc(i)
+                    else
+          	        begin
+          	          XPutBackEvent(display, @NewEvent);
+                      break;
+          	        end;
+                  end;
 
                 msgp.mouse.delta := i;
-                fpgPostMessage(nil, w, FPGM_SCROLL, msgp);
+
+                if ev.xbutton.button in [Button4,Button5] then
+                  fpgPostMessage(nil, w, FPGM_SCROLL, msgp)
+                else
+                  fpgPostMessage(nil, w, FPGM_HSCROLL, msgp);
               end;
             end
             else
diff --git a/src/corelib/x11/fpgui_toolkit.lpk b/src/corelib/x11/fpgui_toolkit.lpk
index 7793f989..d5ad23c8 100644
--- a/src/corelib/x11/fpgui_toolkit.lpk
+++ b/src/corelib/x11/fpgui_toolkit.lpk
@@ -29,7 +29,7 @@
     <Description Value="fpGUI Toolkit"/>
     <License Value="LGPL 2 with static linking exception."/>
     <Version Major="1"/>
-    <Files Count="105">
+    <Files Count="106">
       <Item1>
         <Filename Value="../stdimages.inc"/>
         <Type Value="Include"/>
@@ -450,6 +450,10 @@
         <Filename Value="../../gui/fpg_style_win8.pas"/>
         <UnitName Value="fpg_style_win8"/>
       </Item105>
+      <Item106>
+        <Filename Value="../../gui/fpg_scrollframe.pas"/>
+        <UnitName Value="fpg_scrollframe"/>
+      </Item106>
     </Files>
     <LazDoc Paths="../../../docs/xml/corelib;../../../docs/xml/corelib/x11;../../../docs/xml/corelib/gdi;../../../docs/xml/gui"/>
     <RequiredPkgs Count="1">
diff --git a/src/corelib/x11/fpgui_toolkit.pas b/src/corelib/x11/fpgui_toolkit.pas
index d6855fc9..86e456f4 100644
--- a/src/corelib/x11/fpgui_toolkit.pas
+++ b/src/corelib/x11/fpgui_toolkit.pas
@@ -22,8 +22,8 @@ uses
   fpg_stylemanager, fpg_style_win2k, fpg_style_motif, fpg_style_clearlooks, 
   fpg_style_bluecurve, fpg_style_bitmap, fpg_readonly, fpg_imgfmt_png, 
   U_Command, U_Pdf, U_Report, U_ReportImages, U_Visu, fpg_trayicon, Agg2D, 
-  fpg_dbugintf, fpg_dbugmsg, fpg_fontcache, fpg_style_carbon, 
-  fpg_style_plastic, fpg_style_win8;
+  fpg_dbugintf, fpg_dbugmsg, fpg_fontcache, fpg_style_carbon,
+  fpg_style_plastic, fpg_style_win8, fpg_scrollframe;
 
 implementation