Industrial: Add rounded shape of the OnOffSwitch (BorderStyle = bsNoneRounded, bsThinRounded, bsThickRounded). Allow to show/hide the focus rect.

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

components/industrialstuff/source/switches.pas

@@ -18,10 +18,14 @@ unit switches;
 interface
 
 uses
-  LCLIntf, LCLType, Graphics, Classes, SysUtils, Types, Controls, ExtCtrls;
+  LCLIntf, LCLType, LMessages,
+  Graphics, Classes, SysUtils, Types, Controls, ExtCtrls;
 
 type
-  TSwitchBorderStyle = (bsNone, bsThin, bsThick, bsThin3D, bsThick3D);
+  TSwitchBorderStyle = (
+    bsNone, bsThin, bsThick, bsThin3D, bsThick3D,
+    bsNoneRounded, bsThinRounded, bsThickRounded
+  );
   TSwitchOrientation = (soHorizontal, soVertical);
 
   TCustomOnOffSwitch = class(TCustomControl)
@@ -43,6 +47,7 @@ type
     FReadOnly: Boolean;
     FShowButtonBorder: Boolean;
     FShowCaption: Boolean;
+    FShowFocusRect: Boolean;
     FOnChange: TNotifyEvent;
     FDblClickTimer: TTimer;
     function GetBorderWidth: Integer;
@@ -57,6 +62,8 @@ type
     procedure SetInverse(AValue: Boolean);
     procedure SetShowButtonBorder(AValue: Boolean);
     procedure SetShowCaption(AValue: Boolean);
+    procedure SetShowFocusRect(AValue: Boolean);
+    procedure WM_EraseBkGnd(var Msg: TMsg); message LM_EraseBkGnd;
   protected
     function CalcButtonRect(ADelta: Integer): TRect;
     function CalcMargin: Integer;
@@ -91,6 +98,7 @@ type
     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 ShowFocusRect: Boolean read FShowFocusRect write SetShowFocusRect default true;
     property ShowCaption: Boolean read FShowCaption write SetShowCaption default true;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
   public
@@ -114,7 +122,7 @@ type
     property ReadOnly;
     property ShowButtonBorder;
     property ShowCaption;
-    property OnChange;
+    property ShowFocusRect;
 
     // inherited
     property Action;
@@ -130,6 +138,10 @@ type
     property TabStop default true;
     property Visible;
 
+    // new
+    property OnChange;
+
+    // inherited
     property OnChangeBounds;
     property OnClick;
     property OnEnter;
@@ -159,7 +171,7 @@ begin
   g := GetGValue(AColor);
   b := GetBValue(AColor);
   if r + g + b < 3*128 then
-    // Dark color --> make it brigher
+    // Dark color --> make it brighter
     ADelta := abs(ADelta)
   else
     // Bright color --> make it darker
@@ -187,6 +199,7 @@ begin
   FCaptions[1] := 'ON';
   FShowCaption := true;
   FShowButtonBorder := true;
+  FShowFocusRect := true;
   FDblClickTimer := TTimer.Create(self);
   FDblClickTimer.Interval := 500;
   FDblClickTimer.Enabled := false;
@@ -326,7 +339,13 @@ begin
     Canvas.Pen.Color := Canvas.Brush.Color;
   Canvas.Pen.Width := 1;
   Canvas.Pen.Style := psSolid;
-  Canvas.Rectangle(ARect);
+  if FBorderStyle in [bsNoneRounded, bsThinRounded, bsThickRounded] then
+  begin
+    dec(ARect.Bottom);
+    dec(ARect.Right);
+    Canvas.Ellipse(ARect);
+  end else
+    Canvas.Rectangle(ARect);
 end;
 
 procedure TCustomOnOffSwitch.DrawCaption(ARect: TRect; AChecked: Boolean);
@@ -355,12 +374,19 @@ begin
   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);
+    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;
@@ -370,9 +396,9 @@ end;
 function TCustomOnOffSwitch.GetBorderWidth: Integer;
 begin
   case FBorderStyle of
-    bsNone, bsThin, bsThin3D:
+    bsNone, bsThin, bsThin3D, bsNoneRounded, bsThinRounded:
       Result := 1;
-    bsThick, bsThick3D:
+    bsThick, bsThick3D, bsThickRounded:
       Result := 2;
   end;
 end;
@@ -465,6 +491,7 @@ procedure TCustomOnOffSwitch.Paint;
 var
   R: TRect;
   margin: Integer;
+  diam: Integer;
   newChecked: Boolean;
 begin
   if Enabled then begin
@@ -512,6 +539,18 @@ begin
           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;
 
@@ -558,7 +597,7 @@ begin
 
   R := CalcButtonRect(FDraggedDistance);
   DrawButton(R);
-  if Focused then begin
+  if Focused and FShowFocusRect then begin
     InflateRect(R, 2, 2);
     DrawFocusRect(R);
   end;
@@ -624,5 +663,18 @@ begin
   Invalidate;
 end;
 
+procedure TCustomOnOffSwitch.SetShowFocusRect(AValue: Boolean);
+begin
+  if AValue = FShowFocusRect then exit;
+  FShowFocusRect := AValue;
+  DoChange;
+  Invalidate;
+end;
+
+procedure TCustomOnOffSwitch.WM_EraseBkGnd(var Msg: TMsg);
+begin
+  Msg.message := 1;
+end;
+
 end.