cocoa: cocoa specific TUpDown, same look as with TSpinEdit. #34663

git-svn-id: trunk@60967 -

lcl/interfaces/cocoa/cocoabuttons.pas

@@ -98,8 +98,48 @@ type
     procedure setState(astate: NSInteger); override;
   end;
 
+
+  IStepperCallback = interface(ICommonCallback)
+    procedure BeforeChange(var Allowed: Boolean);
+    procedure Change(NewValue: Double; isUpPressed: Boolean; var Allowed: Boolean);
+    procedure UpdownClick(isUpPressed: Boolean);
+  end;
+
+  { TCocoaStepper }
+
+  TCocoaStepper = objcclass(NSStepper)
+    callback: IStepperCallback;
+    lastValue: Double;
+    procedure stepperAction(sender: NSObject); message 'stepperAction:';
+  end;
+
 implementation
 
+{ TCocoaStepper }
+
+procedure TCocoaStepper.stepperAction(sender: NSObject);
+var
+  newval      : Double;
+  allowChange : Boolean;
+  updownpress : Boolean;
+begin
+  newval := doubleValue;
+  allowChange := true;
+  updownpress := newval > lastValue;
+
+  if Assigned(callback) then begin
+    callback.BeforeChange(allowChange);
+    callback.Change(newval, updownpress, allowChange);
+  end;
+
+  if not allowChange then
+    setDoubleValue(lastValue)
+  else
+    lastValue := doubleValue;
+
+  if Allowchange and Assigned(callback) then callback.UpdownClick(updownpress);
+end;
+
 { TCocoaButton }
 
 procedure TCocoaButton.lclSetFrame(const r: TRect);

lcl/interfaces/cocoa/cocoawscomctrls.pas

@@ -19,7 +19,7 @@ uses
   WSComCtrls,
   // Cocoa WS
   CocoaPrivate, CocoaScrollers, CocoaTabControls, CocoaUtils,
-  CocoaWSCommon, CocoaTables, cocoa_extra, CocoaWSStdCtrls, CocoaGDIObjects;
+  CocoaWSCommon, CocoaTables, cocoa_extra, CocoaWSStdCtrls, CocoaGDIObjects, CocoaButtons;
 
 type
 
@@ -214,6 +214,12 @@ type
 
   TCocoaWSCustomUpDown = class(TWSCustomUpDown)
   published
+    class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
+    class procedure SetIncrement(const AUpDown: TCustomUpDown; AValue: Double); override;
+    class procedure SetMaxPosition(const AUpDown: TCustomUpDown; AValue: Double); override;
+    class procedure SetMinPosition(const AUpDown: TCustomUpDown; AValue: Double); override;
+    class procedure SetPosition(const AUpDown: TCustomUpDown; AValue: Double); override;
+    class procedure SetWrap(const AUpDown: TCustomUpDown; ADoWrap: Boolean); override;
   end;
 
   { TCarbonWSUpDown }
@@ -261,6 +267,103 @@ type
 
 implementation
 
+type
+
+  { TUpdownCommonCallback }
+
+  TUpdownCommonCallback = class(TLCLCommonCallback, IStepperCallback)
+    procedure BeforeChange(var Allowed: Boolean);
+    procedure Change(NewValue: Double; isUpPressed: Boolean; var Allowed: Boolean);
+    procedure UpdownClick(isUpPressed: Boolean);
+  end;
+
+type
+  TAccessUpDown = class(TCustomUpDown);
+
+{ TUpdownCommonCallback }
+
+procedure TUpdownCommonCallback.BeforeChange(var Allowed: Boolean);
+begin
+  if Assigned( TAccessUpDown(Target).OnChanging ) then
+    TAccessUpDown(Target).OnChanging(Target, Allowed);
+end;
+
+procedure TUpdownCommonCallback.Change(NewValue: Double; isUpPressed: Boolean;
+  var Allowed: Boolean);
+const
+  UpDownDir : array [Boolean] of TUpDownDirection = (updUp, updDown);
+begin
+  if Assigned( TAccessUpDown(Target).OnChanging ) then
+    TAccessUpDown(Target).OnChangingEx(Target, Allowed,
+      Round(NewValue), UpDownDir[isUpPressed]);
+end;
+
+procedure TUpdownCommonCallback.UpdownClick(isUpPressed: Boolean);
+const
+  UpDownBtn : array [Boolean] of TUDBtnType = (btPrev, btNext);
+begin
+  if Assigned( TAccessUpDown(Target).OnClick ) then
+    TAccessUpDown(Target).OnClick( Target, UpDownBtn[isUpPressed]);
+end;
+
+{ TCocoaWSCustomUpDown }
+
+class function TCocoaWSCustomUpDown.CreateHandle(
+  const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle;
+var
+  lResult: TCocoaStepper;
+begin
+  lResult := TCocoaStepper.alloc.lclInitWithCreateParams(AParams);
+  if Assigned(lResult) then
+  begin
+    lResult.callback := TUpdownCommonCallback.Create(lResult, AWinControl);
+    //small constrol size looks like carbon
+    //lResult.setControlSize(NSSmallControlSize);
+    lResult.setTarget(lResult);
+    lResult.setAction(objcselector('stepperAction:'));
+
+  end;
+  Result := TLCLIntfHandle(lResult);
+end;
+
+class procedure TCocoaWSCustomUpDown.SetMinPosition(
+  const AUpDown: TCustomUpDown; AValue: Double);
+begin
+  writeln('koko!111');
+  if not Assigned(AUpDown) or not AUpDown.HandleAllocated then Exit;
+  writeln('koko!222');
+  TCocoaStepper(AUpDown.Handle).setMinValue(AValue);
+end;
+
+class procedure TCocoaWSCustomUpDown.SetMaxPosition(
+  const AUpDown: TCustomUpDown; AValue: Double);
+begin
+  if not Assigned(AUpDown) or not AUpDown.HandleAllocated then Exit;
+  TCocoaStepper(AUpDown.Handle).setMaxValue(AValue);
+end;
+
+class procedure TCocoaWSCustomUpDown.SetPosition(const AUpDown: TCustomUpDown;
+  AValue: Double);
+begin
+  if not Assigned(AUpDown) or not AUpDown.HandleAllocated then Exit;
+  TCocoaStepper(AUpDown.Handle).lastValue := AValue;
+  TCocoaStepper(AUpDown.Handle).setDoubleValue(AValue);
+end;
+
+class procedure TCocoaWSCustomUpDown.SetIncrement(const AUpDown: TCustomUpDown;
+  AValue: Double);
+begin
+  if not Assigned(AUpDown) or not AUpDown.HandleAllocated then Exit;
+  TCocoaStepper(AUpDown.Handle).setIncrement(AValue);
+end;
+
+class procedure TCocoaWSCustomUpDown.SetWrap(const AUpDown: TCustomUpDown;
+  ADoWrap: Boolean);
+begin
+  if not Assigned(AUpDown) or not AUpDown.HandleAllocated then Exit;
+  TCocoaStepper(AUpDown.Handle).setValueWraps(ADoWrap);
+end;
+
 { TStatusBarCallback }
 
 function TStatusBarCallback.GetBarsCount: Integer;

lcl/interfaces/cocoa/cocoawsfactory.pas

@@ -186,7 +186,8 @@ end;
 
 function RegisterCustomUpDown: Boolean; alias : 'WSRegisterCustomUpDown';
 begin
-  Result := False;
+  RegisterWSComponent(TCustomUpDown, TCocoaWSCustomUpDown);
+  Result := True;
 end;
 
 function RegisterCustomToolButton: Boolean; alias : 'WSRegisterCustomToolButton';