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

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

View File

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

View File

@ -4688,10 +4688,6 @@ begin
if not Result then if not Result then
begin begin
NDelta := (WheelDelta * Mouse.WheelScrollLines * DefaultItemHeight) div 120; 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; Result := true;
end; end;

View File

@ -230,7 +230,7 @@ const
procedure HandleMouseWheelEvent(var AMsg); procedure HandleMouseWheelEvent(var AMsg);
var var
MousePoint: TPoint; MousePoint: TPoint;
MSg: ^TLMMouseEvent; Msg: ^TLMMouseEvent;
begin begin
{$IFDEF VerboseMouse} {$IFDEF VerboseMouse}
DebugLn('HandleMouseWheelEvent'); DebugLn('HandleMouseWheelEvent');
@ -239,18 +239,15 @@ const
MousePoint := GetMousePoint; MousePoint := GetMousePoint;
if GetMouseWheelAxisHorz then
Msg^.Msg := LM_MOUSEHWHEEL
else
Msg^.Msg := LM_MOUSEWHEEL; Msg^.Msg := LM_MOUSEWHEEL;
Msg^.Button := GetCarbonMouseButton(AEvent); Msg^.Button := GetCarbonMouseButton(AEvent);
Msg^.X := MousePoint.X; Msg^.X := MousePoint.X;
Msg^.Y := MousePoint.Y; Msg^.Y := MousePoint.Y;
Msg^.State := GetCarbonShiftState; Msg^.State := GetCarbonShiftState;
Msg^.WheelDelta := GetMouseWheelDelta; 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; end;
var var

View File

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