mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-05 23:31:49 +02:00
Implemented dedicated mouse wheel event in FV.
This commit is contained in:
Margers
Michael Van Canneyt
parent
89af29c27f
commit
4b271d8e0e
@ -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 }
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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,20 +2046,23 @@ 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
|
||||
end
|
||||
else exit;
|
||||
end;
|
||||
evMouseDown:
|
||||
begin
|
||||
if Event.Double then
|
||||
SelectMode := SelectMode or smDouble;
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user