lazarus-ccr/components/industrialstuff/source/switches.pas

{
 /***************************************************************************
                                 switches.pp

  License: Modified LGPL (with linking exception)

  See the file COPYING.modifiedLGPL.txt, included in the Lazarus distribution,
  for details about the license.

  Autho: Werner Pamler
 *****************************************************************************
}

unit Switches;

{$mode objfpc}{$H+}

interface

uses
  LCLIntf, LCLType, LMessages, LCLVersion,
  Graphics, GraphType, Classes, SysUtils, Types, Controls, ExtCtrls, ImgList;

type
  TSwitchBorderStyle = (
    bsNone, bsThin, bsThick, bsThin3D, bsThick3D,
    bsNoneRounded, bsThinRounded, bsThickRounded
  );
  TSwitchMode = (smClick, smDblClick, smSlide, smSlideDblClick);
  TSwitchOrientation = (soHorizontal, soVertical);
  TSwitchAnimationEffect = (saeBlendColors, saeBlendImages, saeRotateImages);
  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[boolean] of string;
    FChecked: Boolean;
    FCheckedAfterAnimation: Boolean;
    FColors: array [0..2] of TColor;
    FInverse: Boolean;
    FDragging: Boolean;
    FMaxDistance: Integer;
    FFlippedColors: Boolean;
    FTogglePending: Boolean;
    FMousePt: TPoint;
    FButtonRect: TRect;
    FReadOnly: Boolean;
    FShowButtonBorder: Boolean;
    FShowCaption: Boolean;
    FShowFocusRect: Boolean;
    FSwitchMode: TSwitchMode;
    FOnChange: TNotifyEvent;
    FDblClickTimer: TTimer;
    FPicture: array[boolean] of TPicture;
    FImageIndex: array[boolean] of TImageIndex;
    FImageListChangeLink: TChangeLink;
    FImages: TCustomImagelist;
    FImagesWidth: Integer;
    function GetBorderWidth: Integer;
    function GetCaptions(AChecked: Boolean): String;
    function GetColors(AIndex: Integer): TColor;
    function GetImageIndex(AChecked: Boolean): TImageIndex;
    function GetOrientation: TSwitchOrientation;
    function GetPicture(AChecked: Boolean): TPicture;
    procedure SetAnimated(AValue: Boolean);
    procedure SetBorderStyle(AValue: TSwitchBorderStyle); reintroduce;
    procedure SetButtonSize(AValue: Integer);
    procedure SetCaptions(AChecked: Boolean; AValue: string);
    procedure SetChecked(AValue: Boolean);
    procedure SetColors(AIndex: Integer; AValue: TColor);
    procedure SetFlippedColors(AValue: Boolean);
    procedure SetImageIndex(AChecked: Boolean; AValue: TImageIndex);
    procedure SetImages(const AValue: TCustomImageList);
    procedure SetInverse(AValue: Boolean);
    procedure SetPicture(AChecked: Boolean; AValue: TPicture);
    procedure SetShowButtonBorder(AValue: Boolean);
    procedure SetShowCaption(AValue: Boolean);
    procedure SetShowFocusRect(AValue: Boolean);
    procedure UpdateButtonPos;
    procedure UpdateMaxDistance;
    procedure UpdateShape;
  protected
    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;
    procedure DoImageListChange(Sender: TObject);
    function DraggedToON: Boolean;
    procedure DrawButton(ARect: TRect); virtual;
    procedure DrawCaption(ARect: TRect; AChecked: Boolean); virtual;
    procedure DrawFocusRect(ARect: TRect);
    class function GetControlClassDefaultSize: TSize; override;
    function HasPicture: Boolean;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
    procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
    function MouseOnButton(X, Y: Integer): Boolean; virtual;
    procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;
    property Animated: Boolean read FAnimated write SetAnimated default false;
    property AnimationEffects: TSwitchAnimationEffects read FAnimationEffects write FAnimationEffects default [saeBlendColors, saeBlendImages];
    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;
    property CaptionOFF: String index false read GetCaptions write SetCaptions;
    property CaptionON: String index true read GetCaptions write SetCaptions;
    property Checked: Boolean read FChecked write SetChecked default false;
    property Color default clWindow;
    property ColorOFF: TColor index 0 read GetColors write SetColors default clMaroon;
    property ColorON: TColor index 1 read GetColors write SetColors default clGreen;
    property FlippedColors: Boolean read FFlippedColors write SetFlippedColors default false;
    property ImageIndexOFF: TImageIndex index false read GetImageIndex write SetImageIndex default -1;
    property ImageIndexON: TImageIndex index true read GetImageIndex write SetImageIndex default -1;
    property Images: TCustomImageList read FImages write SetImages;
    property ImagesWidth: Integer read FImagesWidth write FImagesWidth default 0;
    property Inverse: Boolean read FInverse write SetInverse default false;
    property PictureOFF: TPicture index false read GetPicture write SetPicture;
    property PictureON: TPicture index true read GetPicture write SetPicture;
    property ReadOnly: boolean read FReadOnly write FReadOnly default false;
    property ShowButtonBorder: Boolean read FShowButtonBorder write SetShowButtonBorder default true;
    property ShowFocusRect: Boolean read FShowFocusRect write SetShowFocusRect default true;
    property ShowCaption: Boolean read FShowCaption write SetShowCaption default true;
    property SwitchMode: TSwitchMode read FSwitchMode write FSwitchMode default smSlideDblClick;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  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;
    property CaptionOFF;
    property CaptionON;
    property Checked;
    property Color;
    property ColorOFF;
    property ColorON;
    property Enabled;
    property FlippedColors;
    property ImageIndexON;
    property ImageIndexOFF;
    property Images;
    property ImagesWidth;
    property Inverse;
    property PictureOFF;
    property PictureON;
    property ReadOnly;
    property ShowButtonBorder;
    property ShowCaption;
    property ShowFocusRect;
    property SwitchMode;

    // inherited
    property Action;
    property Align;
    property Anchors;
    property BorderSpacing;
    property Constraints;
    property DoubleBuffered;
    property Font;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop default true;
    property Visible;

    // new
    property OnChange;

    // inherited
    property OnChangeBounds;
    property OnClick;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseUp;
    property OnResize;
    property OnShowHint;
  end;

implementation

uses
  Math, FPImage, GraphMath, IntfGraphics;

function BlendColors(AFactor: Double; AColor1, AColor2: TColor): TColor;
var
  f1, f2: Double;
  r, g, b: Byte;
begin
  f1 := 1.0 - AFactor;
  f2 := AFactor;
  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;

procedure BlendImages(Img, Img1, Img2: TFPCustomImage; AFactor: Double);
var
  x, y: Integer;
  r,g,b,a: Word;
  f1, f2: Double;
begin
  f1 := 1.0 - AFactor;
  f2 := AFactor;
  for y := 0 to Img1.Height-1 do
    for x := 0 to Img1.Width-1 do
    begin
      r := round(f1 * Img1.Colors[x, y].Red   + f2 * Img2.Colors[x, y].Red);
      g := round(f1 * Img1.Colors[x, y].Green + f2 * Img2.Colors[x, y].Green);
      b := round(f1 * Img1.Colors[x, y].Blue  + f2 * Img2.Colors[x, y].Blue);
      a := round(f1 * Img1.Colors[x, y].Alpha + f2 * Img2.Colors[x, y].Alpha);
      Img.Colors[x, y] := FPColor(r, g, b, a);
    end;
end;

{$IF LCL_FullVersion < 3000000}
function RotatePoint(const APoint: TPoint; AAngle: Double): TPoint;
var
  sa, ca: Double;
begin
  SinCos(AAngle, sa, ca);
  Result.X := Round( ca * APoint.X + sa * APoint.Y);
  Result.Y := Round(-sa * APoint.X + ca * APoint.Y);
end;
{$ENDIF}

procedure RotateImage(Img: TFPCustomImage; Angle: Double);
var
  Buffer: TFPCustomImage;
  x, y: Integer;
  C, P: TPoint;
begin
  Buffer := TFPMemoryImage.Create(Img.Width, Img.Height);
  try
    C := Point(Img.Width div 2, Img.Height div 2);
    for y := 0 to Buffer.Height-1 do
      for x := 0 to Buffer.Width-1 do
      begin
        P := RotatePoint(Point(x, y) - C, Angle) + C;
        if (P.X >= 0) and (P.Y >= 0) and (P.X < Img.Width) and (P.Y < Img.Height) then
          Buffer.Colors[x, y] := Img.Colors[P.X, P.Y]
        else
          Buffer.Colors[x, y] := colTransparent;
      end;
    for y := 0 to Img.Height-1 do
      for x := 0 to Img.Width-1 do
        Img.Colors[x, y] := Buffer[x, y];
  finally
    Buffer.Free;
  end;
end;

function TintedColor(AColor: TColor; ADelta: Integer): TColor;
var
  r, g, b: Byte;
begin
  AColor := ColorToRGB(AColor);
  r := GetRValue(AColor);
  g := GetGValue(AColor);
  b := GetBValue(AColor);
  if r + g + b < 3*128 then
    // Dark color --> make it brighter
    ADelta := abs(ADelta)
  else
    // Bright color --> make it darker
    ADelta := -abs(ADelta);
  r := EnsureRange(r + ADelta, 0, 255);
  g := EnsureRange(g + ADelta, 0, 255);
  b := EnsureRange(b + ADelta, 0, 255);
  Result := RGBToColor(r, g, b);
end;


{ TOnOffSwitch }

constructor TCustomOnOffSwitch.Create(AOwner: TComponent);
begin
  inherited;
  TabStop := true;
  Color := clWindow;
  FAnimationEffects := [saeBlendColors, saeBlendImages];
  FBorderStyle := bsThin;
  FButtonSize := DEFAULT_BUTTON_SIZE;
  FColors[0] := clMaroon; // unchecked color
  FColors[1] := clGreen;  // checked color
  FColors[2] := clGray;   // Border color
  FCaptions[false] := 'OFF';
  FCaptions[true] := 'ON';
  FImageListChangeLink := TChangeLink.Create;
  FImageListChangeLink.OnChange := @DoImageListChange;
  FImageIndex[false] := -1;
  FImageIndex[true] := -1;
  FPicture[false] := TPicture.Create;
  FPicture[true] := TPicture.Create;
  FShowCaption := true;
  FShowButtonBorder := true;
  FShowFocusRect := true;
  FSwitchMode := smSlideDblClick;
  FDblClickTimer := TTimer.Create(self);
  FDblClickTimer.Interval := 500;
  FDblClickTimer.Enabled := false;
  FDblClickTimer.OnTimer := @DblClickTimerHandler;
  with GetControlClassDefaultSize do
    SetInitialBounds(0, 0, CX, CY);
end;

destructor TCustomOnOffSwitch.Destroy;
begin
  FPicture[false].Free;
  FPicture[true].Free;
  FImageListChangeLink.Free;
  inherited;
end;

function TCustomOnOffSwitch.CalcButtonRect: TRect;
begin
  Result := FButtonRect;
  case Orientation of
    soHorizontal : OffsetRect(Result, FButtonPos + CalcMargin, 0);
    soVertical   : OffsetRect(Result, 0, FButtonPos + CalcMargin);
  end;
end;

function TCustomOnOffSwitch.CalcMargin: Integer;
begin
  Result := 3 + GetBorderWidth;
end;

function TCustomOnOffSwitch.CanChange: Boolean;
begin
  Result := Enabled and (not FReadOnly);
end;

procedure TCustomOnOffSwitch.DblClick;
begin
  inherited;
  FDblClickTimer.Enabled := false;
  if CanChange and FTogglePending then begin
    FTogglePending := false;
    SetChecked(not FChecked);
  end;
end;

procedure TCustomOnOffSwitch.DblClickTimerHandler(Sender: TObject);
begin
  FTogglePending := true;
end;

procedure TCustomOnOffSwitch.DoAutoAdjustLayout(
  const AMode: TLayoutAdjustmentPolicy;
  const AXProportion, AYProportion: Double);
begin
  inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion);
  if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
  begin
    case Orientation of
      soHorizontal : FButtonSize := Round(FButtonSize * AXProportion);
      soVertical   : FButtonSize := Round(FButtonSize * AYProportion);
    end;
  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;

  Invalidate;
end;

procedure TCustomOnOffSwitch.DoChange;
begin
  if Assigned(FOnChange) then FOnChange(self);
end;

procedure TCustomOnOffSwitch.DoEnter;
begin
  inherited;
  Invalidate;
end;

procedure TCustomOnOffSwitch.DoExit;
begin
  inherited;
  Invalidate;
end;

procedure TCustomOnOffSwitch.DoImageListChange(Sender: TObject);
begin
  Invalidate;
end;

{ Determines whether the dragged distance lands in the part of the
  ON (Result = true) or OFF state (Result = false) }
function TCustomOnOffSwitch.DraggedToON: Boolean;
begin
  Result := FButtonPos > FMaxDistance div 2;
  if FInverse then Result := not Result;
end;

procedure TCustomOnOffSwitch.DrawButton(ARect: TRect);
var
  rawON, rawOFF: TRawImage;
  Img, ImgOn, ImgOff: TLazIntfImage;
  bmp: TBitmap;
  ImgSize: TSize;
  x, y: Integer;
  idx: Integer;
  ppi: Integer;
begin
  if not Enabled then begin
    Canvas.Brush.Color := clGrayText;
    Canvas.Pen.Color := clGrayText;
  end else begin
    if FFlippedColors then
      Canvas.Brush.Color := Color
    else
    if (saeBlendColors in FAnimationEffects) then
      Canvas.Brush.Color := BlendColors(FButtonPos/FMaxDistance, ColorOFF, ColorON)
    else
    if FChecked then
      Canvas.Brush.Color := ColorON
    else
      Canvas.Brush.Color := ColorOFF;
    Canvas.Pen.Color := clBlack;
  end;
  if not FShowButtonBorder then
    Canvas.Pen.Color := Canvas.Brush.Color;
  Canvas.Pen.Width := 1;
  Canvas.Pen.Style := psSolid;
  if FBorderStyle in [bsNoneRounded, bsThinRounded, bsThickRounded] then
  begin
    dec(ARect.Bottom);
    dec(ARect.Right);
    Canvas.Ellipse(ARect);
  end else
    Canvas.Rectangle(ARect);

  if FImages <> nil then
  begin
    ppi := Font.PixelsPerInch;
    imgSize := FImages.SizeForPPI[FImagesWidth, ppi];
    x := (ARect.Left + ARect.Right - imgSize.CX) div 2;
    y := (ARect.Top + ARect.Bottom - imgSize.CY) div 2;
    idx := FImageIndex[FChecked];
    if idx <> -1 then
    begin
      if ([saeBlendImages, saeRotateImages] * FAnimationEffects <> []) then
      begin
        bmp := TBitmap.Create;
        try
          bmp.PixelFormat := pf32Bit;
          rawOFF.Init;
          rawON.Init;
          FImages.GetRawImage(FImageIndex[false], rawOFF);
          FImages.GetRawImage(FImageIndex[true], rawON);
          imgON := TLazIntfImage.Create(rawON, false);
          imgOFF := TLazIntfImage.Create(rawOFF, false);
          img := TLazIntfImage.CreateCompatible(imgOFF, imgOFF.Width, imgOFF.Height);
          try
            if saeBlendImages in FAnimationEffects then
              BlendImages(img, imgOFF, imgON, FButtonPos/FMaxDistance)
            else
            if FChecked then
              img.Assign(imgON)
            else
              img.Assign(imgOFF);
            if saeRotateImages in FAnimationEffects then
              RotateImage(img, 2*pi * FButtonPos/FMaxDistance);
            bmp.Assign(img);
            Canvas.Draw(x, y, bmp);
          finally
            img.Free;
            imgON.Free;
            imgOFF.Free;
          end;
        finally
          bmp.Free;
        end;
      end else
        FImages.DrawForPPI(Canvas, x, y, idx, FImagesWidth, ppi, GetCanvasScaleFactor, Enabled);
    end;
  end;
end;

procedure TCustomOnOffSwitch.DrawCaption(ARect: TRect; AChecked: Boolean);
var
  ts: TTextStyle;
begin
  Canvas.Font.Assign(Font);
  if not Enabled then
    Canvas.Font.Color := clGrayText;
  ts := Canvas.TextStyle;
  ts.Alignment := taCenter;
  ts.Layout := tlCenter;
  Canvas.TextStyle := ts;
  if AChecked then
    Canvas.TextRect(ARect, ARect.Left, ARect.Top, CaptionON)
  else
    Canvas.TextRect(ARect, ARect.Left, ARect.Top, CaptionOFF);
end;

procedure TCustomOnOffSwitch.DrawFocusRect(ARect: TRect);
var
  m: TPenMode;
  c: Boolean;
begin
  m := Canvas.Pen.Mode;
  c := Canvas.Pen.Cosmetic;
  try
    Canvas.Pen.Color := clBlack;
    Canvas.Pen.Mode := pmXOR;
    Canvas.Pen.Color := clWhite;
    Canvas.Pen.Style := psDot;
    Canvas.Brush.Style := bsClear;
    if FBorderStyle in [bsNoneRounded, bsThinRounded, bsThickRounded] then
    begin
      Canvas.Pen.Cosmetic := true;
      Canvas.Ellipse(ARect);
    end else
    begin
      Canvas.Pen.Cosmetic := false;
      Canvas.Rectangle(ARect);
    end;
  finally
    Canvas.Pen.Mode := m;
    Canvas.Pen.Cosmetic := c;
  end;
end;

function TCustomOnOffSwitch.GetBorderWidth: Integer;
begin
  case FBorderStyle of
    bsNone, bsThin, bsThin3D, bsNoneRounded, bsThinRounded:
      Result := 1;
    bsThick, bsThick3D, bsThickRounded:
      Result := 2;
  end;
end;

function TCustomOnOffSwitch.GetCaptions(AChecked: Boolean): string;
begin
  Result := FCaptions[AChecked];
end;

function TCustomOnOffSwitch.GetColors(AIndex: Integer): TColor;
begin
  Result := FColors[AIndex];
end;

class function TCustomOnOffSwitch.GetControlClassDefaultSize: TSize;
begin
  Result.CX := 60;
  Result.CY := 30;
end;

function TCustomOnOffSwitch.GetImageIndex(AChecked: Boolean): TImageIndex;
begin
  Result := FImageIndex[AChecked];
end;

function TCustomOnOffSwitch.GetOrientation: TSwitchOrientation;
begin
  if Width > Height then Result := soHorizontal else Result := soVertical;
end;

function TCustomOnOffSwitch.GetPicture(AChecked: Boolean): TPicture;
begin
  Result := FPicture[AChecked];
end;

function TCustomOnOffSwitch.HasPicture: Boolean;
begin
  Result := (FPicture[false].Width <> 0) or (FPicture[true].Width <> 0);
end;

procedure TCustomOnOffSwitch.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited;
  if CanChange and ((Key = VK_SPACE) or (Key = VK_RETURN)) then
    Checked := not Checked;
end;

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 (FSwitchMode in [smSlide, smSlideDblClick]) then FDragging := true;
    FMousePt := Point(X, Y);
    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 : delta := X - FMousePt.X;
      soVertical   : delta := Y - FMousePt.Y;
    end;
    FMousePt := Point(X, Y);
    FButtonPos := EnsureRange(FButtonPos + delta, 0, FMaxDistance);
    Invalidate;
  end;
end;

function TCustomOnOffSwitch.MouseOnButton(X, Y: Integer): Boolean;
var
  R: TRect;
begin
  R := CalcButtonRect;
  Result := PtInRect(R, Point(X, Y));
end;

procedure TCustomOnOffSwitch.MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);
var
  oldChecked: Boolean;
begin
  inherited;
  if (Button = mbLeft) and CanChange then begin
    oldChecked := FChecked;
    if FDragging then begin
      FDragging := false;
      FChecked := DraggedToON;
      UpdateButtonPos;
    end else
    begin
      if (FSwitchMode = smClick) or (HasPicture and (FSwitchMode = smSlide)) then
        SetChecked(not FChecked);
      if FChecked <> oldChecked then
        DoChange
      else
      if (FSwitchMode in [smDblClick, smSlideDblClick]) then
        FTogglePending := true;
    end;
    if FChecked <> oldChecked then
      Invalidate;
  end;
end;

procedure TCustomOnOffSwitch.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = Images) then
    SetImages(nil);
end;

procedure TCustomOnOffSwitch.Paint;
var
  R: TRect;
  margin: Integer;
  diam: Integer;
  newChecked: Boolean;
begin
  R := Rect(0, 0, Width, Height);

  if HasPicture then
  begin
    Canvas.StretchDraw(R, FPicture[FChecked].Graphic);
    exit;
  end;

  if Enabled then begin
    if FFlippedColors then begin
      if (saeBlendColors in FAnimationEffects) then
        Canvas.Brush.Color := BlendColors(FButtonPos/FMaxDistance, ColorOFF, ColorON)
      else
      if FChecked then
        Canvas.Brush.Color := ColorON
      else
        Canvas.Brush.Color := ColorOFF;
    end else
      Canvas.Brush.Color := Color;
    Canvas.Pen.Color := BorderColor;
  end else begin
    Canvas.Brush.Color := clInactiveBorder;
    Canvas.Pen.Color := clGrayText;
  end;
  Canvas.Brush.Style := bsSolid;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Width := GetBorderWidth;
  case FBorderStyle of
    bsNone:
      begin
        Canvas.Pen.Style := psClear;
        Canvas.Rectangle(R);
      end;
    bsThin:
      Canvas.Rectangle(R);
    bsThick:
      Canvas.Rectangle(1, 1, Width, Height);
    bsThin3D, bsThick3D:
      begin
        Canvas.Pen.Width := 1;
        Canvas.Pen.Color := clBtnShadow;
        Canvas.Line(R.Left, R.Top, R.Right, R.Top);
        Canvas.Line(R.Left, R.Top, R.Left, R.Bottom);
        if FBorderStyle = bsThick3D then begin
          Canvas.Line(R.Left+1, R.Top+1, R.Right-1, R.Top+1);
          Canvas.Line(R.Left+1, R.Top+1, R.Left+1, R.Bottom-1);
        end;
        Canvas.Pen.Color := clBtnHighlight;
        Canvas.Line(R.Left, R.Bottom-1, R.Right, R.Bottom-1);
        Canvas.Line(R.Right-1, R.Top, R.Right-1, R.Bottom);
        if FBorderStyle = bsThin3D then
        begin
          InflateRect(R, -1, -1);
          Canvas.FillRect(R)
        end else
        begin
          InflateRect(R, -2, -2);
          Canvas.Line(R.Left-1, R.Bottom, R.Right+1, R.Bottom);
          Canvas.Line(R.Right, R.Top-1, R.Right, R.Bottom);
          Canvas.FillRect(R);
        end;
      end;
    bsNoneRounded, bsThinRounded, bsThickRounded:
      begin
        case FBorderStyle of
          bsNoneRounded: Canvas.Pen.Style := psClear;
          bsThickRounded: InflateRect(R, -1, -1);
        end;
        if Orientation = soHorizontal then
          diam := R.Height
        else
          diam := R.Width;
        Canvas.RoundRect(R, diam, diam);
      end;
  end;
  margin := CalcMargin;

  case Orientation of
    soHorizontal:
      FButtonRect := Rect(0, margin, FButtonSize, Height - margin);
    soVertical:
      FButtonRect := Rect(margin, 0, Width - margin, FButtonSize);
  end;

  if FShowCaption then begin
    if FDragging then
      newChecked := DraggedToOn  //DraggingToON(FMovedDistance)
    else
      newchecked := FChecked;
    case Orientation of
      soHorizontal:
        if FChecked xor FInverse then begin
          // Drag begins from button at right
          if FDragging and not (FInverse xor newChecked) then
            DrawCaption(Rect(margin + FButtonSize, margin, Width, Height - margin), FInverse)
          else
            DrawCaption(Rect(0, margin, Width - margin - FButtonSize, Height - margin), not FInverse);
        end else begin
          // Drag begins from button at left
          if FDragging and (FInverse xor newChecked) then
            DrawCaption(Rect(0, margin, Width - margin - FButtonSize, Height - margin), not FInverse)
          else
            DrawCaption(Rect(margin + FButtonSize, margin, Width, Height - margin), FInverse);
        end;
      soVertical:
        if FChecked xor FInverse then begin
          // Drag begins from button at bottom
          if FDragging and not (FInverse xor newChecked) then
            DrawCaption(Rect(margin, margin + FButtonSize, Width-margin, Height), FInverse)
          else
            DrawCaption(Rect(margin, 0, Width - margin, Height - margin - FButtonSize), not FInverse);
        end else begin
          // Drag begins from button at top
          if FDragging and (FInverse xor newChecked) then
            DrawCaption(Rect(margin, 0, Width - margin, Height - margin - FButtonSize), not FInverse)
          else
            DrawCaption(Rect(margin, margin + FButtonsize, Width - margin, Height), FInverse);
        end;
    end;
  end;

  R := CalcButtonRect;
  DrawButton(R);
  if Focused and FShowFocusRect then begin
    InflateRect(R, 2, 2);
    DrawFocusRect(R);
  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;
  FBorderStyle := AValue;
  UpdateShape;
  Invalidate;
end;

procedure TCustomOnOffSwitch.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited;
  UpdateShape;
  UpdateMaxDistance;
end;

procedure TCustomOnOffSwitch.SetButtonSize(AValue: Integer);
begin
  if (AValue = FButtonSize) and (AValue > 0) then
    exit;
  FButtonSize := AValue;
  UpdateMaxDistance;
  Invalidate;
end;

procedure TCustomOnOffSwitch.SetCaptions(AChecked: Boolean; AValue: String);
begin
  if AValue = FCaptions[AChecked] then exit;
  FCaptions[AChecked] := AValue;
  Invalidate;
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
  if AValue = FColors[AIndex] then exit;
  FColors[AIndex] := AValue;
  Invalidate;
end;

procedure TCustomOnOffSwitch.SetFlippedColors(AValue: Boolean);
begin
  if AValue = FFlippedColors then exit;
  FFlippedColors := AValue;
  Invalidate;
end;

procedure TCustomOnOffSwitch.SetImageIndex(AChecked: Boolean; AValue: TImageIndex);
begin
  if FImageIndex[AChecked] = AValue then Exit;
  FImageIndex[AChecked] := AValue;
  Invalidate;
end;

procedure TCustomOnOffSwitch.SetImages(const AValue: TCustomImageList);
begin
  if FImages = AValue then Exit;
  if FImages <> nil then
  begin
    FImages.UnRegisterChanges(FImageListChangeLink);
    FImages.RemoveFreeNotification(Self);
  end;
  FImages := AValue;
  if FImages <> nil then
  begin
    FImages.FreeNotification(Self);
    FImages.RegisterChanges(FImageListChangeLink);
  end;
  DoImageListChange(Self);
end;

procedure TCustomOnOffSwitch.SetInverse(AValue: boolean);
begin
  if AValue = FInverse then exit;
  FInverse := AValue;
  UpdateButtonPos;
  Invalidate;
end;

procedure TCustomOnOffSwitch.SetPicture(AChecked: Boolean; AValue: TPicture);
begin
  if AValue = FPicture[AChecked] then
    exit;
  if AValue = nil then
    FPicture[AChecked].Clear
  else
    FPicture[AChecked].Assign(AValue);
  Invalidate;
end;

procedure TCustomOnOffSwitch.SetShowButtonBorder(AValue: Boolean);
begin
  if AValue = FShowButtonBorder then exit;
  FShowButtonBorder := AValue;
  DoChange;
  Invalidate;
end;

procedure TCustomOnOffSwitch.SetShowCaption(AValue: Boolean);
begin
  if AValue = FShowCaption then exit;
  FShowCaption := AValue;
  DoChange;
  Invalidate;
end;

procedure TCustomOnOffSwitch.SetShowFocusRect(AValue: Boolean);
begin
  if AValue = FShowFocusRect then exit;
  FShowFocusRect := AValue;
  DoChange;
  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.UpdateShape;
var
  R: TRect;
  bmp: TBitmap;
  diam: Integer;
begin
  R := Rect(0, 0, Width, Height);
  bmp := TBitmap.Create;
  try
    bmp.Monochrome := true;
    bmp.SetSize(R.Width, R.Height);
    if FBorderStyle in [bsNoneRounded, bsThinRounded, bsThickRounded] then
    begin
      if Orientation = soHorizontal then
        diam := R.Height
      else
        diam := R.Width;
      bmp.Canvas.Brush.Color := clBlack;
      bmp.Canvas.FillRect(R);
      bmp.Canvas.Brush.Color := clWhite;
//      bmp.Canvas.Pen.Style := psClear;
      bmp.Canvas.Pen.Color := clWhite;
      bmp.Canvas.Pen.Width := GetBorderWidth;
      if FBorderStyle = bsThickRounded then
        InflateRect(R, -1, -1);
      bmp.Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, diam, diam);
    end else
    begin
      bmp.Canvas.Brush.Color := clWhite;
      bmp.Canvas.FillRect(R);
    end;
    SetShape(bmp);
  finally
    bmp.Free;
  end;
end;

end.