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

cocoa: mouse handling for TUpDown control

Browse Source 
git-svn-id: trunk@61431 -
This commit is contained in:
dmitry 2019-06-20 03:16:57 +00:00
parent cf89d1f9bf
commit 5080a98675
1 changed files with 62 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
lcl/interfaces/cocoa/cocoabuttons.pas
View File

@ -111,6 +111,16 @@ type
callback: IStepperCallback;
lastValue: Double;
procedure stepperAction(sender: NSObject); message 'stepperAction:';
procedure mouseDown(event: NSEvent); override;
procedure mouseUp(event: NSEvent); override;
procedure rightMouseDown(event: NSEvent); override;
procedure rightMouseUp(event: NSEvent); override;
procedure otherMouseDown(event: NSEvent); override;
procedure otherMouseUp(event: NSEvent); override;
procedure mouseDragged(event: NSEvent); override;
procedure mouseMoved(event: NSEvent); override;
end;
implementation
@ -140,6 +150,58 @@ begin
if Allowchange and Assigned(callback) then callback.UpdownClick(updownpress);
end;
procedure TCocoaStepper.mouseDown(event: NSEvent);
begin
if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
begin
inherited mouseDown(event);
if Assigned(Callback) then
callback.MouseUpDownEvent(event, true);
end;
end;
procedure TCocoaStepper.mouseUp(event: NSEvent);
begin
if not callback.MouseUpDownEvent(event) then
inherited mouseUp(event);
end;
procedure TCocoaStepper.rightMouseDown(event: NSEvent);
begin
if not callback.MouseUpDownEvent(event) then
inherited rightMouseDown(event);
end;
procedure TCocoaStepper.rightMouseUp(event: NSEvent);
begin
if not callback.MouseUpDownEvent(event) then
inherited rightMouseUp(event);
end;
procedure TCocoaStepper.otherMouseDown(event: NSEvent);
begin
if not callback.MouseUpDownEvent(event) then
inherited otherMouseDown(event);
end;
procedure TCocoaStepper.otherMouseUp(event: NSEvent);
begin
if not callback.MouseUpDownEvent(event) then
inherited otherMouseUp(event);
end;
procedure TCocoaStepper.mouseDragged(event: NSEvent);
begin
if not callback.MouseMove(event) then
inherited mouseDragged(event);
end;
procedure TCocoaStepper.mouseMoved(event: NSEvent);
begin
if not callback.MouseMove(event) then
inherited mouseMoved(event);
end;
{ TCocoaButton }
procedure TCocoaButton.lclSetFrame(const r: TRect);