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

Cocoa: add support for scrollWheel on ScrollBar, Merge branch 'cocoa/scrollbar'

Browse Source 
for example, the scrollWheel on the ScrollBar of SynEdit works properly noew
This commit is contained in:
rich2014 2024-05-13 23:33:06 +08:00
commit 95f84b4b0b
2 changed files with 71 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1062,11 +1062,10 @@ end;
procedure TCocoaScrollBar.scrollWheel(event: NSEvent); procedure TCocoaScrollBar.scrollWheel(event: NSEvent);
begin begin
if suppressLCLMouse then if Assigned(callback) then
inherited scrollWheel(event) callback.scrollWheel(event)
else else
if not Assigned(callback) or not callback.scrollWheel(event) then Inherited;
inherited scrollWheel(event);
end; end;
function TCocoaScrollBar.acceptsFirstResponder: LCLObjCBoolean; function TCocoaScrollBar.acceptsFirstResponder: LCLObjCBoolean;

69
lcl/interfaces/cocoa/cocoawinapi.inc
View File

@ -129,6 +129,70 @@ const
WantTab : array [boolean] of integer = (0, DLGC_WANTTAB); WantTab : array [boolean] of integer = (0, DLGC_WANTTAB);
WantArrow : array [boolean] of integer = (0, DLGC_WANTARROWS); WantArrow : array [boolean] of integer = (0, DLGC_WANTARROWS);
WantKeys : array [boolean] of integer = (0, DLGC_WANTALLKEYS); WantKeys : array [boolean] of integer = (0, DLGC_WANTALLKEYS);
procedure CallMouseWheelHandler(barFlag: Integer);
var
scrollMsg: TLMScroll;
pMsg: PLMessage;
winControl: TWinControl Absolute Sender;
scrollControl: TScrollingWinControl Absolute Sender;
barControl: TControlScrollBar;
barInfo: TScrollInfo;
wheelDelta: Integer;
pos: Integer;
offset: Integer;
inc: Integer;
begin
if NOT (Sender is TWinControl) then
Exit;
if NOT winControl.HandleAllocated then
Exit;
if NOT GetScrollInfo(winControl.Handle, barFlag, barInfo{%H-}) then
Exit;
inc:= 1;
if winControl is TScrollingWinControl then
begin
if barFlag = SB_Vert then
barControl:= scrollControl.VertScrollBar
else
barControl:= scrollControl.HorzScrollBar;
if Assigned(barControl) then
inc:= barControl.Increment;
end
else
inc:= Mouse.WheelScrollLines;
wheelDelta := TLMMouseEvent(Message).WheelDelta;
offset:= WheelDelta * inc div 120;
if offset=0 then begin
if WheelDelta>0 then
offset:= 1
else
offset:= -1;
end;
if barFlag = SB_Vert then
offset:= -offset;
pos:= barInfo.nPos + offset;
if pos > barInfo.nMax then
pos:= barInfo.nMax;
if pos < barInfo.nMin then
pos:= barInfo.nMin;
FillChar(scrollMsg{%H-}, SizeOf(TLMScroll), #0);
if barFlag = SB_Vert then
scrollMsg.Msg:= LM_VSCROLL
else
scrollMsg.Msg:= LM_HSCROLL;
scrollMsg.Pos:= pos;
scrollMsg.ScrollCode:= SB_THUMBPOSITION;
pMsg:= @scrollMsg;
winControl.WindowProc(pMsg^);
end;
begin begin
case TLMessage(Message).Msg of case TLMessage(Message).Msg of
LM_GETDLGCODE: begin LM_GETDLGCODE: begin
@ -146,8 +210,11 @@ begin
ks := ks or rt; // Return is handled by LCL as part of ALLKey ks := ks or rt; // Return is handled by LCL as part of ALLKey
TLMessage(Message).Result := TLMessage(Message).Result or WantTab[tb] or WantArrow[ar] or WantKeys[ks]; TLMessage(Message).Result := TLMessage(Message).Result or WantTab[tb] or WantArrow[ar] or WantKeys[ks];
end; end;
end; end;
LM_MOUSEWHEEL:
CallMouseWheelHandler(SB_Vert);
LM_MOUSEHWHEEL:
CallMouseWheelHandler(SB_Horz);
else else
TLMessage(Message).Result := 0; TLMessage(Message).Result := 0;
end; end;