Industrial: Add animation to TOnOffSwitch

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9025 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-11-14 21:33:01 +00:00
parent 62f3c0a5cb
commit a5677f896b

View File

@ -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;