industrialstuff: Version 0.3. Add TmKnob and TmOnOffSwitch. High-dpi palette icons for TA3nalogGauge, TmKnow and TOnOffSwitch.

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

components/industrialstuff/Example/OnOffSwitch_Knob_Sample/demo.lpi

@@ -0,0 +1,82 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="demo"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+      <Icon Value="0"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="industrial"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="demo.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="main.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="MainForm"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="demo"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

components/industrialstuff/Example/OnOffSwitch_Knob_Sample/demo.lpr

@@ -0,0 +1,22 @@
+program demo;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, main
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  Application.Initialize;
+  Application.CreateForm(TMainForm, MainForm);
+  Application.Run;
+end.
+

components/industrialstuff/Example/OnOffSwitch_Knob_Sample/main.lfm

@@ -0,0 +1,50 @@
+object MainForm: TMainForm
+  Left = 282
+  Height = 305
+  Top = 133
+  Width = 248
+  Caption = 'Demo'
+  ClientHeight = 305
+  ClientWidth = 248
+  OnCreate = FormCreate
+  LCLVersion = '2.1.0.0'
+  object Knob: TmKnob
+    Left = 104
+    Height = 96
+    Top = 200
+    Width = 88
+    Position = 0
+    MarkStyle = msCircle
+    OnChange = KnobChange
+  end
+  object OnOffSwitch: TOnOffSwitch
+    Left = 15
+    Height = 30
+    Top = 216
+    Width = 60
+    CaptionOFF = 'OFF'
+    CaptionON = 'ON'
+    Checked = True
+    OnChange = OnOffSwitchChange
+    TabOrder = 1
+  end
+  object AnalogGauge: TA3nalogGauge
+    Left = 8
+    Height = 190
+    Top = 8
+    Width = 232
+    Caption = 'Volts'
+    CaptionFont.Height = -19
+    CaptionFont.Style = [fsBold]
+    Position = 0
+  end
+  object Edit: TEdit
+    Left = 15
+    Height = 23
+    Top = 264
+    Width = 61
+    Alignment = taRightJustify
+    OnEditingDone = EditEditingDone
+    TabOrder = 3
+  end
+end

components/industrialstuff/Example/OnOffSwitch_Knob_Sample/main.pas

@@ -0,0 +1,66 @@
+unit main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, MKnob,
+  switches, A3nalogGauge;
+
+type
+
+  { TMainForm }
+
+  TMainForm = class(TForm)
+    AnalogGauge: TA3nalogGauge;
+    Edit: TEdit;
+    Knob: TmKnob;
+    OnOffSwitch: TOnOffSwitch;
+    procedure EditEditingDone(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure KnobChange(Sender: TObject; AValue: Longint);
+    procedure OnOffSwitchChange(Sender: TObject);
+  private
+
+  public
+
+  end;
+
+var
+  MainForm: TMainForm;
+
+implementation
+
+{$R *.lfm}
+
+{ TMainForm }
+
+procedure TMainForm.EditEditingDone(Sender: TObject);
+var
+  s: String;
+begin
+  s := Edit.Text;
+  while (s <> '') and not (s[Length(s)] in ['0'..'9']) do
+    SetLength(s, Length(s)-1);
+  Knob.Position := StrToInt(s);
+end;
+
+procedure TMainForm.FormCreate(Sender: TObject);
+begin
+  Knob.Position := 40;
+end;
+
+procedure TMainForm.KnobChange(Sender: TObject; AValue: Longint);
+begin
+  AnalogGauge.Position := Knob.Position;
+  Edit.Text := IntToStr(Knob.Position) + ' V';
+end;
+
+procedure TMainForm.OnOffSwitchChange(Sender: TObject);
+begin
+  Knob.AllowUserDrag := OnOffSwitch.Checked
+end;
+
+end.
+

components/industrialstuff/industrial.lpk

@@ -4,7 +4,7 @@
     <PathDelim Value="\"/>
     <Name Value="industrial"/>
     <Type Value="RunAndDesignTime"/>
-    <Author Value="Jurassic Pork; A3nalogGauge by Irnis Haliullin"/>
+    <Author Value="Initial version by Jurassic Pork; various authors (see unit headers)."/>
     <CompilerOptions>
       <Version Value="11"/>
       <PathDelim Value="\"/>
@@ -28,12 +28,15 @@
     <Description Value="Industrial-themed components and gauges:
 - LED indicators
 - LED seven-sigment display
+- Gauges
 - stop-light lamps
 - analog gauges
-- thermometer-like gauge"/>
-    <License Value="MPL  + GPL "/>
-    <Version Minor="2"/>
-    <Files Count="11">
+- thermometer-like gauge
+- knob
+- on/off switch"/>
+    <License Value="MPL  + GPL + modified LGPL (see unit headers)."/>
+    <Version Minor="3"/>
+    <Files Count="13">
       <Item1>
         <Filename Value="source\indled.pas"/>
         <UnitName Value="IndLed"/>
@@ -79,6 +82,14 @@
         <Filename Value="source\a3naloggauge.pas"/>
         <UnitName Value="A3nalogGauge"/>
       </Item11>
+      <Item12>
+        <Filename Value="source\mknob.pas"/>
+        <UnitName Value="MKnob"/>
+      </Item12>
+      <Item13>
+        <Filename Value="source\switches.pas"/>
+        <UnitName Value="switches"/>
+      </Item13>
     </Files>
     <RequiredPkgs Count="1">
       <Item1>

components/industrialstuff/industrial.pas

@@ -9,8 +9,8 @@ interface
 
 uses
   IndLed, Sensors, AllIndustrialRegister, LedNumber, indGnouMeter, AdvLed, 
-  indcyBaseLed, indcyClasses, indcyGraphics, indcyTypes, A3nalogGauge, 
-  LazarusPackageIntf;
+  indcyBaseLed, indcyClasses, indcyGraphics, indcyTypes, A3nalogGauge, MKnob, 
+  switches, LazarusPackageIntf;
 
 implementation
 

components/industrialstuff/resources/industrial_icons.txt

@@ -4,4 +4,12 @@ tindgnoumeter.png
 tindled.png
 tlednumber.png
 tstoplightsensor.png
-ta3naloggauge.bmp
+ta3naloggauge.png
+ta3naloggauge_150.png
+ta3naloggauge_200.png
+tmknob.png
+tmknob_150.png
+tmknob_200.png
+tonoffswitch.png
+tonoffswitch_150.png
+tonoffswitch_200.png

components/industrialstuff/source/AllIndustrialRegister.pas

@@ -12,7 +12,7 @@ interface
 
  uses
   Classes, LResources, AdvLed, IndLed, LedNumber, Sensors, IndGnouMeter,
-  A3nalogGauge;
+  A3nalogGauge, MKnob, Switches;
 
 procedure Register;
 
@@ -25,7 +25,7 @@ procedure Register;
 begin
   RegisterComponents ('Industrial',[
     TAdvLed, TIndLed, TLedNumber, TStopLightSensor,
-    TAnalogSensor, TA3nalogGauge, TindGnouMeter
+    TAnalogSensor, TA3nalogGauge, TindGnouMeter, TmKnob, TOnOffSwitch
   ]);
 
 end;

components/industrialstuff/source/a3naloggauge.pas

@@ -1,6 +1,6 @@
 unit A3nalogGauge;
 
-{$DEFINE TICKER}
+{.$DEFINE TICKER}
 
 {$IFDEF FPC}
   {$MODE DELPHI}
@@ -13,7 +13,7 @@ interface
 
 uses
  {$IFDEF LCL}
-  LCLIntf, LCLType, LCLProc, LMessages,
+  LCLIntf, LCLType, LCLProc, Types,
   {$IFDEF TICKER} Windows,{$ENDIF}      // for QueryPerformanceCounter
  {$ELSE}
   Windows, Messages,
@@ -248,6 +248,7 @@ begin
   FFaceBitmap := TBitmap.Create;
   FAABitmap := nil;
   //*****************************defaults:****************************************
+  (*
   {$IFDEF LCL}
   with GetControlClassDefaultSize do begin
     SetInitialBounds(0, 0, CX, CY);
@@ -255,11 +256,12 @@ begin
     h := CY;
   end;
   {$ELSE}
+  *)
   w := 225;
   h := 180;
   Width := w;
   Height := h;
-  {$ENDIF}
+//  {$ENDIF}
   FBackBitmap.Width := w;
   FBackBitmap.Height := h;
   FBackBitmap.Canvas.Brush.Style := bsClear;
@@ -314,9 +316,11 @@ begin
 end;
 { ------------------------------------------------------------------------- }
 procedure SetPenStyles(Pen: TPen; Width: Integer; Color: TColor);
+{$IFNDEF LCL}
 var
   HP: HPen;
   LB: TLOGBRUSH;
+{$IFEND}
 begin
   {$IFDEF LCL}
   Pen.Width := Width;
@@ -332,7 +336,7 @@ begin
     Pen.Color := Color
   end else
     Pen.Handle := HP;
-  {$ENDIF}
+  {$IFEND}
 end;
 
 procedure TA3nalogGauge.CaptionFontChanged(Sender: TObject);
@@ -366,7 +370,7 @@ begin
     Canvas.Brush.Color := FFaceColor;
     Canvas.FillRect(Canvas.ClipRect);
     Canvas.Font.Assign(Font);
-    GetTextMetrics(Canvas.Handle, tm);
+    GetTextMetrics(Canvas.Handle, tm{%H-});
     hfnt := tm.tmHeight * K;
     Canvas.Font.Height := hFnt;
 

components/industrialstuff/source/mknob.pas

@@ -0,0 +1,554 @@
+unit MKnob;
+
+{ TmKnob : Marco Caselli's Knob Control rel. 1.0
+ This component emulate the volume knob you could find on some HiFi devices;
+**********************************************************************
+* Feel free to use or give away this software as you see fit.        *
+* Please leave the credits in place if you alter the source.         *
+*                                                                    *
+* This software is delivered to you "as is",                         *
+* no guarantees of any kind.                                         *
+*                                                                    *
+* If you find any bugs, please let me know, I will try to fix them.  *
+* If you modify the source code, please send me a copy               *
+*                                                                    *
+* If you like this component,  and also if you dislike it ;), please *
+* send me an E-mail with your comment                                *
+* Marco Caselli                                                      *
+* Web site : http://members.tripod.com/dartclub                      *
+* E-mail   : mcaselli@iname.com                                      *
+*                                                                    *
+* Thank to guy at news://marcocantu.public.italian.delphi            *
+* for some math code. Check the site http://www.marcocantu.com       *
+**********************************************************************
+*** Sorry for my bad english ...............
+ Properties :
+      AllowUserDrag : Boolean; Specify if user can or not drag the control
+                               to a new value using mouse;
+      FaceColor : TColor;      Color of knob face;
+      TickColor : TColor;      Color of tick mark;
+      Position : Longint;      Current position of the knob;
+      MarkStyle: TMarkStyle;   Specify style of the tick mark ( actually only
+                               line or filled circle;
+      RotationEffect:Boolean;    If True, the knob will shake emulating a rotation
+                                  visual effect.
+      Position:Longint;        Current value of knob;
+      Max : Longint;           Upper limit value for Position;
+      Min : Longint;           Lower limit value for Position;
+
+ Events:
+    property OnChange :        This event is triggered every time you change the
+                               knob value;
+
+ Lazarus port by W.Pamler
+*******************************************************************************}
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  LclIntf, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, math, ComCtrls;
+
+const
+  DEFAULT_KNOB_FACE_COLOR = $00B5CCBD;
+  DEFAULT_KNOB_MARK_SIZE = 6;
+
+type
+  TKnobAngleRange = (
+    arTop270, arTop180, arTop120, arTop90,
+    arBottom270, arBottom180, arBottom120, arBottom90,
+    arLeft270, arLeft180, arLeft120, arLeft90,
+    arRight270, arRight180, arRight120, arRight90
+  );
+  TKnobChangeEvent = procedure(Sender: TObject; AValue: Longint) of object;
+  TKnobMarkStyle = (msLine, msCircle, msTriangle);
+
+  TmKnob = class(TCustomControl)
+  private
+    { Private declarations }
+    FMaxValue: Integer;
+    FMinValue: Integer;
+    FCurValue: Integer;
+    FFaceColor: TColor;
+    FTickColor: TColor;
+    FAllowDrag: Boolean;
+    FOnChange: TKnobChangeEvent;
+    FFollowMouse: Boolean;
+    FMarkSize: Integer;
+    FMarkStyle: TKnobMarkStyle;
+    FAngleRange: TKnobAngleRange;
+    FRotationEffect: Boolean;
+    FTransparent: Boolean;
+    function GetAngleOrigin: Double;
+    function GetAngleRange: Double;
+    procedure SetAllowDrag(AValue: Boolean);
+    procedure SetAngleRange(AValue: TKnobAngleRange);
+    procedure SetCurValue(AValue: Integer);
+    procedure SetFaceColor(AColor: TColor);
+    procedure SetMarkSize(AValue: Integer);
+    procedure SetMarkStyle(AValue: TKnobMarkStyle);
+    procedure SetMaxValue(AValue: Integer);
+    procedure SetMinValue(AValue: Integer);
+    procedure SetTickColor(AValue: TColor);
+    procedure SetTransparent(AValue: Boolean);
+    procedure UpdatePosition(X, Y: Integer);
+
+  protected  { Protected declarations }
+    procedure KnobChange;
+    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+    procedure Paint; override;
+
+  public
+    { Public declarations }
+    constructor Create(AOwner: TComponent); override;
+
+  published
+    { Published declarations }
+    property Align;
+    property AllowUserDrag: Boolean read FAllowDrag write SetAllowDrag default True;
+    property AngleRange: TKnobAngleRange read FAngleRange write SetAngleRange default arTop270;
+    property BorderSpacing;
+    property Color;
+    property FaceColor: TColor read FFaceColor write SetFaceColor default DEFAULT_KNOB_FACE_COLOR;
+    property TickColor: TColor read FTickColor write SetTickColor default clBlack;
+    property Position: Integer read FCurValue write SetCurValue;
+    property RotationEffect: Boolean read FRotationEffect write FRotationEffect default false;
+    property Enabled;
+    property MarkSize: Integer read FMarkSize write SetMarkSize default DEFAULT_KNOB_MARK_SIZE;
+    property MarkStyle: TKnobMarkStyle read FMarkStyle write SetMarkStyle default msLine;
+    property Max: Integer read FMaxValue write SetMaxValue default 100;
+    property Min: Integer read FMinValue write SetMinvalue default 0;
+    property OnChange: TKnobChangeEvent read FOnChange write FOnChange;
+    property ParentColor;
+    property ParentShowHint;
+    property ShowHint;
+    property Transparent: Boolean read FTransparent write SetTransparent default true;
+    property Visible;
+  end;
+
+implementation
+
+function Rotate(P, Center: TPoint; SinAngle, CosAngle: Double): TPoint;
+begin
+  P.X := P.X - Center.X;
+  P.Y := P.Y - Center.Y;
+  Result.X := round(cosAngle * P.X - sinAngle * P.Y) + Center.X;
+  Result.Y := round(sinAngle * P.X + cosAngle * P.Y) + Center.Y;
+end;
+
+constructor TmKnob.Create(AOwner : TComponent);
+begin
+  inherited Create(AOwner);
+  ControlStyle := ControlStyle + [csOpaque];
+  Width := 60;
+  Height := 60;
+  FMaxValue := 100;
+  FMinValue := 0;
+  FCurValue := 0;
+  FRotationEffect := false;
+  FMarkStyle := msLine;
+  FMarkSize := DEFAULT_KNOB_MARK_SIZE;
+  FTickColor := clBlack;
+  FFaceColor := DEFAULT_KNOB_FACE_COLOR;
+  FFollowMouse := false;
+  FAllowDrag := true;
+  FAngleRange := arTop270;
+  FTransparent := true;
+end;
+
+function TmKnob.GetAngleOrigin: Double;
+const
+  ORIGIN: array[TKnobAngleRange] of Double = (
+      0,   0,   0,   0,
+    180, 180, 180, 180,
+     90,  90,  90,  90,
+    270, 270, 270, 270
+  );
+begin
+  Result := DegToRad(ORIGIN[FAngleRange]);
+end;
+
+function TmKnob.GetAngleRange: Double;
+const
+  ANGLE: array[TKnobAngleRange] of Double = (
+    270, 180, 120, 90,
+    270, 180, 120, 90,
+    270, 180, 120, 90,
+    270, 180, 120, 90
+    );
+begin
+  Result := DegToRad(ANGLE[FAngleRange]);
+end;
+
+procedure TmKnob.KnobChange;
+begin
+  if Assigned(FOnChange) then
+    FOnChange(Self, FCurValue);
+end;
+
+procedure TmKnob.MouseDown(Button: TMouseButton; Shift: TShiftState;
+  X, Y: Integer);
+begin
+  inherited MouseDown(Button, Shift, X, Y);
+  if FAllowDrag then
+  begin
+    FFollowMouse := True;
+    UpdatePosition(X,Y);
+    Refresh;
+  end;
+end;
+
+procedure TmKnob.MouseUp(Button: TMouseButton; Shift: TShiftState;
+  X, Y: Integer);
+begin
+  inherited MouseUp(Button, Shift, X, Y);
+  FFollowMouse := False;
+end;
+
+procedure TmKnob.MouseMove(Shift: TShiftState; X, Y: Integer);
+begin
+  inherited MouseMove(Shift, X, Y);
+  if FFollowMouse then
+    UpdatePosition(X,Y)
+end;
+
+                        (*
+procedure TmKnob.Paint;
+var	R             : TRect;
+       	Bm            : TBitMap;
+        Co,Si,Angle   : Double;
+        X, Y,W, H     : Integer;
+        dx,dy,gx,gy   : Integer;
+        OuterPoint    : TPoint;
+begin
+	{ Initialize offscreen BitMap }
+   Bm := TBitMap.Create;
+   if ( csdesigning in componentstate) then
+      if Height < Width then
+         Height:=Width
+      else
+         Width:=Height;
+
+   Bm.Width := Width;
+   Bm.Height := Height;
+   Bm.Canvas.Brush.Color := clBTNFACE; //clWindow;
+   R.Left := 0;
+   R.Top := 0;
+   R.Right := Width ;//- 1;
+   R.Bottom := Height;// - 1;
+   W := R.Right - R.Left -4;
+   H := R.Bottom - R.Top -4;
+   { This weird thing make knob "shake", emulating a rotation effect.
+      Not so pretty, but I like it..............}
+   if fRotationEffect then
+      if (position mod 2) <> 0 then
+         inc(h);
+
+   Bm.Canvas.FillRect(R);
+
+   with Bm.Canvas do
+    begin
+
+    Brush.Color := FaceColor;
+    Pen.Width := 2;
+    Pen.Color := Cl3dlight;
+    ellipse(1, 1, W-1, H-1);
+    Pen.Color := Clbtnshadow;
+    ellipse(3, 3, W+2, H+2);
+
+    Pen.Color := Clbtnface;
+    Pen.Width := 1;
+    RoundRect(2,2,w,h,w,h);
+    Pen.Width := 3;
+    Pen.Color := TickColor;
+
+    if Position >= 0 then
+    begin
+      Brush.Color := FaceColor;
+      X := W div 2;
+      Y := H div 2;
+      dX := W div 6;
+      dY := H div 6;
+      gX := W div 32;
+      gY := H div 32;
+
+      Angle:=(Position - (Min + Max)/2 ) / (Max - Min) * 5 ;
+
+      Si:=Sin(Angle);
+      Co:=Cos(Angle);
+      OuterPoint.X:=Round(X + Si * (X-dx));
+      OuterPoint.Y:=Round(Y - Co * (Y-dy));
+      MoveTo(OuterPoint.X,OuterPoint.y);
+
+      case MarkStyle of
+        msLine   : LineTo(Round(X + Si * (X-gx)),Round(Y - Co * (Y-gy)));
+  { this implementation of circle style is very poor but for my needing is enough}
+        msCircle : begin
+                   Brush.Color := TickColor;
+                   RoundRect(OuterPoint.X-3, OuterPoint.Y-3,
+                             OuterPoint.X+3, OuterPoint.Y+3,
+                             OuterPoint.X+3, OuterPoint.Y+3);
+                   end;
+      end;
+    end;
+   end;
+
+   Canvas.CopyMode := cmSrcCopy;
+   Canvas.Draw(0, 0, Bm);
+   bm.Destroy;
+end;
+             *)
+
+procedure TmKnob.Paint;
+const
+  cPENWIDTH = 1;
+  cMARGIN = 4*cPENWIDTH;
+var
+  R: TRect;
+  bmp: TBitmap;
+  Angle, sinAngle, cosAngle: Double;
+  //X, Y,
+  W, H: Integer;
+  i: Integer;
+  P: array[0..3] of TPoint;
+  margin: Integer;
+  markerSize: Integer;
+  radius: Integer;
+  ctr: TPoint;
+  penwidth: Integer;
+begin
+  margin := Scale96ToFont(cMARGIN);
+  penwidth := Scale96ToFont(cPENWIDTH);
+
+  { Initialize offscreen BitMap }
+  bmp := TBitmap.Create;
+  try
+    bmp.Width := Width;
+    bmp.Height := Height;
+    if FTransparent then
+    begin
+      bmp.Transparent := true;
+      bmp.TransparentColor := clForm;
+      bmp.Canvas.Brush.Color := bmp.TransparentColor;
+    end else
+    begin
+      bmp.Transparent := false;
+      if Color = clDefault then
+        bmp.Canvas.Brush.Color := clForm
+      else
+        bmp.Canvas.Brush.Color := Color;
+    end;
+    ctr := Point(Width div 2, Height div 2);
+    R := Rect(0, 0, Width, Height);
+    W := R.Right - R.Left - margin;
+    H := R.Bottom - R.Top - margin;
+    if H < W then
+      radius := H div 2
+    else
+      radius := W div 2;
+
+    { This weird thing make knob "shake", emulating a rotation effect.
+      Not so pretty, but I like it..............}
+    if FRotationEffect and (Position mod 2 <> 0) then
+      inc(H);
+
+    with bmp.Canvas do
+    begin
+      FillRect(R);
+
+      Brush.Color := FaceColor;
+      Pen.Color := cl3dLight;
+      Pen.Width := penwidth * 2;
+      Pen.Style := psSolid;
+      R := Rect(ctr.X, ctr.Y, ctr.X, ctr.Y);
+      InflateRect(R, radius - penwidth, radius - penwidth);
+      OffsetRect(R, -penwidth, -penwidth);
+      Ellipse(R);
+
+      Pen.Color := clBtnShadow;
+      OffsetRect(R, 3*penwidth, 3*penwidth);
+      Ellipse(R);
+
+      Pen.Color := clBtnFace;
+      Pen.Width := 1;
+      OffsetRect(R, -2*penwidth, -2*penwidth);
+      Ellipse(R);
+
+      if Position >= 0 then
+      begin
+        markersize := radius * FMarkSize div 100;
+        if markersize < 5 then markersize := 5;
+
+        Angle := (Position - (Min + Max)/2 ) / (Max - Min) * GetAngleRange + GetAngleOrigin;
+        SinCos(Angle, sinAngle, cosAngle);
+
+        case MarkStyle of
+          msLine:
+            begin
+              Pen.Width := 3;
+              Pen.Color := TickColor;
+              P[0] := Point(ctr.X, markersize);
+              P[1] := Point(P[0].X, P[0].Y + markersize);
+              for i:=0 to 1 do
+                P[i] := Rotate(P[i], ctr, sinAngle, cosAngle);
+              MoveTo(P[0].X, P[0].Y);
+              LineTo(P[1].X, P[1].Y);
+            end;
+          msCircle:
+            begin
+              Brush.Color := TickColor;
+              Pen.Style := psClear;
+              P[0] := Rotate(Point(ctr.X, MARGIN + markersize + H div 32), ctr, sinAngle, cosAngle);
+              R := Rect(P[0].X, P[0].Y, P[0].X, P[0].Y);
+              InflateRect(R, markersize, markersize);
+              Ellipse(R);
+            end;
+          msTriangle:
+            begin
+              Brush.Color := TickColor;
+              Pen.Style := psClear;
+              P[0] := Point(ctr.X, H div 32);
+              P[1] := Point(P[0].X - markersize, P[0].Y + markersize*2);
+              P[2] := Point(P[0].X + markersize, P[0].Y + markersize*2);
+              P[3] := P[0];
+              for i:=0 to High(P) do
+                P[i] := Rotate(P[i], ctr, sinAngle, cosAngle);
+              Polygon(P);
+            end;
+        end;
+      end;
+    end;
+
+    Canvas.CopyMode := cmSrcCopy;
+    Canvas.Draw(0, 0, bmp);
+  finally
+    bmp.Free;
+  end;
+end;
+
+procedure TmKnob.SetAllowDrag(AValue: Boolean);
+begin
+  if AValue <> FAllowDrag then
+  begin
+    FAllowDrag := AValue;
+    Invalidate;
+  end;
+end;
+
+procedure TmKnob.SetAngleRange(AValue: TKnobAngleRange);
+begin
+  if AValue <> FAngleRange then
+  begin
+    FAngleRange := AValue;
+    Invalidate;
+  end;
+end;
+
+procedure TmKnob.SetCurValue(AValue: Integer);
+var
+  tmp: Integer;
+begin
+  if AValue <> FCurValue then
+  begin
+    if FMinValue > FMaxValue then begin
+      tmp := FMinValue;
+      FMinValue := FMaxValue;
+      FMaxValue := tmp;
+    end;
+    FCurValue := EnsureRange(AValue, FMinValue, FMaxValue);
+    Invalidate;
+    KnobChange;
+  end;
+end;
+
+procedure TmKnob.SetFaceColor(AColor: TColor);
+begin
+  if FFaceColor <> AColor then begin
+    FFaceColor := AColor;
+    Invalidate;
+  end;
+end;
+
+procedure TmKnob.SetMarkSize(AValue: Integer);
+begin
+  if AValue <> FMarkSize then
+  begin
+    FMarkSize := AValue;
+    Invalidate;
+  end;
+end;
+
+procedure TmKnob.SetMarkStyle(AValue: TKnobMarkStyle);
+begin
+  if AValue <> FMarkStyle then
+  begin
+    FMarkStyle := AValue;
+    Invalidate;
+  end;
+end;
+
+procedure TmKnob.SetMaxValue(AValue: Integer);
+begin
+  if AValue <> FMaxValue then
+  begin
+    FMaxValue := AValue;
+    Invalidate;
+  end;
+end;
+
+procedure TmKnob.SetMinValue(AValue: Integer);
+begin
+  if AValue <> FMinValue then
+  begin
+    FMinValue := AValue;
+    Invalidate;
+  end;
+end;
+
+procedure TmKnob.SetTickColor(AValue: TColor);
+begin
+  if AValue <> FTickColor then
+  begin
+    FTickColor := AValue;
+    Invalidate;
+  end;
+end;
+
+procedure TmKnob.SetTransparent(AValue: Boolean);
+begin
+  if FTransparent = AValue then exit;
+  FTransparent := AValue;
+  Invalidate;
+end;
+
+
+procedure TmKnob.UpdatePosition(X, Y: Integer);
+var
+  CX, CY: integer;
+  R: double;
+  Angle: double;
+begin
+  CX := Width div 2;
+  CY := Height div 2;
+  R := Round(sqrt(sqr(CX-X) + sqr(CY-Y)));
+  if R = 0 then R := 0.0001;
+
+  if Y < CY then
+    Angle := arcsin((X-CX)/R)
+  else
+  begin
+    Angle := arcsin((CX-X)/R);
+    if X > CX then
+      Angle := Angle + Pi
+    else
+      Angle := Angle - Pi;
+  end;
+  Position := Round((Angle - GetAngleOrigin) * (Max - Min) / GetAngleRange + (Min + Max) / 2);
+  Refresh;
+end;
+
+
+end.

components/industrialstuff/source/switches.pas

@@ -0,0 +1,640 @@
+{
+ /***************************************************************************
+                                 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
+  Graphics, Classes, SysUtils, Types, Controls, ExtCtrls;
+
+type
+  TSwitchBorderStyle = (bsNone, bsThin, bsThick, bsThin3D, bsThick3D);
+  TSwitchOrientation = (soHorizontal, soVertical);
+
+  TCustomOnOffSwitch = class(TCustomControl)
+  private
+    FBorderStyle: TSwitchBorderStyle;
+    FButtonSize: Integer;
+    FCaptions: array[0..1] of string;
+    FChecked: Boolean;
+    FColors: array [0..2] of TColor;
+    FInverse: Boolean;
+    FDragging: Boolean;
+    FDraggedDistance: Integer;
+    FTogglePending: Boolean;
+    FMousePt: TPoint;
+    FButtonRect: TRect;
+    FReadOnly: Boolean;
+    FShowButtonBorder: Boolean;
+    FShowCaption: Boolean;
+    FOnChange: TNotifyEvent;
+    FDblClickTimer: TTimer;
+    function GetBorderWidth: Integer;
+    function GetCaptions(AIndex: Integer): String;
+    function GetColors(AIndex: Integer): TColor;
+    function GetOrientation: TSwitchOrientation;
+    function IsButtonSizeStored: Boolean;
+    procedure SetBorderStyle(AValue: TSwitchBorderStyle); reintroduce;
+    procedure SetButtonSize(AValue: Integer);
+    procedure SetCaptions(AIndex: Integer; AValue: string);
+    procedure SetChecked(AValue: Boolean);
+    procedure SetColors(AIndex: Integer; AValue: TColor);
+    procedure SetInverse(AValue: Boolean);
+    procedure SetShowButtonBorder(AValue: Boolean);
+    procedure SetShowCaption(AValue: Boolean);
+  protected
+    function CalcButtonRect(ADelta: Integer): TRect;
+    function CalcMargin: Integer;
+    function CanChange: Boolean; virtual;
+    procedure DblClick; override;
+    procedure DblClickTimerHandler(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;
+    procedure DrawButton(ARect: TRect); virtual;
+    procedure DrawCaption(ARect: TRect; AChecked: Boolean); virtual;
+    procedure DrawFocusRect(ARect: TRect);
+    class function GetControlClassDefaultSize: TSize; override;
+    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 Paint; override;
+    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 stored IsButtonSizeStored;
+    property CaptionOFF: String index 0 read GetCaptions write SetCaptions;
+    property CaptionON: String index 1 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 Inverse: Boolean read FInverse write SetInverse default false;
+    property ReadOnly: boolean read FReadOnly write FReadOnly default false;
+    property ShowButtonBorder: Boolean read FShowButtonBorder write SetShowButtonBorder default true;
+    property ShowCaption: Boolean read FShowCaption write SetShowCaption default true;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+  public
+    constructor Create(AOwner: TComponent); override;
+    property Orientation: TSwitchOrientation read GetOrientation;
+  end;
+
+  TOnOffSwitch = class(TCustomOnOffSwitch)
+  published
+    property BorderColor;
+    property BorderStyle;
+    property ButtonSize;
+    property CaptionOFF;
+    property CaptionON;
+    property Checked;
+    property Color;
+    property ColorOFF;
+    property ColorON;
+    property Enabled;
+    property Inverse;
+    property ReadOnly;
+    property ShowButtonBorder;
+    property ShowCaption;
+    property OnChange;
+
+    // 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;
+
+    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
+  LCLIntf, LCLType, Math;
+
+const
+  DEFAULT_BUTTON_SIZE = 24;
+
+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 brigher
+    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;
+  FBorderStyle := bsThin;
+  FButtonSize := Scale96ToFont(DEFAULT_BUTTON_SIZE);
+  FColors[0] := clMaroon; // unchecked color
+  FColors[1] := clGreen;  // checked color
+  FColors[2] := clGray;   // Border color
+  FCaptions[0] := 'OFF';
+  FCaptions[1] := 'ON';
+  FShowCaption := true;
+  FShowButtonBorder := true;
+  FDblClickTimer := TTimer.Create(self);
+  FDblClickTimer.Interval := 500;
+  FDblClickTimer.Enabled := false;
+  FDblClickTimer.OnTimer := @DblClickTimerHandler;
+  with GetControlClassDefaultSize do
+    SetInitialBounds(0, 0, CX, CY);
+end;
+
+function TCustomOnOffSwitch.CalcButtonRect(ADelta: Integer): TRect;
+
+  function GetOffset(AMaxSize, ABtnSize: Integer): Integer;
+  var
+    pStart, pEnd, margin: Integer;
+  begin
+    margin := CalcMargin;
+    if (FInverse xor FChecked) then begin
+      // Button at right (or bottom), ADelta is negative
+      pStart := AMaxSize - ABtnSize - margin;
+      pEnd := margin;
+      if ADelta < pEnd - pStart then
+        result := pEnd
+      else if ADelta > 0 then
+        result := pStart
+      else
+        Result := pStart + ADelta;
+    end else begin
+      // Button at left (or top), ADelta is positive
+      pStart := margin;
+      pEnd := AMaxSize - ABtnSize - margin;
+      if ADelta < 0 then
+        Result := pStart
+      else if ADelta > pEnd - pStart then
+        Result := pEnd
+      else
+        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));
+  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;
+  if CanChange and FTogglePending then begin
+    Checked := not Checked;
+    FTogglePending := false;
+  end;
+  FDblClickTimer.Enabled := false;
+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
+    DisableAutosizing;
+    try
+      if IsButtonSizeStored then
+        case Orientation of
+          soHorizontal : FButtonSize := Round(FButtonSize * AXProportion);
+          soVertical   : FButtonSize := Round(FButtonSize * AYProportion);
+        end;
+    finally
+      EnableAutoSizing;
+    end;
+  end;
+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;
+
+{ Determines whether the dragged distance lands in the part of the ON or OFF state }
+function TCustomOnOffSwitch.DraggingToValue(ADistance: Integer): Boolean;
+var
+  margin: Integer;
+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;
+end;
+
+procedure TCustomOnOffSwitch.DrawButton(ARect: TRect);
+begin
+  if not Enabled then begin
+    Canvas.Brush.Color := clGrayText;
+    Canvas.Pen.Color := clGrayText;
+  end else begin
+    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;
+  Canvas.Rectangle(ARect);
+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.Cosmetic := false;
+    Canvas.Pen.Mode := pmXOR;
+    Canvas.Pen.Color := clWhite;
+    Canvas.Pen.Style := psDot;
+    Canvas.Brush.Style := bsClear;
+    Canvas.Rectangle(ARect);
+  finally
+    Canvas.Pen.Mode := m;
+    Canvas.Pen.Cosmetic := c;
+  end;
+end;
+
+function TCustomOnOffSwitch.GetBorderWidth: Integer;
+begin
+  case FBorderStyle of
+    bsNone, bsThin, bsThin3D:
+      Result := 1;
+    bsThick, bsThick3D:
+      Result := 2;
+  end;
+end;
+
+function TCustomOnOffSwitch.GetCaptions(AIndex: Integer): string;
+begin
+  Result := FCaptions[AIndex];
+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.GetOrientation: TSwitchOrientation;
+begin
+  if Width > Height then Result := soHorizontal else Result := soVertical;
+end;
+
+function TCustomOnOffSwitch.IsButtonSizeStored: Boolean;
+begin
+  Result := FButtonSize <> Scale96ToFont(DEFAULT_BUTTON_SIZE);
+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
+    FDragging := true;
+    FMousePt := Point(X, Y);
+    FDraggedDistance := 0;
+    FDblClickTimer.Enabled := true;
+  end;
+end;
+
+procedure TCustomOnOffSwitch.MouseMove(Shift: TShiftState; X,Y: Integer);
+begin
+  inherited;
+  if FDragging then begin
+    case Orientation of
+      soHorizontal : FDraggedDistance := X - FMousePt.X;
+      soVertical   : FDraggedDistance := Y - FMousePt.Y;
+    end;
+    Invalidate;
+  end;
+end;
+
+function TCustomOnOffSwitch.MouseOnButton(X, Y: Integer): Boolean;
+var
+  R: TRect;
+begin
+  R := CalcButtonRect(FDraggedDistance);
+  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 then begin
+    oldChecked := FChecked;
+    d := FDraggedDistance;
+    FDraggedDistance := 0;
+    if FDragging then begin
+      FChecked := DraggingToValue(d);
+    end;
+    FDragging := false;
+    if CanChange then begin
+      if FChecked <> oldChecked then
+        DoChange
+      else
+        FTogglePending := true;
+    end;
+    Invalidate;
+  end;
+end;
+
+procedure TCustomOnOffSwitch.Paint;
+var
+  R: TRect;
+  margin: Integer;
+  newChecked: Boolean;
+begin
+  if Enabled then begin
+    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;
+  R := Rect(0, 0, Width, Height);
+  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.Color := clBtnShadow;
+        Canvas.Line(R.Right, R.Top, R.Left, R.Top);
+        Canvas.Line(R.Left, R.Top, R.Left, R.Bottom);
+        if FBorderStyle = bsThick3D then begin
+          InflateRect(R, -1, -1);
+          Canvas.Line(R.Right, R.Top, R.Left, R.Top);
+          Canvas.Line(R.Left, R.Top, R.Left, R.Bottom);
+          InflateRect(R, +1, +1);
+        end;
+        Canvas.Pen.Color := clBtnHighlight;
+        Canvas.Line(R.Left, R.Bottom, R.Right, R.Bottom);
+        Canvas.Line(R.Right, R.Bottom, R.Right, R.Top);
+        InflateRect(R, -1, -1);
+        if FBorderStyle = bsThin then
+          Canvas.FillRect(R)
+        else begin
+          Canvas.Line(R.Left, R.Bottom, R.Right, R.Bottom);
+          Canvas.Line(R.Right, R.Bottom, R.Right, R.Top);
+          InflateRect(R, -1, -1);
+          Canvas.FillRect(R);
+        end;
+      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
+    newChecked := DraggingToValue(FDraggedDistance);
+    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(FDraggedDistance);
+  DrawButton(R);
+  if Focused then begin
+    InflateRect(R, 2, 2);
+    DrawFocusRect(R);
+  end;
+end;
+
+procedure TCustomOnOffSwitch.SetBorderStyle(AValue: TSwitchBorderStyle);
+begin
+  if AValue = FBorderStyle then exit;
+  FBorderStyle := AValue;
+  Invalidate;
+end;
+
+procedure TCustomOnOffSwitch.SetButtonSize(AValue: Integer);
+begin
+  if (AValue = FButtonSize) and (AValue > 0) then
+    exit;
+  FButtonSize := AValue;
+  Invalidate;
+end;
+
+procedure TCustomOnOffSwitch.SetCaptions(AIndex: Integer; AValue: String);
+begin
+  if AValue = FCaptions[AIndex] then exit;
+  FCaptions[AIndex] := AValue;
+  Invalidate;
+end;
+
+procedure TCustomOnOffSwitch.SetChecked(AValue: Boolean);
+begin
+  if AValue = FChecked then exit;
+  FChecked := AValue;
+  DoChange;
+  Invalidate;
+end;
+
+procedure TCustomOnOffSwitch.SetColors(AIndex: Integer; AValue: TColor);
+begin
+  if AValue = FColors[AIndex] then exit;
+  FColors[AIndex] := AValue;
+  Invalidate;
+end;
+
+procedure TCustomOnOffSwitch.SetInverse(AValue: boolean);
+begin
+  if AValue = FInverse then exit;
+  FInverse := 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;
+
+end.
+