You've already forked lazarus-ccr
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:
@ -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;
|
||||
|
Reference in New Issue
Block a user