Industrial: Add animation to TOnOffSwitch

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9025 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/industrialstuff/source/switches.pas

@@ -28,20 +28,27 @@ type
   );
   TSwitchMode = (smClick, smDblClick, smSlide, smSlideDblClick);
   TSwitchOrientation = (soHorizontal, soVertical);
+  TSwitchAnimationEffect = (saeBlendColors);
+  TSwitchAnimationEffects = set of TSwitchAnimationEffect;
 
   TCustomOnOffSwitch = class(TCustomControl)
   private
     const
       DEFAULT_BUTTON_SIZE = 24;
   private
+    FAnimated: Boolean;
+    FAnimationEffects: TSwitchAnimationEffects;
+    FAnimationTimer: TTimer;
     FBorderStyle: TSwitchBorderStyle;
+    FButtonPos: Integer;
     FButtonSize: Integer;
     FCaptions: array[0..1] of string;
     FChecked: Boolean;
+    FCheckedAfterAnimation: Boolean;
     FColors: array [0..2] of TColor;
     FInverse: Boolean;
     FDragging: Boolean;
-    FDraggedDistance: Integer;
+    FMaxDistance: Integer;
     FFlippedColors: Boolean;
     FTogglePending: Boolean;
     FMousePt: TPoint;
@@ -59,6 +66,7 @@ type
     function GetColors(AIndex: Integer): TColor;
     function GetOrientation: TSwitchOrientation;
     function GetPicture(AIndex: Integer): TPicture;
+    procedure SetAnimated(AValue: Boolean);
     procedure SetBorderStyle(AValue: TSwitchBorderStyle); reintroduce;
     procedure SetButtonSize(AValue: Integer);
     procedure SetCaptions(AIndex: Integer; AValue: string);
@@ -70,19 +78,22 @@ type
     procedure SetShowButtonBorder(AValue: Boolean);
     procedure SetShowCaption(AValue: Boolean);
     procedure SetShowFocusRect(AValue: Boolean);
+    procedure UpdateButtonPos;
+    procedure UpdateMaxDistance;
     procedure WM_EraseBkGnd(var Msg: TMsg); message LM_EraseBkGnd;
   protected
-    function CalcButtonRect(ADelta: Integer): TRect;
+    function CalcButtonRect: TRect;
     function CalcMargin: Integer;
     function CanChange: Boolean; virtual;
     procedure DblClick; override;
     procedure DblClickTimerHandler(Sender: TObject);
+    procedure DoAnimation(Sender: TObject);
     procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
       const AXProportion, AYProportion: Double); override;
     procedure DoChange; virtual;
     procedure DoEnter; override;
     procedure DoExit; override;
-    function DraggingToValue(ADistance: Integer): Boolean;
+    function DraggedToON: Boolean;
     procedure DrawButton(ARect: TRect); virtual;
     procedure DrawCaption(ARect: TRect; AChecked: Boolean); virtual;
     procedure DrawFocusRect(ARect: TRect);
@@ -94,6 +105,8 @@ type
     function MouseOnButton(X, Y: Integer): Boolean; virtual;
     procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
     procedure Paint; override;
+    property Animated: Boolean read FAnimated write SetAnimated default false;
+    property AnimationEffects: TSwitchAnimationEffects read FAnimationEffects write FAnimationEffects default [];
     property BorderColor: TColor index 2 read GetColors write SetColors default clGray;
     property BorderStyle: TSwitchBorderStyle read FBorderStyle write SetBorderStyle default bsThin;
     property ButtonSize: Integer read FButtonSize write SetButtonSize default DEFAULT_BUTTON_SIZE;
@@ -116,11 +129,14 @@ type
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
+    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
     property Orientation: TSwitchOrientation read GetOrientation;
   end;
 
   TOnOffSwitch = class(TCustomOnOffSwitch)
   published
+    property Animated;
+    property AnimationEffects;
     property BorderColor;
     property BorderStyle;
     property ButtonSize;
@@ -179,6 +195,19 @@ implementation
 uses
   Math;
 
+function BlendColors(AFactor: Double; AColor1, AColor2: TColor): TColor;
+var
+  f1, f2: Double;
+  r, g, b: Byte;
+begin
+  f1 := AFactor;
+  f2 := 1.0 - f1;
+  r := EnsureRange(round(GetRValue(AColor1) * f1 + GetRValue(AColor2) * f2), 0, 255);
+  g := EnsureRange(round(GetGValue(AColor1) * f1 + GetGValue(AColor2) * f2), 0, 255);
+  b := EnsureRange(round(GetBValue(AColor1) * f1 + GetBValue(AColor2) * f2), 0, 255);
+  Result := RGBToColor(r, g, b);
+end;
+
 function TintedColor(AColor: TColor; ADelta: Integer): TColor;
 var
   r, g, b: Byte;
@@ -235,14 +264,16 @@ begin
   inherited;
 end;
 
-function TCustomOnOffSwitch.CalcButtonRect(ADelta: Integer): TRect;
+function TCustomOnOffSwitch.CalcButtonRect: TRect;
-
+                 (*
   function GetOffset(AMaxSize, ABtnSize: Integer): Integer;
   var
     pStart, pEnd, margin: Integer;
   begin
     margin := CalcMargin;
-    if (FInverse xor FChecked) then begin
+
+    if FInverse xor FChecked then
+    begin
       // Button at right (or bottom), ADelta is negative
       pStart := AMaxSize - ABtnSize - margin;
       pEnd := margin;
@@ -264,12 +295,12 @@ function TCustomOnOffSwitch.CalcButtonRect(ADelta: Integer): TRect;
         Result := pStart + ADelta;
     end;
   end;
-
+  *)
 begin
   Result := FButtonRect;
   case Orientation of
-    soHorizontal : OffsetRect(Result, GetOffset(Width, FButtonSize), 0);
+    soHorizontal : OffsetRect(Result, FButtonPos + CalcMargin, 0);
-    soVertical   : OffsetRect(Result, 0, GetOffset(Height, FButtonSize));
+    soVertical   : OffsetRect(Result, 0, FButtonPos + CalcMargin);
   end;
 end;
 
@@ -286,11 +317,11 @@ end;
 procedure TCustomOnOffSwitch.DblClick;
 begin
   inherited;
-  if CanChange and FTogglePending then begin
-    Checked := not Checked;
-    FTogglePending := false;
-  end;
   FDblClickTimer.Enabled := false;
+  if CanChange and FTogglePending then begin
+    FTogglePending := false;
+    SetChecked(not FChecked);
+  end;
 end;
 
 procedure TCustomOnOffSwitch.DblClickTimerHandler(Sender: TObject);
@@ -312,6 +343,58 @@ begin
   end;
 end;
 
+{ Handler for the animation timer }
+procedure TCustomOnOffSwitch.DoAnimation(Sender: TObject);
+const
+  SPEED = 3;
+begin
+  if FCheckedAfterAnimation xor FInverse then
+  begin
+    inc(FButtonPos, SPEED);
+    if FButtonPos >= FMaxDistance then
+    begin
+      FAnimationTimer.Enabled := false;
+      FChecked := FCheckedAfterAnimation;
+      UpdateButtonPos;
+      DoChange;
+    end;
+  end else
+  begin
+    dec(FButtonPos, SPEED);
+    if FButtonPos <= 0 then
+    begin
+      FAnimationTimer.Enabled := false;
+      FChecked := FCheckedAfterAnimation;
+      UpdateButtonPos;
+      DoChange;
+    end;
+  end;
+  {
+  if FCheckedAfterAnimation xor FInverse then
+  begin
+    inc(FMovedDistance, 3);
+    if FMovedDistance > FMaxDistance then
+    begin
+      FMovedDistance := FMaxDistance;
+      FAnimationTimer.Enabled := false;
+      FChecked := FCheckedAfterAnimation;
+      DoChange;
+    end;
+  end else
+  begin
+    dec(FMovedDistance, 3);
+    if FMovedDistance < -FMaxDistance then
+    begin
+      FMovedDistance := -FMaxDistance;
+      FAnimationTimer.Enabled := false;
+      FChecked := FCheckedAfterAnimation;
+      DoChange;
+    end;
+  end;
+  }
+  Invalidate;
+end;
+
 procedure TCustomOnOffSwitch.DoChange;
 begin
   if Assigned(FOnChange) then FOnChange(self);
@@ -329,25 +412,12 @@ begin
   Invalidate;
 end;
 
-{ Determines whether the dragged distance lands in the part of the ON or OFF state }
+{ Determines whether the dragged distance lands in the part of the
-function TCustomOnOffSwitch.DraggingToValue(ADistance: Integer): Boolean;
+  ON (Result = true) or OFF state (Result = false) }
-var
+function TCustomOnOffSwitch.DraggedToON: Boolean;
-  margin: Integer;
 begin
-  if not (FChecked xor FInverse) and (ADistance < 0) then
+  Result := FButtonPos > FMaxDistance div 2;
-    Result := false
+  if FInverse then Result := not Result;
-  else
-  if (FChecked xor FInverse) and (ADistance > 0) then
-    Result := true
-  else begin
-    margin := CalcMargin;
-    case Orientation of
-      soHorizontal : Result := abs(ADistance) > (Width - FButtonSize) div 2 - margin;
-      soVertical   : Result := abs(ADistance) > (Height - FButtonSize) div 2 - margin;
-    end;
-    if FChecked {xor FInverse} then
-      Result := not Result;
-  end;
 end;
 
 procedure TCustomOnOffSwitch.DrawButton(ARect: TRect);
@@ -359,6 +429,9 @@ begin
     if FFlippedColors then
       Canvas.Brush.Color := Color
     else
+    if (saeBlendColors in FAnimationEffects) then
+      Canvas.Brush.Color := BlendColors(FButtonPos/FMaxDistance, ColorON, ColorOFF)
+    else
     if FChecked then
       Canvas.Brush.Color := ColorON
     else
@@ -471,26 +544,31 @@ begin
     Checked := not Checked;
 end;
 
-procedure TCustomOnOffSwitch.MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);
+procedure TCustomOnOffSwitch.MouseDown(Button: TMouseButton; Shift: TShiftState;
+  X, Y: Integer);
 begin
   inherited;
   SetFocus;
-  if CanChange and (Button = mbLeft) and MouseOnButton(X, Y) then begin
+  if CanChange and (Button = mbLeft) and MouseOnButton(X, Y) then
+  begin
     if (FSwitchMode in [smSlide, smSlideDblClick]) then FDragging := true;
     FMousePt := Point(X, Y);
-    FDraggedDistance := 0;
+    FDblClickTimer.Enabled := FSwitchMode in [smDblClick, smSlideDblClick];
-    FDblClickTimer.Enabled := true;
   end;
 end;
 
 procedure TCustomOnOffSwitch.MouseMove(Shift: TShiftState; X,Y: Integer);
+var
+  delta: Integer;
 begin
   inherited;
   if FDragging then begin
     case Orientation of
-      soHorizontal : FDraggedDistance := X - FMousePt.X;
+      soHorizontal : delta := X - FMousePt.X;
-      soVertical   : FDraggedDistance := Y - FMousePt.Y;
+      soVertical   : delta := Y - FMousePt.Y;
     end;
+    FMousePt := Point(X, Y);
+    FButtonPos := EnsureRange(FButtonPos + delta, 0, FMaxDistance);
     Invalidate;
   end;
 end;
@@ -499,27 +577,25 @@ function TCustomOnOffSwitch.MouseOnButton(X, Y: Integer): Boolean;
 var
   R: TRect;
 begin
-  R := CalcButtonRect(FDraggedDistance);
+  R := CalcButtonRect;
   Result := PtInRect(R, Point(X, Y));
 end;
 
 procedure TCustomOnOffSwitch.MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);
 var
   oldChecked: Boolean;
-  d: Integer;
 begin
   inherited;
   if (Button = mbLeft) and CanChange then begin
     oldChecked := FChecked;
-    d := FDraggedDistance;
-    FDraggedDistance := 0;
     if FDragging then begin
-      FChecked := DraggingToValue(d);
       FDragging := false;
+      FChecked := DraggedToON;
+      UpdateButtonPos;
     end else
     begin
       if (FSwitchMode = smClick) or (HasPicture and (FSwitchMode = smSlide)) then
-        FChecked := not FChecked;
+        SetChecked(not FChecked);
       if FChecked <> oldChecked then
         DoChange
       else
@@ -550,6 +626,9 @@ begin
 
   if Enabled then begin
     if FFlippedColors then begin
+      if (saeBlendColors in FAnimationEffects) then
+        Canvas.Brush.Color := BlendColors(FButtonPos/FMaxDistance, ColorON, ColorOFF)
+      else
       if FChecked then
         Canvas.Brush.Color := ColorON
       else
@@ -621,7 +700,10 @@ begin
   end;
 
   if FShowCaption then begin
-    newChecked := DraggingToValue(FDraggedDistance);
+    if FDragging then
+      newChecked := DraggedToOn  //DraggingToON(FMovedDistance)
+    else
+      newchecked := FChecked;
     case Orientation of
       soHorizontal:
         if FChecked xor FInverse then begin
@@ -654,7 +736,7 @@ begin
     end;
   end;
 
-  R := CalcButtonRect(FDraggedDistance);
+  R := CalcButtonRect;
   DrawButton(R);
   if Focused and FShowFocusRect then begin
     InflateRect(R, 2, 2);
@@ -662,6 +744,23 @@ begin
   end;
 end;
 
+procedure TCustomOnOffSwitch.SetAnimated(AValue: Boolean);
+begin
+  if AValue = FAnimated then exit;
+  FAnimated := AValue;
+  if FAnimated then
+  begin
+    if  (FAnimationTimer = nil) then
+    begin
+      FAnimationTimer := TTimer.Create(self);
+      FAnimationTimer.Interval := 10;
+      FAnimationTimer.Enabled := false;
+      FAnimationTimer.OnTimer := @DoAnimation;
+    end
+  end else
+    FreeAndNil(FAnimationTimer);
+end;
+
 procedure TCustomOnOffSwitch.SetBorderStyle(AValue: TSwitchBorderStyle);
 begin
   if AValue = FBorderStyle then exit;
@@ -669,11 +768,18 @@ begin
   Invalidate;
 end;
 
+procedure TCustomOnOffSwitch.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
+begin
+  inherited;
+  UpdateMaxDistance;
+end;
+
 procedure TCustomOnOffSwitch.SetButtonSize(AValue: Integer);
 begin
   if (AValue = FButtonSize) and (AValue > 0) then
     exit;
   FButtonSize := AValue;
+  UpdateMaxDistance;
   Invalidate;
 end;
 
@@ -687,10 +793,23 @@ end;
 procedure TCustomOnOffSwitch.SetChecked(AValue: Boolean);
 begin
   if AValue = FChecked then exit;
+  if FDblClickTimer.Enabled then exit;
+  if FAnimated then
+  begin
+    case Orientation of
+      soHorizontal: FMaxDistance := Width - FButtonSize - 2*CalcMargin;
+      soVertical: FMaxDistance := Height - FButtonSize - 2*CalcMargin;
+    end;
+    FAnimationTimer.Enabled := true;
+    FCheckedAfterAnimation := AValue;
+  end else
+  begin
     FChecked := AValue;
+    UpdateButtonPos;
     DoChange;
     Invalidate;
   end;
+end;
 
 procedure TCustomOnOffSwitch.SetColors(AIndex: Integer; AValue: TColor);
 begin
@@ -710,6 +829,7 @@ procedure TCustomOnOffSwitch.SetInverse(AValue: boolean);
 begin
   if AValue = FInverse then exit;
   FInverse := AValue;
+  UpdateButtonPos;
   Invalidate;
 end;
 
@@ -748,6 +868,23 @@ begin
   Invalidate;
 end;
 
+procedure TCustomOnOffSwitch.UpdateButtonPos;
+begin
+  if FChecked xor FInverse then
+    FButtonPos := FMaxDistance
+  else
+    FButtonPos := 0;
+end;
+
+procedure TCustomOnOffSwitch.UpdateMaxDistance;
+begin
+  case Orientation of
+    soHorizontal: FMaxDistance := Width - FButtonSize - 2*CalcMargin;
+    soVertical: FMaxDistance := Height - FButtonSize - 2*CalcMargin;
+  end;
+  UpdateButtonPos;
+end;
+
 procedure TCustomOnOffSwitch.WM_EraseBkGnd(var Msg: TMsg);
 begin
   Msg.message := 1;