horizontal scrolling, commit 1

3 files changed, 84 insertions, 37 deletions

diff --git a/src/corelib/fpg_widget.pas b/src/corelib/fpg_widget.pas
index a74c1b30..ae18ff98 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;
@@ -56,6 +58,7 @@ type
     FOnMouseMove: TMouseMoveEvent;
     FOnMouseUp: TMouseButtonEvent;
     FOnMouseScroll: TMouseWheelEvent;
+    FOnMouseHorizScroll: TMouseWheelEvent;
     FOnPaint: TPaintEvent;
     FOnKeyPress: TKeyPressEvent;
     FOnResize: TNotifyEvent;
@@ -81,6 +84,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
@@ -134,6 +138,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;
@@ -153,6 +158,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;
@@ -854,6 +860,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
@@ -1189,6 +1201,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 20974dfe..27f59abe 100644
--- a/src/corelib/x11/fpg_x11.pas
+++ b/src/corelib/x11/fpg_x11.pas
@@ -1749,31 +1749,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/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas
index 3b0e445f..cc8bf0a6 100644
--- a/src/gui/fpg_basegrid.pas
+++ b/src/gui/fpg_basegrid.pas
@@ -135,6 +135,7 @@ type
     procedure   HandleResize(awidth, aheight: TfpgCoord); override;
     procedure   HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
     procedure   HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override;
+    procedure   HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override;
     procedure   HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override;
     procedure   HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override;
     procedure   HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override;
@@ -1164,43 +1165,52 @@ end;
 procedure TfpgBaseGrid.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint);
 var
   lRow: Integer;
-  lCol: Integer;
 begin
   inherited HandleMouseScroll(x, y, shiftstate, delta);
 
   lRow := FFirstRow;
-  lCol := FFirstCol;
 
-  if delta > 0 then // scroll down
-    inc(FFirstRow, abs(delta)*3)
-  else              // scroll up
-    if FFirstRow > 0 then
-      dec(FFirstRow, abs(delta)*3);
+  // If vertical scrollbar is not visible, but
+  // horizontal is, Mouse wheel will scroll horizontally.  :)
+  if FHScrollBar.Visible and (not FVScrollBar.Visible) then
+  begin
+    HandleMouseHorizScroll(x, y, shiftstate, delta);
+    Exit;
+  end;
+
+  inc(FFirstRow, delta*3);
 
   // apply limits
   if FFirstRow > RowCount - VisibleLines then
     FFirstRow := RowCount - VisibleLines;
   if FFirstRow < 0 then
     FFirstRow := 0;
-    
-  // scroll left/right
-  // If vertical scrollbar is not visible, but
-  // horizontal is. Mouse wheel will scroll horizontally.  :)
-  if FHScrollBar.Visible and (not FVScrollBar.Visible) then
+
+  if lRow <> FFirstRow then
   begin
-    if delta > 0 then // scroll right
-    begin
-      if FFirstCol < (ColumnCount-1) then
-        inc(FFirstCol);
-    end
-    else
-    begin
-      if FFirstCol > 0 then
-        dec(FFirstCol);
-    end;
+    UpdateScrollBars;
+    RePaint;
+  end;
+end;
+
+procedure TfpgBaseGrid.HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint);
+var
+  lCol: Integer;
+begin
+  inherited HandleMouseHorizScroll(x, y, shiftstate, delta);
+
+  lCol := FFirstCol;
+
+  if go_SmoothScroll in Options then
+  begin
+    ;
+  end
+  else
+  begin
+    inc(FFirstCol, delta);
   end;
 
-  if (lRow <> FFirstRow) or (lCol <> FFirstCol) then
+  if lCol <> FFirstCol then
   begin
     UpdateScrollBars;
     RePaint;