pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

NiceGrid: Improved mousewheel behaviour.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8926 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-09-23 20:59:57 +00:00
parent b5412c3f5b
commit a46d1d3f3c
1 changed files with 18 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
components/nicegrid/source/nicegrid.pas
View File

@ -284,7 +284,7 @@ type
procedure WMUnknown(var Msg: TLMessage); message LM_USER + $B902; procedure WMUnknown(var Msg: TLMessage); message LM_USER + $B902;
procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL;
procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL; procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL;
procedure WMMouseWheel(var Msg: TLMessage{TWMMouseWheel}); message LM_MOUSEWHEEL; // procedure WMMouseWheel(var Msg: TLMessage{TWMMouseWheel}); message LM_MOUSEWHEEL;
procedure WMEraseBkgnd(var Msg: TLMEraseBkGnd); message LM_ERASEBKGND; procedure WMEraseBkgnd(var Msg: TLMEraseBkGnd); message LM_ERASEBKGND;
// procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS; // procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS;
// procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS; // procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS;
@ -410,6 +410,7 @@ type
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); override; procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); override;
procedure DoEnter; override; procedure DoEnter; override;
procedure DoExit; override; procedure DoExit; override;
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
procedure DoOnResize; override; procedure DoOnResize; override;
{$ENDIF} {$ENDIF}
@ -3603,12 +3604,26 @@ begin
Msg.Result := 0; Msg.Result := 0;
end; end;
procedure TNiceGrid.WMMouseWheel(var Msg: {$IFDEF FPC}TLMessage{$ELSE}TWMMouseWheel{$ENDIF}); {$IFDEF FPC}
function TNiceGrid.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean;
{$ELSE}
procedure TNiceGrid.WMMouseWheel(var Msg: TWMMouseWheel);
{$ENDIF}
var var
Old: Integer; Old: Integer;
delta: Integer;
sgn: Integer;
begin begin
delta := {$IFNDEF FPC}Msg.{$ENDIF}WheelDelta;
sgn := Sign(delta);
if (ssShift in Shift) then
delta := sgn * FLargeChange
else
delta := sgn * FSmallChange;
Old := FVertOffset; Old := FVertOffset;
FVertOffset := Max(0, Min(FMaxVScroll, FVertOffset - Msg.{$IFDEF FPC}lParam{$ELSE}WheelDelta{$ENDIF})); FVertOffset := Max(0, Min(FMaxVScroll, FVertOffset - delta));
if (FVertOffset <> Old) then if (FVertOffset <> Old) then
begin begin
SetScrollBar(SB_VERT, 0, FVertOffset, SIF_POS); SetScrollBar(SB_VERT, 0, FVertOffset, SIF_POS);