paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 12:39:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Extend horizontal mouse wheel messages for Carbon and Cocoa. Remove ssHyper. Issue #32753, patch from AlexeyT.

Browse Source 
git-svn-id: trunk@56659 -
This commit is contained in:
juha 2017-12-07 14:58:36 +00:00
parent ac38042db0
commit a3649ec49b
4 changed files with 25 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lcl/grids.pas
View File

@ -1067,7 +1067,7 @@ type
function GetPxTopLeft: TPoint;
function GetTruncCellHintText(ACol, ARow: Integer): string; virtual;
function GridColumnFromColumnIndex(ColumnIndex: Integer): Integer;
procedure GridMouseWheel(shift: TShiftState; Delta: Integer); virtual;
procedure GridMouseWheel(Shift: TShiftState; Delta: Integer); virtual;
procedure HeaderClick(IsColumn: Boolean; index: Integer); virtual;
procedure HeaderSized(IsColumn: Boolean; index: Integer); virtual;
procedure HeaderSizing(const IsColumn:boolean; const AIndex,ASize:Integer); virtual;
@ -8647,11 +8647,10 @@ begin
{$endif}
end;
procedure TCustomGrid.GridMouseWheel(shift: TShiftState; Delta: Integer);
procedure TCustomGrid.GridMouseWheel(Shift: TShiftState; Delta: Integer);
begin
// Mac widgetset sets ssHyper on horz scrolling
// Ctrl-key is for other OSes
if (ssCtrl in Shift) or (ssHyper in Shift) then
// Ctrl-key is to support horiz scrolling with basic mouse
if ssCtrl in Shift then
MoveNextSelectable(true, Delta, 0)
else
MoveNextSelectable(true, 0, Delta);

6
lcl/include/treeview.inc
View File

@ -4688,11 +4688,7 @@ begin
if not Result then
begin
NDelta := (WheelDelta * Mouse.WheelScrollLines * DefaultItemHeight) div 120;
// Mac widgetset sets ssHyper on horz scrolling
if ssHyper in Shift then
ScrolledLeft := ScrolledLeft - NDelta
else
ScrolledTop := ScrolledTop - NDelta;
ScrolledTop := ScrolledTop - NDelta;
Result := true;
end;
UpdateTooltip(MousePos.X, MousePos.Y);

13
lcl/interfaces/carbon/carbonprivatewindow.inc
View File

@ -230,7 +230,7 @@ const
procedure HandleMouseWheelEvent(var AMsg);
var
MousePoint: TPoint;
MSg: ^TLMMouseEvent;
Msg: ^TLMMouseEvent;
begin
{$IFDEF VerboseMouse}
DebugLn('HandleMouseWheelEvent');
@ -239,18 +239,15 @@ const
MousePoint := GetMousePoint;
Msg^.Msg := LM_MOUSEWHEEL;
if GetMouseWheelAxisHorz then
Msg^.Msg := LM_MOUSEHWHEEL
else
Msg^.Msg := LM_MOUSEWHEEL;
Msg^.Button := GetCarbonMouseButton(AEvent);
Msg^.X := MousePoint.X;
Msg^.Y := MousePoint.Y;
Msg^.State := GetCarbonShiftState;
Msg^.WheelDelta := GetMouseWheelDelta;
// ssHyper id in TShiftStateEnum is not used in LCL (almost, only n lines in gtk/gtk2, they not needed).
// Key "Hyper" was on non usual weird keyboard (for sci-fi film?)
// Lets use this id
if GetMouseWheelAxisHorz then
Include(Msg^.State, ssHyper);
end;
var

19
lcl/interfaces/cocoa/cocoawscommon.pas
View File

@ -880,17 +880,28 @@ begin
FillChar(Msg, SizeOf(Msg), #0);
Msg.Msg := LM_MOUSEWHEEL;
Msg.Button := MButton;
Msg.X := round(MousePos.X);
Msg.Y := round(MousePos.Y);
Msg.State := TShiftState(integer(CocoaModifiersToKeyState(Event.modifierFlags)));
// Some info on event.deltaY can be found here:
// https://developer.apple.com/library/mac/releasenotes/AppKit/RN-AppKitOlderNotes/
// It says that deltaY=1 means 1 line, and in the LCL 1 line is 120
Msg.WheelDelta := round(event.deltaY * 120);
// Filter out empty events - See bug 28491
if Msg.WheelDelta = 0 then Exit;
if event.deltaY <> 0 then
begin
Msg.Msg := LM_MOUSEWHEEL;
Msg.WheelDelta := round(event.deltaY * 120);
end
else
if event.deltaX <> 0 then
begin
Msg.Msg := LM_MOUSEHWHEEL;
Msg.WheelDelta := round(event.deltaX * 120);
end
else
// Filter out empty events - See bug 28491
Exit;
NotifyApplicationUserInput(Target, Msg.Msg);
Result := DeliverMessage(Msg) <> 0;