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

cocoa: passing scroll part information, whenever the scroll part is known

Browse Source 
git-svn-id: trunk@62663 -
This commit is contained in:
dmitry 2020-02-23 04:04:39 +00:00
parent 6f0d7d6abc
commit aaf4d4d12f
3 changed files with 17 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/interfaces/cocoa/cocoaprivate.pas
View File

@ -91,7 +91,7 @@ type
procedure DidResignKeyNotification;
procedure SendOnChange;
procedure SendOnTextChanged;
procedure scroll(isVert: Boolean; Pos: Integer);
procedure scroll(isVert: Boolean; Pos: Integer; AScrollPart: NSScrollerPart = NSScrollerNoPart);
// non event methods
function DeliverMessage(Msg: Cardinal; WParam: WParam; LParam: LParam): LResult;
function GetPropStorage: TStringList;

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

@ -180,29 +180,16 @@ var
sz : Integer;
dlt : double;
v : double;
//const
//WinPageOfs : integer = 64; // this is an "ofset" of the pageInc used in Windows
// so the click on "large" makes two pages overlap
begin
Result := false;
case prt of
NSScrollerDecrementPage: begin
adj := -sc.largeInc;
if adj = 0 then
begin
adj := -sc.pageInt;
//if (sc.PageInt>WinPageOfs) then
// inc(adj, WinPageOfs);
end;
if adj = 0 then adj := -sc.pageInt;
end;
NSScrollerIncrementPage: begin
adj := sc.largeInc;
if adj = 0 then
begin
adj := sc.pageInt;
//if (sc.PageInt>WinPageOfs) then
// dec(adj, WinPageOfs);
end;
if adj = 0 then adj := sc.pageInt;
end;
NSScrollerDecrementLine: begin
adj := -sc.smallInc;
@ -843,7 +830,7 @@ begin
HandleMouseDown(self, locInWin, prt);
if Assigned(callback) then
callback.scroll( not IsHorizontal(), lclPos);
callback.scroll(not IsHorizontal(), lclPos, prt);
end;
function TCocoaScrollBar.IsHorizontal: Boolean;

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

@ -92,7 +92,7 @@ type
procedure DidResignKeyNotification; virtual;
procedure SendOnChange; virtual;
procedure SendOnTextChanged; virtual; // text controls (like spin) respond to OnChange for this event, but not for SendOnChange
procedure scroll(isVert: Boolean; Pos: Integer); virtual;
procedure scroll(isVert: Boolean; Pos: Integer; AScrollPart: NSScrollerPart); virtual;
function DeliverMessage(var Msg): LRESULT; virtual; overload;
function DeliverMessage(Msg: Cardinal; WParam: WParam; LParam: LParam): LResult; virtual; overload;
procedure Draw(ControlContext: NSGraphicsContext; const bounds, dirty: NSRect); virtual;
@ -1329,10 +1329,12 @@ begin
SendSimpleMessage(Target, CM_TEXTCHANGED);
end;
procedure TLCLCommonCallback.scroll(isVert: Boolean; Pos: Integer);
procedure TLCLCommonCallback.scroll(isVert: Boolean; Pos: Integer;
AScrollPart: NSScrollerPart);
var
LMScroll: TLMScroll;
b: Boolean;
lclCode: Integer;
begin
FillChar(LMScroll{%H-}, SizeOf(LMScroll), #0);
//todo: this should be a part of a parameter
@ -1344,7 +1346,15 @@ begin
LMScroll.Msg := LM_HSCROLL;
LMScroll.Pos := Pos;
LMScroll.ScrollCode := SB_THUMBPOSITION; //SIF_POS;
case AScrollPart of
NSScrollerDecrementPage: lclCode := SB_PAGELEFT;
NSScrollerIncrementPage: lclCode := SB_PAGERIGHT;
NSScrollerDecrementLine: lclCode := SB_LINELEFT;
NSScrollerIncrementLine: lclCode := SB_LINERIGHT;
else
lclCode := SB_THUMBPOSITION;
end;
LMScroll.ScrollCode := lclCode; //SIF_POS;
LCLMessageGlue.DeliverMessage(Target, LMScroll);
end;