From a5677f896b5e9c0fcdb8a1f326a3df54f82a812c Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 14 Nov 2023 21:33:01 +0000 Subject: [PATCH] Industrial: Add animation to TOnOffSwitch git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9025 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../industrialstuff/source/switches.pas | 233 ++++++++++++++---- 1 file changed, 185 insertions(+), 48 deletions(-) diff --git a/components/industrialstuff/source/switches.pas b/components/industrialstuff/source/switches.pas index fdc9493ea..d309d8781 100644 --- a/components/industrialstuff/source/switches.pas +++ b/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); - soVertical : OffsetRect(Result, 0, GetOffset(Height, FButtonSize)); + soHorizontal : OffsetRect(Result, FButtonPos + CalcMargin, 0); + 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 } -function TCustomOnOffSwitch.DraggingToValue(ADistance: Integer): Boolean; -var - margin: Integer; +{ Determines whether the dragged distance lands in the part of the + ON (Result = true) or OFF state (Result = false) } +function TCustomOnOffSwitch.DraggedToON: Boolean; begin - if not (FChecked xor FInverse) and (ADistance < 0) then - Result := false - 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; + Result := FButtonPos > FMaxDistance div 2; + if FInverse then Result := not Result; 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 := true; + FDblClickTimer.Enabled := FSwitchMode in [smDblClick, smSlideDblClick]; 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; - soVertical : FDraggedDistance := Y - FMousePt.Y; + soHorizontal : delta := X - FMousePt.X; + 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,9 +793,22 @@ end; procedure TCustomOnOffSwitch.SetChecked(AValue: Boolean); begin if AValue = FChecked then exit; - FChecked := AValue; - DoChange; - Invalidate; + 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); @@ -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;