Implemented dedicated mouse wheel event in FV.

packages/fv/src/dialogs.inc

@@ -3621,8 +3621,7 @@ END;
 {---------------------------------------------------------------------------}
 PROCEDURE THistoryViewer.HandleEvent (Var Event: TEvent);
 BEGIN
-   If ((Event.What = evMouseDown) AND (Event.Double)  { Double click mouse }
-       and ((Event.Buttons and (mbScrollUp or mbScrollDown))=0)){and not scroll}
+   If (Event.What = evMouseDown) AND (Event.Double)   { Double click mouse }
    OR ((Event.What = evKeyDown) AND
    (Event.KeyCode = kbEnter)) Then Begin              { Enter key press }
      EndModal(cmOk);                                  { End with cmOk }

packages/fv/src/drivers.inc

@@ -183,6 +183,8 @@ CONST
    evMouseUp   = $0002;                               { Mouse up event }
    evMouseMove = $0004;                               { Mouse move event }
    evMouseAuto = $0008;                               { Mouse auto event }
+   { Idea of evMouseWheel to be separate event type comes from https://github.com/magiblot/tvision }
+   evMouseWheel= $0020;                               { Mouse wheel event }
    evKeyDown   = $0010;                               { Key down event }
    evCommand   = $0100;                               { Command event }
    evBroadcast = $0200;                               { Broadcast event }
@@ -192,7 +194,7 @@ CONST
 {---------------------------------------------------------------------------}
 CONST
    evNothing   = $0000;                               { Empty event }
-   evMouse     = $000F;                               { Mouse event }
+   evMouse     = $002F;                               { Mouse event }
    evKeyboard  = $0010;                               { Keyboard event }
    evMessage   = $FF00;                               { Message event }
 
@@ -297,13 +299,19 @@ CONST
    mbLeftButton      = $01;                           { Left mouse button }
    mbRightButton     = $02;                           { Right mouse button }
    mbMiddleButton    = $04;                           { Middle mouse button }
-   mbScrollWheelDown = $08 deprecated 'use mbScrollDown instead';
-   mbScrollWheelUp   = $10 deprecated 'use mbScrollUp instead';
-   mbScrollDown      = $08;                           { Scroll down - turn the wheel downward (toward you) }
-   mbScrollUp        = $10;                           { Scroll up - turn the wheel upward (away from you) }
+   mbScrollWheelDown = $08 deprecated 'use evMouseWheel event and mwDown instead';
+   mbScrollWheelUp   = $10 deprecated 'use evMouseWheel event and mwUp instead';
    mbXButton1        = $20;                           { 4th mouse button. Browser_Back }
    mbXButton2        = $40;                           { 5th mouse button. Browser_Forward }
 
+{---------------------------------------------------------------------------}
+{                         MOUSE WHEEL STATES                                }
+{---------------------------------------------------------------------------}
+CONST
+   mwUp     = $01;      { Scroll up - turn the wheel upward (away from you) }
+   mwDown   = $02;      { Scroll down - turn the wheel downward (toward you) }
+   mwLeft   = $04;      { not implemented }
+   mwRight  = $08;      { not implemented }
 
 {---------------------------------------------------------------------------}
 {                         SCREEN CRT MODE CONSTANTS                         }
@@ -338,6 +346,7 @@ TYPE
         evNothing: ();                                { ** NO EVENT ** }
         evMouse: (
           Buttons: Byte;                              { Mouse buttons }
+          Wheel:   Byte;                              { Mouse wheel }
           Double: Boolean;                            { Double click state }
           Triple: Boolean;                            { Triple click state }
           Where: TPoint);                             { Mouse position }
@@ -804,8 +813,8 @@ CONST
 {---------------------------------------------------------------------------}
 VAR
    LastDouble : Boolean;                              { Last double buttons }
-   LastButtons: Byte;                                 { Last button state }
-   DownButtons: Byte;                                 { Last down buttons }
+   LastButtons: Word;                                 { Last button state }
+   DownButtons: Word;                                 { Last down buttons }
    EventCount : Sw_Word;                                 { Events in queue }
    AutoDelay  : Sw_Word;                                 { Delay time count }
    DownTicks  : Sw_Word;                                 { Down key tick count }
@@ -1411,7 +1420,7 @@ begin
               (GetDosTicks-DownTicks<=DoubleDelay) then
            begin
              Event.Double:=true;
-             if LastDouble and ((e.Buttons and( mbScrollUp or mbScrollDown)) = 0) then
+             if LastDouble and ((e.Buttons and( MouseButton4 or MouseButton5)) = 0) then
              begin              {only "normal" buttons can produce triple click}
                Event.Double:=false;
                Event.Triple:=true;
@@ -1428,6 +1437,16 @@ begin
            if AutoTicks=0 then
              AutoTicks:=1;
            AutoDelay:=RepeatDelay;
+           if (e.Buttons and (MouseButton4 or MouseButton5))<>0 then
+           begin
+             Event.What:=evMouseWheel; { Mouse wheel event not mouse down }
+             case e.Buttons and (MouseButton4 or MouseButton5) of
+               MouseButton4: Event.Wheel:=mwUp;
+               MouseButton5: Event.Wheel:=mwDown;
+             end;
+             e.Buttons:=e.Buttons and( not word( MouseButton4 or MouseButton5)); {remove wheel buttons for Buttons}
+             AutoTicks:=0;  {there is no "holding down" mouse wheel }
+           end;
          end;
        MouseActionUp :
          begin

packages/fv/src/editors.pas

@@ -1354,7 +1354,7 @@ begin
   GrowMode := gfGrowHiX + gfGrowHiY;
   Options := Options or ofSelectable;
   Flags := EditorFlags;
-  EventMask := evMouseDown + evKeyDown + evCommand + evBroadcast;
+  EventMask := evMouseWheel + evMouseDown + evKeyDown + evCommand + evBroadcast;
   ShowCursor;
 
   HScrollBar := AHScrollBar;
@@ -2046,21 +2046,24 @@ begin
   if Selecting or (ShiftState and $03 <> 0) then
     SelectMode := smExtend;
   case Event.What of
-    {$IFDEF FPC_DOTTEDUNITS}FreeVision.{$ENDIF}Drivers.evMouseDown:
+    evMouseWheel:
       begin
-        if (Event.Buttons=mbScrollUp) then { mouse scroll up}
+        if (Event.Wheel=mwDown) then { Mouse scroll down}
           begin
             LinesScroll:=1;
             if Event.Double then LinesScroll:=LinesScroll+4;
             ScrollTo(Delta.X, Delta.Y + LinesScroll);
           end else
-        if (Event.Buttons=mbScrollDown) then  { mouse scroll down }
+        if (Event.Wheel=mwUp) then  { Mouse scroll up }
           begin
             LinesScroll:=-1;
             if Event.Double then LinesScroll:=LinesScroll-4;
             ScrollTo(Delta.X, Delta.Y + LinesScroll);
-          end else
-        begin
+          end
+        else exit;
+      end;
+    evMouseDown:
+      begin
         if Event.Double then
           SelectMode := SelectMode or smDouble;
         repeat
@@ -2083,10 +2086,9 @@ begin
           SelectMode := SelectMode or smExtend;
           Unlock;
         until not MouseEvent (Event, evMouseMove + evMouseAuto);
-        end;
-      end; { {$IFDEF FPC_DOTTEDUNITS}FreeVision.{$ENDIF}Drivers.evMouseDown }
+      end; { evMouseDown }
 
-    {$IFDEF FPC_DOTTEDUNITS}FreeVision.{$ENDIF}Drivers.evKeyDown:
+    evKeyDown:
       case Event.CharCode of
         #32..#255:
           begin

packages/fv/src/stddlg.pas

@@ -1022,8 +1022,7 @@ var
   K : pointer;
   Value : Sw_integer;
 begin
-  if (Event.What = evMouseDown) and (Event.Double) { double click and not scroll}
-      and ((Event.Buttons and (mbScrollUp or mbScrollDown))=0) then
+  if (Event.What = evMouseDown) and (Event.Double) then
   begin
     Event.What := evCommand;
     Event.Command := cmOK;
@@ -1868,7 +1867,7 @@ procedure TDirListBox.HandleEvent(var Event: TEvent);
 begin
   case Event.What of
     evMouseDown:
-      if Event.Double and ((Event.Buttons and (mbScrollUp or mbScrollDown))=0) then
+      if Event.Double then
       begin
    Event.What := evCommand;
    Event.Command := cmChangeDir;

packages/fv/src/views.inc

@@ -3111,6 +3111,7 @@ const
 {$endif FV_UNICODE}
 BEGIN
    Inherited Init(Bounds);                            { Call ancestor }
+   EventMask:=EventMask or evMouseWheel;              { Respond to mouse scroll}
    PgStep := 1;                                       { Page step size = 1 }
    ArStep := 1;                                       { Arrow step sizes = 1 }
    If (Size.X = 1) Then Begin                         { Vertical scrollbar }
@@ -3321,6 +3322,25 @@ BEGIN
          SetValue(I);                                 { Set new item }
          ClearEvent(Event);                           { Event now handled }
      End;
+     evMouseWheel: Begin
+        Clicked;
+        if Event.Wheel=mwDown then                    { Mouse scroll down}
+        begin
+          if (arStep<>1) or not Event.double then
+            SetValue(Value+arStep)
+          else
+            SetValue(Value+6); {fixed step is bad, use it for now. Yet to be implemented ScrollSetp}
+          ClearEvent(Event);                           { Event now handled }
+        end else
+        if Event.Wheel=mwUp then                       { Mouse scroll up}
+        begin
+          if (arStep<>1) or not Event.double then
+            SetValue(Value-arStep)
+          else
+            SetValue(Value-6); {fixed step is bad, use it for now. Yet to be implemented ScrollSetp}
+          ClearEvent(Event);                           { Event now handled }
+        end;
+      end;
      evMouseDown: Begin                               { Mouse press event }
          Clicked;                                     { Scrollbar clicked }
          MakeLocal(Event.Where, Mouse);                 { Localize mouse }
@@ -3436,7 +3456,7 @@ CONSTRUCTOR TScroller.Init (Var Bounds: TRect; AHScrollBar, AVScrollBar: PScroll
 BEGIN
    Inherited Init(Bounds);                            { Call ancestor }
    Options := Options OR ofSelectable;                { View is selectable }
-   EventMask := EventMask OR evBroadcast;             { See broadcasts }
+   EventMask := EventMask OR evBroadcast OR evMouseWheel; { See broadcasts and mouse wheel }
    HScrollBar := AHScrollBar;                         { Hold horz scrollbar }
    VScrollBar := AVScrollBar;                         { Hold vert scrollbar }
 END;
@@ -3526,19 +3546,21 @@ var LinesScroll  : Sw_Integer;
 BEGIN
    Inherited HandleEvent(Event);                      { Call ancestor }
    case Event.What of
-    evMouseDown:
+    evMouseWheel:
       begin
-        if (Event.Buttons=mbScrollUp) then { mouse scroll up}
+        if (Event.Wheel=mwDown) then                  { Mouse scroll down}
           begin
             LinesScroll:=1;
             if Event.Double then LinesScroll:=LinesScroll+4;
             ScrollTo(Delta.X, Delta.Y + LinesScroll);
+            ClearEvent(Event);                        { Event was handled }
           end else
-        if (Event.Buttons=mbScrollDown) then  { mouse scroll down }
+        if (Event.Wheel=mwUp) then                    { Mouse scroll up }
           begin
             LinesScroll:=-1;
             if Event.Double then LinesScroll:=LinesScroll-4;
             ScrollTo(Delta.X, Delta.Y + LinesScroll);
+            ClearEvent(Event);                        { Event was handled }
           end;
       end;
    end;
@@ -3575,7 +3597,7 @@ CONSTRUCTOR TListViewer.Init (Var Bounds: TRect; ANumCols: Sw_Word; AHScrollBar,
 BEGIN
    Inherited Init(Bounds);                            { Call ancestor }
    Options := Options OR (ofFirstClick+ofSelectable); { Set options }
-   EventMask := EventMask OR evBroadcast;             { Set event mask }
+   EventMask := EventMask OR evBroadcast OR evMouseWheel; { Set event mask }
    NumCols := ANumCols;                               { Hold column number }
    LastY:=0;
    If (AHScrollBar <> Nil) Then
@@ -3867,18 +3889,20 @@ BEGIN
              Then DrawView;                           { Redraw the view }
          End;
      End;
-     evMouseDown: Begin                               { Mouse down event }
-       if (Event.Buttons=mbScrollUp) then             { mouse scroll up}
+     evMouseWheel:                                    { Mouse wheel event }
+       if (Event.Wheel=mwDown) then                   { Mouse scroll down }
          begin
            if NumCols>1 then ScrollTo(TopItem+Size.Y)
            else if Event.Double then ScrollTo(TopItem+4) else ScrollTo(TopItem+1);
+           ClearEvent(Event);                         { Event was handled }
          end else
-       if (Event.Buttons=mbScrollDown) then           { mouse scroll down }
+       if (Event.Wheel=mwUp) then                     { Mouse scroll up }
          begin
            if NumCols>1 then ScrollTo(TopItem-Size.Y)
            else if Event.Double then ScrollTo(TopItem-4) else ScrollTo(TopItem-1);
-         end else
-       begin
+           ClearEvent(Event);                         { Event was handled }
+         end;
+     evMouseDown: Begin                               { Mouse down event }
        Cw := Size.X DIV NumCols + 1;                  { Column width }
        Oi := Focused;                                 { Hold focused item }
        MakeLocal(Event.Where, Mouse);                 { Localize mouse }
@@ -3919,7 +3943,6 @@ BEGIN
        If (Oi <> Ni) Then MoveFocus(Ni);              { Focus moved again }
        If (Event.Double AND (Range > Focused)) Then
          SelectItem(Focused);                         { Select the item }
-       end;
        ClearEvent(Event);                             { Event was handled }
      End;
    End;