diff --git a/components/industrialstuff/Example/OnOffSwitch_Knob_Sample/demo.lpi b/components/industrialstuff/Example/OnOffSwitch_Knob_Sample/demo.lpi
new file mode 100644
index 000000000..1f00f87aa
--- /dev/null
+++ b/components/industrialstuff/Example/OnOffSwitch_Knob_Sample/demo.lpi
@@ -0,0 +1,82 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/industrialstuff/Example/OnOffSwitch_Knob_Sample/demo.lpr b/components/industrialstuff/Example/OnOffSwitch_Knob_Sample/demo.lpr
new file mode 100644
index 000000000..932c81e8a
--- /dev/null
+++ b/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.
+
diff --git a/components/industrialstuff/Example/OnOffSwitch_Knob_Sample/main.lfm b/components/industrialstuff/Example/OnOffSwitch_Knob_Sample/main.lfm
new file mode 100644
index 000000000..787f0103c
--- /dev/null
+++ b/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
diff --git a/components/industrialstuff/Example/OnOffSwitch_Knob_Sample/main.pas b/components/industrialstuff/Example/OnOffSwitch_Knob_Sample/main.pas
new file mode 100644
index 000000000..16a76c287
--- /dev/null
+++ b/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.
+
diff --git a/components/industrialstuff/industrial.lpk b/components/industrialstuff/industrial.lpk
index 7cde63fb1..040cf4d72 100644
--- a/components/industrialstuff/industrial.lpk
+++ b/components/industrialstuff/industrial.lpk
@@ -4,7 +4,7 @@
-
+
@@ -28,12 +28,15 @@
-
-
-
+- thermometer-like gauge
+- knob
+- on/off switch"/>
+
+
+
@@ -79,6 +82,14 @@
+
+
+
+
+
+
+
+
diff --git a/components/industrialstuff/industrial.pas b/components/industrialstuff/industrial.pas
index aa858d352..2620148c4 100644
--- a/components/industrialstuff/industrial.pas
+++ b/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
diff --git a/components/industrialstuff/resources/industrial_icons.txt b/components/industrialstuff/resources/industrial_icons.txt
index 5fa942396..8bd0d1095 100644
--- a/components/industrialstuff/resources/industrial_icons.txt
+++ b/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
diff --git a/components/industrialstuff/resources/ta3naloggauge.bmp b/components/industrialstuff/resources/ta3naloggauge.bmp
deleted file mode 100644
index 9c0399b4a..000000000
Binary files a/components/industrialstuff/resources/ta3naloggauge.bmp and /dev/null differ
diff --git a/components/industrialstuff/resources/ta3naloggauge.png b/components/industrialstuff/resources/ta3naloggauge.png
new file mode 100644
index 000000000..c403d9e9a
Binary files /dev/null and b/components/industrialstuff/resources/ta3naloggauge.png differ
diff --git a/components/industrialstuff/resources/ta3naloggauge_150.png b/components/industrialstuff/resources/ta3naloggauge_150.png
new file mode 100644
index 000000000..3b70f4f63
Binary files /dev/null and b/components/industrialstuff/resources/ta3naloggauge_150.png differ
diff --git a/components/industrialstuff/resources/ta3naloggauge_200.png b/components/industrialstuff/resources/ta3naloggauge_200.png
new file mode 100644
index 000000000..eece0f70b
Binary files /dev/null and b/components/industrialstuff/resources/ta3naloggauge_200.png differ
diff --git a/components/industrialstuff/resources/tmknob.png b/components/industrialstuff/resources/tmknob.png
new file mode 100644
index 000000000..f954fba9e
Binary files /dev/null and b/components/industrialstuff/resources/tmknob.png differ
diff --git a/components/industrialstuff/resources/tmknob_150.png b/components/industrialstuff/resources/tmknob_150.png
new file mode 100644
index 000000000..ae8361b73
Binary files /dev/null and b/components/industrialstuff/resources/tmknob_150.png differ
diff --git a/components/industrialstuff/resources/tmknob_200.png b/components/industrialstuff/resources/tmknob_200.png
new file mode 100644
index 000000000..c9f4dc6d9
Binary files /dev/null and b/components/industrialstuff/resources/tmknob_200.png differ
diff --git a/components/industrialstuff/resources/tonoffswitch.png b/components/industrialstuff/resources/tonoffswitch.png
new file mode 100644
index 000000000..0b6b809d6
Binary files /dev/null and b/components/industrialstuff/resources/tonoffswitch.png differ
diff --git a/components/industrialstuff/resources/tonoffswitch_150.png b/components/industrialstuff/resources/tonoffswitch_150.png
new file mode 100644
index 000000000..2363c2ea2
Binary files /dev/null and b/components/industrialstuff/resources/tonoffswitch_150.png differ
diff --git a/components/industrialstuff/resources/tonoffswitch_200.png b/components/industrialstuff/resources/tonoffswitch_200.png
new file mode 100644
index 000000000..3cd24bd7d
Binary files /dev/null and b/components/industrialstuff/resources/tonoffswitch_200.png differ
diff --git a/components/industrialstuff/source/AllIndustrialRegister.pas b/components/industrialstuff/source/AllIndustrialRegister.pas
index cbd55067c..57c6fd2f9 100644
--- a/components/industrialstuff/source/AllIndustrialRegister.pas
+++ b/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;
diff --git a/components/industrialstuff/source/a3naloggauge.pas b/components/industrialstuff/source/a3naloggauge.pas
index 03cddd172..76153ad58 100644
--- a/components/industrialstuff/source/a3naloggauge.pas
+++ b/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;
diff --git a/components/industrialstuff/source/industrial_icons.res b/components/industrialstuff/source/industrial_icons.res
index cfcf3b06f..dac10c4ce 100644
Binary files a/components/industrialstuff/source/industrial_icons.res and b/components/industrialstuff/source/industrial_icons.res differ
diff --git a/components/industrialstuff/source/mknob.pas b/components/industrialstuff/source/mknob.pas
new file mode 100644
index 000000000..9784c1884
--- /dev/null
+++ b/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.
diff --git a/components/industrialstuff/source/switches.pas b/components/industrialstuff/source/switches.pas
new file mode 100644
index 000000000..e64dbef83
--- /dev/null
+++ b/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.
+