Better position calculation in BCLeaRingSlider and BCLeaSelector; Small improvements in Create methods of all the components

bcleaboard.pas

@@ -89,7 +89,7 @@ type
     property OnContextPopup;
     property FrameColor: TColor read FFrameColor write SetFrameColor default clBtnFace;
     property BoardColor: TColor read FBoardColor write SetBoardColor default clBtnFace;
-    property BackgroundColor: TColor read FBkgColor write SetBkgColor default clWhite;
+    property BackgroundColor: TColor read FBkgColor write SetBkgColor default clBtnFace;
     property FrameStyle: TZStyle read FFrameStyle write SetFrameStyle default zsRaised;
     property BoardStyle: TZStyle read FBoardStyle write SetBoardStyle default zsFlat;
     property Theme: TBCLeaTheme read FTheme write SetTheme;
@@ -114,8 +114,8 @@ begin
   with GetControlClassDefaultSize do
     SetInitialBounds(0, 0, 200, 150);
   ControlStyle := [csAcceptsControls, csReplicatable, csClickEvents];
-  FBitmap := TBGRABitmap.Create(Width, Height, FBkgColor);
   ApplyDefaultTheme;
+  FBitmap := TBGRABitmap.Create(Width, Height, FBkgColor);
 end;
 
 destructor TBCLeaBoard.Destroy;

bcleaqled.pas

@@ -142,9 +142,9 @@ begin
   with GetControlClassDefaultSize do
     SetInitialBounds(0, 0, 50, 50);
   FValue := False;
+  ApplyDefaultTheme;
   FBitmap := TBGRABitmap.Create(Width, Height, FBkgColor);
   FClickable := False;
-  ApplyDefaultTheme;
 end;
 
 destructor TBCLeaQLED.Destroy;

bclearingslider.pas

@@ -37,6 +37,8 @@ type
     FLineWidth: integer;
     FVerticalPos: single;
     FDeltaPos: single;
+    FDirection: integer;
+    FPrevCurrPosition: single;
     FSettingVerticalPos: boolean;
     FSensitivity: integer;
     FMinAngle: integer;
@@ -308,6 +310,7 @@ var
   EffectiveLineWidth: single;
   r: single;
   RMinAngle, RMaxAngle: single;
+  RValue: single;
   Blur: TBGRABitmap;
   Mask, Mask2: TBGRABitmap;
   Phong: TPhongShading;
@@ -365,24 +368,25 @@ begin
   FBitmap.Canvas2D.lineWidth := EffectiveLineWidth;
 
   RMinAngle := (180 + FMinAngle) * pi / 180;
-  RMaxAngle := ((180 + FMaxAngle) * pi / 180) - RMinAngle;
+  RMaxAngle := ((180 + FMaxAngle) * pi / 180);
+  RValue := ((180 + FMinAngle + ((FMaxAngle - FMinAngle) / FMaxValue * FValue)) * pi / 180);
 
   FBitmap.Canvas2D.lineCapLCL := pecRound;
   // background line
   if FLineBkgColor <> clNone then
-    DoDrawArc(RMinAngle, (RMaxAngle + RMinAngle), FLineBkgColor);
+    DoDrawArc(RMinAngle, RMaxAngle, FLineBkgColor);
 
   if Enabled then
   begin
     if FValue > FMinValue then
     begin
-      DoDrawArc(RMinAngle, (RMaxAngle / (FMaxValue + FOffset)) * ((FValue + FOffset) - ((FMaxValue + FOffset) / 2)), FLineColor);
+      DoDrawArc(RMinAngle, RValue, FLineColor);
       if FDrawPointer then
-        DoDrawPointer((RMaxAngle / (FMaxValue + FOffset)) * ((FValue + FOffset) - ((FMaxValue + FOffset) / 2)), FPointerColor);
+        DoDrawPointer(RValue, FPointerColor);
     end;
   end
   else
-    DoDrawArc(RMinAngle, (RMaxAngle / (FMaxValue + FOffset)) * ((FValue + FOffset) - ((FMaxValue + FOffset) / 2)), clGray);
+    DoDrawArc(RMinAngle, RMaxAngle, clGray);
 
   if FDrawText and FDrawTextPhong then
   begin
@@ -455,6 +459,7 @@ begin
 
   with GetControlClassDefaultSize do
     SetInitialBounds(0, 0, 100, 100);
+  TabStop := True;
   FMaxValue := 100;
   FMinValue := 0;
   FOffset := 0;
@@ -462,13 +467,14 @@ begin
   FMaxAngle := 340;
   FValue := 0;
   FDeltaPos := 0;
+  FDirection := 0;
   FSensitivity := 10;
   Font.Color := clBlack;
   Font.Height := 20;
   FDrawText := True;
   FDrawPointer := False;
-  FBitmap := TBGRABitmap.Create(Width, Height, FBkgColor);
   ApplyDefaultTheme;
+  FBitmap := TBGRABitmap.Create(Width, Height, FBkgColor);
 end;
 
 destructor TBCLeaRingSlider.Destroy;
@@ -483,6 +489,9 @@ begin
   if Button = mbLeft then
   begin
     FDeltaPos := ((ClientHeight / FSensitivity) - (Y / FSensitivity)) * (FMaxValue / ClientHeight);
+    FDirection := 0;
+    FPrevCurrPosition := 0;
+    FVerticalPos := FValue;
     FSettingVerticalPos := True;
   end;
 end;
@@ -505,10 +514,24 @@ procedure TBCLeaRingSlider.UpdateVerticalPos(X, Y: integer);
 var
   FPreviousPos: single;
   FCurrPos: single;
+  FNewDirection: integer;
 begin
+  {The whole code here is for beter control of the slider with the mouse movements}
   FPreviousPos := FVerticalPos;
   FCurrPos := ((ClientHeight / FSensitivity) - (Y / FSensitivity)) * (FMaxValue / ClientHeight);
 
+  if FPrevCurrPosition <> 0 then
+  begin
+    if FCurrPos < FPrevCurrPosition then FNewDirection := -1;
+    if FCurrPos > FPrevCurrPosition then FNewDirection := 1;
+    if FNewDirection <> FDirection then
+    begin
+      FDirection := FNewDirection;
+      FDeltaPos := ((ClientHeight / FSensitivity) - (Y / FSensitivity)) * (FMaxValue / ClientHeight);
+    end;
+  end;
+  FPrevCurrPosition := FCurrPos;
+
   FVerticalPos := FVerticalPos - FDeltaPos + FCurrPos;
   if FVerticalPos < FMinValue then FVerticalPos := FMinValue;
   if FVerticalPos > FMaxValue then FVerticalPos := FMaxValue;

bcleaselector.pas

@@ -29,7 +29,6 @@ type
     FTheme: TBCLeaTheme;
     FOnChangeValue: TNotifyEvent;
     FTicksCount: integer;
-    FOffset: integer;
     FValue: integer;
     FLineColor: TColor;
     FLineBkgColor: TColor;
@@ -398,12 +397,12 @@ begin
   begin
     for i := 0 to FTicksCount - 1 do
     begin
-      RAngle := (RMaxTicksAngle / (FTicksCount - 1 + FOffset)) * ((i + FOffset) - ((FTicksCount - 1 + FOffset) / 2));
+      RAngle := (RMaxTicksAngle / (FTicksCount - 1)) * (i - ((FTicksCount - 1) / 2));
       DoDrawTicks(RAngle - FPointerSize / 200, RAngle + FPointerSize / 200, clBlack);
     end;
   end;
 
-  RAngle := (RMaxTicksAngle / (FTicksCount - 1 + FOffset)) * ((FValue + FOffset) - ((FTicksCount - 1 + FOffset) / 2));
+  RAngle := (RMaxTicksAngle / (FTicksCount - 1)) * (FValue - ((FTicksCount - 1) / 2));
   if Enabled then
   begin
     if FValue >= 0 then
@@ -491,8 +490,8 @@ begin
 
   with GetControlClassDefaultSize do
     SetInitialBounds(0, 0, 100, 100);
+  TabStop:=True;
   FTicksCount := 3;
-  FOffset := 0;
   FMinAngle := 20;
   FMaxAngle := 340;
   FMinTicksAngle := 150;
@@ -502,6 +501,7 @@ begin
   FSensitivity := 10;
   FDrawText := True;
   FDrawTicks := False;
+  ApplyDefaultTheme;
   FBitmap := TBGRABitmap.Create(Width, Height, FBkgColor);
   FItems := TStringList.Create;
   FItems.Add('Item 1');
@@ -510,7 +510,6 @@ begin
   TStringList(FItems).OnChange := @ItemsChanged;
   Font.Color := clBlack;
   Font.Height := 20;
-  ApplyDefaultTheme;
 end;
 
 destructor TBCLeaSelector.Destroy;
@@ -528,6 +527,7 @@ begin
   begin
     FDeltaPos := ((ClientHeight / FSensitivity) - (Y / FSensitivity)) * ((FTicksCount - 1) / ClientHeight);
     FSettingVerticalPos := True;
+    FVerticalPos := FValue;
   end;
 end;
 

test/test_bclea/untThemeBuilder.lfm

@@ -1858,6 +1858,7 @@ object frmMain: TfrmMain
       AnchorSideLeft.Side = asrCenter
       AnchorSideTop.Side = asrCenter
       AnchorSideRight.Side = asrCenter
+      Cursor = crHandPoint
       Left = 0
       Height = 101
       Top = 50
@@ -1892,6 +1893,7 @@ object frmMain: TfrmMain
       AnchorSideLeft.Side = asrBottom
       AnchorSideTop.Control = LCDDisplay
       AnchorSideTop.Side = asrCenter
+      Cursor = crHandPoint
       Left = 600
       Height = 50
       Top = 75
@@ -1907,6 +1909,7 @@ object frmMain: TfrmMain
       AnchorSideLeft.Side = asrBottom
       AnchorSideTop.Control = LCDDisplay
       AnchorSideTop.Side = asrCenter
+      Cursor = crHandPoint
       Left = 700
       Height = 100
       Top = 50
@@ -1917,6 +1920,7 @@ object frmMain: TfrmMain
       TabOrder = 3
       TabStop = False
       OnClick = BSelectorClick
+      Value = 1
       DrawTicks = True
       Items.Strings = (
         'Item 1'
@@ -1933,6 +1937,7 @@ object frmMain: TfrmMain
       AnchorSideLeft.Side = asrBottom
       AnchorSideTop.Control = LCDDisplay
       AnchorSideTop.Side = asrCenter
+      Cursor = crHandPoint
       Left = 800
       Height = 100
       Top = 50
@@ -1980,6 +1985,7 @@ object frmMain: TfrmMain
       AnchorSideLeft.Side = asrBottom
       AnchorSideTop.Control = LCDDisplay
       AnchorSideTop.Side = asrCenter
+      Cursor = crHandPoint
       Left = 650
       Height = 50
       Top = 75
@@ -1995,6 +2001,7 @@ object frmMain: TfrmMain
       AnchorSideLeft.Side = asrBottom
       AnchorSideTop.Control = LCDDisplay
       AnchorSideTop.Side = asrCenter
+      Cursor = crHandPoint
       Left = 900
       Height = 150
       Top = 25
@@ -2002,7 +2009,6 @@ object frmMain: TfrmMain
       TabOrder = 6
       TabStop = False
       OnClick = BCLeaBoardClick
-      BackgroundColor = clBtnFace
       Theme = BTheme
     end
   end