Merge pull request #230 from bgrabitmap/dev-bgracontrols

Dev bgracontrols v9.0.1.7

.github/workflows/make.pas

@@ -186,7 +186,7 @@ uses
       List := FindAllFiles(Target, '*.lpi');
       List.Sort;
       for Result in List do
-        if not Result.Contains('backup') then
+        if not Result.Contains('backup') and not Result.Contains('/use/') then
           BuildProject(Result);
     finally
       List.Free;
@@ -198,7 +198,7 @@ uses
 
 begin
   try
-    BuildAll('.', ['BGRABitmap']);
+    BuildAll('.', ['UEControls']);
     case ExitCode of
       0: OutLog(etInfo, 'Errors:'#9 + ExitCode.ToString);
       else

.gitignore

@@ -5,6 +5,7 @@
 backup/*
 backup
 lib
+bin
 debug
 *.res
 *.lrt
@@ -19,3 +20,4 @@ test/test_bccombobox/test_bccombobox
 !images/bgracontrols_images.res
 
 .DS_Store
+use/*/

.gitmodules

@@ -0,0 +1,3 @@
+[submodule "use/bgrabitmap"]
+	path = use/bgrabitmap
+	url = https://github.com/bgrabitmap/bgrabitmap.git

README.md

@@ -64,6 +64,12 @@ A label control that can be styled through properties, it supports shadow, custo
 
 Author: Dibo.
 
+### TBCRoundedImage
+
+A Image Viewer which can show a resized image (even proportionally) or not and with different alignments, it can read both from a TPicture and from a TBGRABitmap.
+
+Author: Lainz, Massimo Magnano.
+
 ### TBCMaterialDesignButton
 
 A button control that has an animation effect according to Google Material Design guidelines. It supports custom color for background and for the circle animation, also you can customize the shadow.
@@ -114,9 +120,9 @@ Author: Circular.
 
 ### TBGRAFlashProgressBar
 
-A progress bar with a default style inspired in the old Flash Player Setup for Windows progress dialog. You can change the color property to have different styles and also you can use the event OnRedraw to paint custom styles on it like text or override the entire default drawing.
+A progress bar inspired in the old Flash Player Setup for Windows progress dialog. You can change Colors and Style to Normal, MultiProgress (SubTotal and Total), Marquee (with or without Bounce effect), Timer (Countdown), Graph (as the details of Copy File). Also you can use the event OnRedraw to paint custom styles on it like text or override the entire default drawing.
 
-Author: Circular.
+Author: Circular, Massimo Magnano.
 
 ### TBGRAGraphicControl
 
@@ -128,19 +134,19 @@ Author: Circular.
 
 An image list that supports alpha in all supported platforms.
 
-Author: Dibo.
+Author: Dibo, Massimo Magnano.
 
 ### TBGRAImageManipulation
 
 A tool to manipulate pictures, see the demo that shows all the capability that comes with it.
 
-Author: Emerson Cavalcanti, maxm74 .
+Author: Emerson Cavalcanti, Massimo Magnano .
 
 ### TBGRAKnob
-
+![Knob](https://raw.githubusercontent.com/bgrabitmap/bgracontrols/dev-bgracontrols/docs/img/BGRA-Knob-V2.png)
 A knob that can be styled through properties.
 
-Author: Circular.
+Author: Circular, Sandy Ganz
 
 ### TBGRAResizeSpeedButton
 
@@ -214,6 +220,12 @@ Another gauge.
 
 Author: Digeo.
 
+### TSuperGauge
+![SuperGauge](https://raw.githubusercontent.com/bgrabitmap/bgracontrols/dev-bgracontrols/docs/img/SuperGauge-V100.png)
+Updated and Enhanced Analog Gauge. Many new features, faster drawing, additonal events
+
+Author: Sandy Ganz
+
 ### TPSImport_BGRAPascalScript
 
 A component to load BGRABitmap pascal script utilities.
@@ -262,6 +274,13 @@ An imitation of a potentiometer.
 
 Author: Boban Spasic.
 
+### TBCExpandPanel
+
+A Panel that collapses when clicked on the button.
+
+Author: Massimo Magnano, Alexander Roth.
+
+
 # BGRA Custom Drawn
 BGRA Custom Drawn is a set of controls inherited from Custom Drawn. These come with a default dark style that is like Photoshop.
 

atshapelinebgra.pas

@@ -13,6 +13,10 @@ For BGRAControls by: Lainz
 
 - Using BGRABitmap antialiased drawing (2020-09-09)
 
+2025 - Massimo Magnano
+         Fixed gtk draw outside area (Use Width/Height instead of Canvas.Width/Height)
+         Added Color Property; Comments in English
+
 Lazarus: 1.6+}
 
 unit atshapelinebgra;
@@ -39,6 +43,7 @@ type
     FLineWidth: integer;
     FLineColor: TColor;
     FArrowColor: TColor;
+    FLineStyle: TPenStyle;
 
     procedure SetArrowColor(AValue: TColor);
     procedure SetLineColor(AValue: TColor);
@@ -47,6 +52,7 @@ type
     procedure SetArrow2(Value: Boolean);
     procedure SetArrowFactor(Value: integer);
     procedure SetLineWidth(AValue: Integer);
+    procedure SetLineStyle(aLineStyle: TPenStyle);
   protected
     { Protected declarations }
     procedure Paint; override;
@@ -56,6 +62,7 @@ type
     destructor Destroy; override;
   published
     { Published declarations }
+    property Color;
     property DragCursor;
     property DragKind;
     property DragMode;
@@ -71,9 +78,11 @@ type
     property LineColor: TColor read FLineColor write SetLineColor;
     property ArrowColor: TColor read FArrowColor write SetArrowColor;
     property LineWidth: Integer read FLineWidth write SetLineWidth;
+    property LineStyle: TPenStyle read FLineStyle write SetLineStyle default psSolid;
     property Arrow1: Boolean read FArrow1 write SetArrow1 default False;
     property Arrow2: Boolean read FArrow2 write SetArrow2 default False;
     property ArrowFactor: Integer read FArrowFactor write SetArrowFactor default 8;
+
     property OnDragDrop;
     property OnDragOver;
     property OnEndDrag;
@@ -110,6 +119,7 @@ begin
   FArrowColor:=clBlack;
   FLineColor:=clBlack;
   FLineWidth:=1;
+  FLineStyle:=psSolid;
   FLineDir:=drLeftRight;
 end;
 
@@ -151,6 +161,15 @@ begin
   end;
 end;
 
+procedure TShapeLineBGRA.SetLineStyle(aLineStyle: TPenStyle);
+begin
+  if aLineStyle <> FLineStyle then
+  begin
+    FLineStyle := aLineStyle;
+    Invalidate;
+  end;
+end;
+
 procedure TShapeLineBGRA.SetLineColor(AValue: TColor);
 begin
   if AValue <> FLineColor then
@@ -188,22 +207,27 @@ var
 begin
   inherited;
 
-  bgra := TBGRABitmap.Create(Canvas.Width, Canvas.Height, BGRAPixelTransparent);
+  try
+  if (Color=Parent.Color) or (Color=clNone)
+  then bgra := TBGRABitmap.Create(Width, Height, BGRAPixelTransparent)
+  else bgra := TBGRABitmap.Create(Width, Height, ColorToBGRA(Color));
+
   bgra.CanvasBGRA.Pen.Color:= FLineColor;
   bgra.CanvasBGRA.Brush.Color:=FArrowColor;
   bgra.CanvasBGRA.Pen.Width:=FLineWidth;
+  bgra.CanvasBGRA.Pen.Style:=FLineStyle;
 
   case FLineDir of
     drLeftRight:
       begin
-        start := (Height - FLineWidth) div 2;
+        start := (Height -1) div 2;
         bgra.CanvasBGRA.Pen.Width:= FLineWidth;
         bgra.CanvasBGRA.MoveTo(IfThen(FArrow1, FArrowFactor), start);
         bgra.CanvasBGRA.LineTo(Width-IfThen(FArrow2, FArrowFactor), Start);
         bgra.CanvasBGRA.Pen.Width:= 1;
 
         if FArrow1 then begin
-          //Flecha hacia izquierda
+          //Left Arrow
           p1:=Point(0,start);
           p2:=Point(FArrowFactor,Start-FArrowFactor);
           p3:=Point(FArrowFactor,Start+FArrowFactor);
@@ -211,7 +235,7 @@ begin
         end;
 
         if FArrow2 then begin
-          //Flecha hacia derecha
+          //Right Arrow
           p1:=Point(Width-1, Start);
           p2:=Point(Width-(FArrowFactor+1),Start-FArrowFactor);
           p3:=Point(Width-(FArrowFactor+1),Start+FArrowFactor);
@@ -221,14 +245,14 @@ begin
 
     drUpDown:
       begin
-        start := (Width - FLineWidth) div 2;
+        start := (Width -1) div 2;
         bgra.CanvasBGRA.Pen.Width:= FLineWidth;
         bgra.CanvasBGRA.MoveTo(start, IfThen(FArrow1, FArrowFactor));
         bgra.CanvasBGRA.LineTo(start, Height-IfThen(FArrow2, FArrowFactor));
         bgra.CanvasBGRA.Pen.Width:= 1;
 
         if FArrow1 then begin
-          //Flecha hacia arriba
+          //Up Arrow
           p1:=Point(start,0);
           p2:=Point(Start-FArrowFactor,FArrowFactor);
           p3:=Point(Start+FArrowFactor,FArrowFactor);
@@ -236,7 +260,7 @@ begin
         end;
 
         if FArrow2 then begin
-          //Flecha hacia abajo
+          //Down Arrow
           p1:=Point(start,Height-1);
           p2:=Point(Start-FArrowFactor,Height-(FArrowFactor+1));
           p3:=Point(Start+FArrowFactor,Height-(FArrowFactor+1));
@@ -259,7 +283,7 @@ begin
         bgra.CanvasBGRA.Pen.Width:= 1;
 
         if FArrow1 and(Width>0)then begin
-          //Flecha hacia arriba
+          //Up Arrow
           H0:=Round((FArrowFactor+1)*Sin(Alfa));
           W0:=Round((FArrowFactor+1)*Cos(Alfa));
 
@@ -285,7 +309,7 @@ begin
 
 
         if FArrow2 and(Width>0)then begin
-          //Flecha hacia abajo
+          //Down Arrow
           H0:=Round((FArrowFactor+1)*Sin(Alfa));
           W0:=Round((FArrowFactor+1)*Cos(Alfa));
 
@@ -393,7 +417,10 @@ begin
   end;
 
   bgra.Draw(Canvas, 0, 0, False);
-  bgra.Free;
+
+  finally
+    bgra.Free;
+  end;
 end;
 
 end.

bcbutton.pas

@@ -2058,7 +2058,7 @@ begin
   FBGRANormal.Free;
   FBGRAHover.Free;
   FBGRAClick.Free;
-  {$IFDEF FPC}FreeThenNil(FGlyph);{$ELSE}FreeAndNil(FGlyph);{$ENDIF}
+  FreeAndNil(FGlyph);
   FRounding.Free;
   FRoundingDropDown.Free;
   inherited Destroy;

bcbuttonfocus.pas

@@ -1857,7 +1857,7 @@ begin
   FBGRANormal.Free;
   FBGRAHover.Free;
   FBGRAClick.Free;
-  {$IFDEF FPC}FreeThenNil{$ELSE}FreeAndNil{$ENDIF}(FGlyph);
+  FreeAndNil(FGlyph);
   FRounding.Free;
   FRoundingDropDown.Free;
   inherited Destroy;

bccombobox.pas

@@ -47,6 +47,8 @@ type
     function GetComboCanvas: TCanvas;
     function GetArrowSize: integer;
     function GetArrowWidth: integer;
+    function GetButtonHint: TTranslateString;
+    function GetButtonShowHint: Boolean;
     function GetGlobalOpacity: byte;
     function GetItemText: string;
     function GetDropDownColor: TColor;
@@ -59,8 +61,7 @@ type
     function GetStateHover: TBCButtonState;
     function GetStateNormal: TBCButtonState;
     function GetStaticButton: boolean;
-    procedure ListBoxKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState
-      );
+    procedure ListBoxKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
     procedure ListBoxMouseUp({%H-}Sender: TObject; {%H-}Button: TMouseButton;
                           {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
     procedure ListBoxMouseLeave(Sender: TObject);
@@ -75,6 +76,8 @@ type
     procedure SetArrowFlip(AValue: boolean);
     procedure SetArrowSize(AValue: integer);
     procedure SetArrowWidth(AValue: integer);
+    procedure SetButtonHint(const AValue: TTranslateString);
+    procedure SetButtonShowHint(AValue: Boolean);
     procedure SetCanvasScaleMode(AValue: TBCCanvasScaleMode);
     procedure SetDropDownColor(AValue: TColor);
     procedure SetGlobalOpacity(AValue: byte);
@@ -87,6 +90,24 @@ type
     procedure SetStateHover(AValue: TBCButtonState);
     procedure SetStateNormal(AValue: TBCButtonState);
     procedure SetStaticButton(AValue: boolean);
+
+    function GetOnButtonMouseDown: TMouseEvent;
+    function GetOnButtonMouseEnter: TNotifyEvent;
+    function GetOnButtonMouseLeave: TNotifyEvent;
+    function GetOnButtonMouseMove: TMouseMoveEvent;
+    function GetOnButtonMouseUp: TMouseEvent;
+    function GetOnButtonMouseWheel: TMouseWheelEvent;
+    function GetOnButtonMouseWheelDown: TMouseWheelUpDownEvent;
+    function GetOnButtonMouseWheelUp: TMouseWheelUpDownEvent;
+
+    procedure SetOnButtonMouseDown(AValue: TMouseEvent);
+    procedure SetOnButtonMouseEnter(AValue: TNotifyEvent);
+    procedure SetOnButtonMouseLeave(AValue: TNotifyEvent);
+    procedure SetOnButtonMouseMove(AValue: TMouseMoveEvent);
+    procedure SetOnButtonMouseUp(AValue: TMouseEvent);
+    procedure SetOnButtonMouseWheel(AValue: TMouseWheelEvent);
+    procedure SetOnButtonMouseWheelDown(AValue: TMouseWheelUpDownEvent);
+    procedure SetOnButtonMouseWheelUp(AValue: TMouseWheelUpDownEvent);
   protected
     function GetStyleExtension: String; override;
     procedure WMSetFocus(var {%H-}Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF}); message {$IFDEF FPC}LM_SETFOCUS{$ELSE}WM_SETFOCUS{$ENDIF};
@@ -109,9 +130,12 @@ type
     property ListBox: TListBox read GetListBox;
     property Text: string read GetItemText;
   published
+    property Align;
     property Anchors;
+    property BorderSpacing;
     property Canvas: TCanvas read GetComboCanvas;
     property CanvasScaleMode: TBCCanvasScaleMode read FCanvasScaleMode write SetCanvasScaleMode default csmAuto;
+    property Hint: TTranslateString read GetButtonHint write SetButtonHint;
     property Items: TStrings read GetItems write SetItems;
     property ItemIndex: integer read GetItemIndex write SetItemIndex;
     property ItemHeight: integer read FItemHeight write FItemHeight default 0;
@@ -119,7 +143,7 @@ type
     property ArrowWidth: integer read GetArrowWidth write SetArrowWidth;
     property ArrowFlip: boolean read GetArrowFlip write SetArrowFlip default false;
     property FocusBorderColor: TColor read FFocusBorderColor write FFocusBorderColor default clBlack;
-    property FocusBorderOpacity: byte read FFocusBorderOpacity write FFocusBorderOpacity default 255;
+    property FocusBorderOpacity: byte read FFocusBorderOpacity write FFocusBorderOpacity default 0;
     property DropDownBorderColor: TColor read FDropDownBorderColor write FDropDownBorderColor default clWindowText;
     property DropDownBorderSize: integer read FDropDownBorderSize write FDropDownBorderSize default 1;
     property DropDownColor: TColor read GetDropDownColor write SetDropDownColor default clWindow;
@@ -130,6 +154,7 @@ type
     property GlobalOpacity: byte read GetGlobalOpacity write SetGlobalOpacity;
     property MemoryUsage: TBCButtonMemoryUsage read GetMemoryUsage write SetMemoryUsage;
     property Rounding: TBCRounding read GetRounding write SetRounding;
+    property ShowHint: Boolean read GetButtonShowHint write SetButtonShowHint default False;
     property StateClicked: TBCButtonState read GetStateClicked write SetStateClicked;
     property StateHover: TBCButtonState read GetStateHover write SetStateHover;
     property StateNormal: TBCButtonState read GetStateNormal write SetStateNormal;
@@ -138,6 +163,14 @@ type
     property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
     property OnDrawSelectedItem: TOnAfterRenderBCButton read GetOnDrawSelectedItem write SetOnDrawSelectedItem;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property OnMouseDown: TMouseEvent read GetOnButtonMouseDown write SetOnButtonMouseDown;
+    property OnMouseMove: TMouseMoveEvent read GetOnButtonMouseMove write SetOnButtonMouseMove;
+    property OnMouseUp: TMouseEvent read GetOnButtonMouseUp write SetOnButtonMouseUp;
+    property OnMouseEnter: TNotifyEvent read GetOnButtonMouseEnter write SetOnButtonMouseEnter;
+    property OnMouseLeave: TNotifyEvent read GetOnButtonMouseLeave write SetOnButtonMouseLeave;
+    property OnMouseWheel: TMouseWheelEvent read GetOnButtonMouseWheel write SetOnButtonMouseWheel;
+    property OnMouseWheelDown: TMouseWheelUpDownEvent read GetOnButtonMouseWheelDown write SetOnButtonMouseWheelDown;
+    property OnMouseWheelUp: TMouseWheelUpDownEvent read GetOnButtonMouseWheelUp write SetOnButtonMouseWheelUp;
     property TabStop;
     property TabOrder;
   end;
@@ -238,6 +271,16 @@ begin
   result := Button.DropDownWidth;
 end;
 
+function TBCComboBox.GetButtonHint: TTranslateString;
+begin
+  result := FButton.Hint;
+end;
+
+function TBCComboBox.GetButtonShowHint: Boolean;
+begin
+  result := FButton.ShowHint;
+end;
+
 function TBCComboBox.GetGlobalOpacity: byte;
 begin
   result := Button.GlobalOpacity;
@@ -397,17 +440,22 @@ end;
 procedure TBCComboBox.OnAfterRenderButton(Sender: TObject;
   const ABGRA: TBGRABitmap; AState: TBCButtonState; ARect: TRect);
 var
-  focusMargin: integer;
+  FocusMargin: integer;
 begin
   if Assigned(FOnDrawSelectedItem) then
     FOnDrawSelectedItem(self, ABGRA, AState, ARect);
   if Focused then
   begin
-    focusMargin := round(2 * Button.CanvasScale);
-    ABGRA.RectangleAntialias(ARect.Left + focusMargin, ARect.Top + focusMargin,
-      ARect.Right - focusMargin - 1, ARect.Bottom - focusMargin - 1,
-      ColorToBGRA(FocusBorderColor, FocusBorderOpacity),
-      Button.CanvasScale);
+    FocusMargin := round(2 * FButton.CanvasScale);
+    ABGRA.RoundRectAntialias(
+      ARect.Left + FocusMargin,
+      ARect.Top + FocusMargin,
+      ARect.Right - FocusMargin - 1,
+      ARect.Bottom - FocusMargin - 1,
+      Max(0, FButton.Rounding.RoundX - FocusMargin),
+      Max(0, FButton.Rounding.RoundY - FocusMargin),
+      ColorToBGRA(FFocusBorderColor, FFocusBorderOpacity),
+      FButton.CanvasScale);
   end;
 end;
 
@@ -446,6 +494,16 @@ begin
   Button.DropDownWidth:= AValue;
 end;
 
+procedure TBCComboBox.SetButtonHint(const AValue: TTranslateString);
+begin
+  FButton.Hint := AValue;
+end;
+
+procedure TBCComboBox.SetButtonShowHint(AValue: Boolean);
+begin
+  FButton.ShowHint := AValue;
+end;
+
 procedure TBCComboBox.SetCanvasScaleMode(AValue: TBCCanvasScaleMode);
 begin
   if FCanvasScaleMode=AValue then Exit;
@@ -524,6 +582,86 @@ begin
   Button.StaticButton:= AValue;
 end;
 
+function TBCComboBox.GetOnButtonMouseDown: TMouseEvent;
+begin
+  result := FButton.OnMouseDown;
+end;
+
+function TBCComboBox.GetOnButtonMouseEnter: TNotifyEvent;
+begin
+  result := FButton.OnMouseEnter;
+end;
+
+function TBCComboBox.GetOnButtonMouseLeave: TNotifyEvent;
+begin
+  result := FButton.OnMouseLeave;
+end;
+
+function TBCComboBox.GetOnButtonMouseMove: TMouseMoveEvent;
+begin
+  result := FButton.OnMouseMove;
+end;
+
+function TBCComboBox.GetOnButtonMouseUp: TMouseEvent;
+begin
+  result := FButton.OnMouseUp;
+end;
+
+function TBCComboBox.GetOnButtonMouseWheel: TMouseWheelEvent;
+begin
+  result := FButton.OnMouseWheel;
+end;
+
+function TBCComboBox.GetOnButtonMouseWheelDown: TMouseWheelUpDownEvent;
+begin
+  result := FButton.OnMouseWheelDown;
+end;
+
+function TBCComboBox.GetOnButtonMouseWheelUp: TMouseWheelUpDownEvent;
+begin
+  result := FButton.OnMouseWheelUp;
+end;
+
+procedure TBCComboBox.SetOnButtonMouseDown(AValue: TMouseEvent);
+begin
+  FButton.OnMouseDown := AValue;
+end;
+
+procedure TBCComboBox.SetOnButtonMouseEnter(AValue: TNotifyEvent);
+begin
+  FButton.OnMouseEnter := AValue;
+end;
+
+procedure TBCComboBox.SetOnButtonMouseLeave(AValue: TNotifyEvent);
+begin
+  FButton.OnMouseLeave := AValue;
+end;
+
+procedure TBCComboBox.SetOnButtonMouseMove(AValue: TMouseMoveEvent);
+begin
+  FButton.OnMouseMove := AValue;
+end;
+
+procedure TBCComboBox.SetOnButtonMouseUp(AValue: TMouseEvent);
+begin
+  FButton.OnMouseUp := AValue;
+end;
+
+procedure TBCComboBox.SetOnButtonMouseWheel(AValue: TMouseWheelEvent);
+begin
+  FButton.OnMouseWheel := AValue;
+end;
+
+procedure TBCComboBox.SetOnButtonMouseWheelDown(AValue: TMouseWheelUpDownEvent);
+begin
+  FButton.OnMouseWheelDown := AValue;
+end;
+
+procedure TBCComboBox.SetOnButtonMouseWheelUp(AValue: TMouseWheelUpDownEvent);
+begin
+  FButton.OnMouseWheelUp := AValue;
+end;
+
 function TBCComboBox.GetStyleExtension: String;
 begin
   result := 'bccombo';
@@ -543,11 +681,9 @@ end;
 procedure TBCComboBox.UpdateFocus(AFocused: boolean);
 var
   lForm: TCustomForm;
-  oldCaption: string;
 begin
   lForm := GetParentForm(Self);
-  if lForm = nil then
-    exit;
+  if lForm = nil then Exit;
 
   {$IFDEF FPC}//#
   if AFocused then
@@ -555,11 +691,7 @@ begin
   else
     ActiveDefaultControlChanged(nil);
   {$ENDIF}
-
-  oldCaption := FButton.Caption;
-  FButton.Caption := FButton.Caption + '1';
-  FButton.Caption := oldCaption;
-
+  FButton.UpdateControl;
   Invalidate;
 end;
 
@@ -689,6 +821,8 @@ begin
   FButton.OnClick := ButtonClick;
   FButton.DropDownArrow := True;
   FButton.OnAfterRenderBCButton := OnAfterRenderButton;
+  FFocusBorderColor := clBlack;
+  FFocusBorderOpacity := 0;
   UpdateButtonCanvasScaleMode;
 
   FItems := TStringList.Create;

bcfluentprogressring.pas

@@ -178,7 +178,7 @@ begin
 
   if EffectiveSize<2 then exit;
 
-
+  Bitmap.FillTransparent;
   Bitmap.Canvas2D.resetTransform;
   Bitmap.Canvas2D.translate(Bitmap.Width/2, Bitmap.Height/2);
   Bitmap.Canvas2D.rotate(pi15);

bclealed.pas

@@ -70,6 +70,7 @@ type
     procedure SetEnabled(Value: boolean); override;
     procedure SetVisible(Value: boolean); override;
     procedure Paint; override;
+    procedure Resize; override;
     procedure Redraw;
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
@@ -115,7 +116,7 @@ type
     property ColorOn: TColor read FColorOn write SetColorOn default TColor($00FF9C15);
     property ColorOff: TColor read FColorOff write SetColorOff default TColor($009E5A00);
     property BackgroundColor: TColor read FBkgColor write SetBkgColor default clBtnFace;
-    property Size: integer read FSize write SetSize default 15;
+    property Size: integer read FSize write SetSize default 30;
     property OnChangeValue: TNotifyEvent read FOnChangeValue write FOnChangeValue;
     property Style: TZStyle read FStyle write SetStyle default zsRaised;
     property Clickable: boolean read FClickable write SetClickable default False;
@@ -139,9 +140,9 @@ begin
   with GetControlClassDefaultSize do
     SetInitialBounds(0, 0, 50, 50);
   FValue := False;
+  ApplyDefaultTheme;
   FBitmap := TBGRABitmap.Create(Width, Height, FBkgColor);
   FClickable := False;
-  ApplyDefaultTheme;
 end;
 
 destructor TBCLeaLED.Destroy;
@@ -168,6 +169,12 @@ begin
   Redraw;
 end;
 
+procedure TBCLeaLED.Resize;
+begin
+  inherited Resize;
+  {$IFDEF LCLgtk2} Invalidate; {$ENDIF}
+end;
+
 procedure TBCLeaLED.SetStyle(AValue: TZStyle);
 begin
   if FStyle = AValue then
@@ -306,7 +313,7 @@ begin
   FColorOff := TColor($009E5A00);
   FBkgColor := clBtnFace;
   FStyle := zsRaised;
-  FSize := 15;
+  FSize := 30;
   FAltitude := 2;
   FAmbientFactor := 0.3;
   FSpecularIndex := 10;
@@ -348,36 +355,39 @@ end;
 
 procedure TBCLeaLED.Redraw;
 var
-  EffectiveSize: integer;
   Blur: TBGRABitmap;
   Mask, Mask2: TBGRABitmap;
   Phong: TPhongShading;
-  ScaledPhongSize, ScaledSize: integer;
+  ScaledPhongSize, ScaledBlurSize, ScaledRadius: integer;
+  imgSize: integer;
+  img: TBGRABitmap;
+  Margin: integer;
 begin
   FBitmap.SetSize(Width, Height);
   FBitmap.Fill(FBkgColor);
 
-  if Width < Height then
-    EffectiveSize := Width
-  else
-    EffectiveSize := Height;
-  if EffectiveSize < 2 then exit;
-  ScaledSize := Scale96ToForm(FSize);
+  if (Width < 2) or (Height < 2) then exit;
+  ScaledRadius := Scale96ToForm(FSize div 2);
   ScaledPhongSize := Scale96ToForm(5);
+  ScaledBlurSize := Scale96ToForm(10);
+  Margin := ScaledBlurSize;
+
+  imgSize := 2*(ScaledRadius + Margin);
+  img := TBGRABitmap.Create(imgSize, imgSize, ColorToBGRA(ColorToRGB(FBkgColor)));
 
   if Enabled then
   begin
     if FValue then
-      FBitmap.FillEllipseAntialias((EffectiveSize - 1) / 2, (EffectiveSize - 1) / 2, ScaledSize, ScaledSize, FColorOn)
+      img.FillEllipseAntialias((imgSize-1)/2, (imgSize-1)/2, ScaledRadius, ScaledRadius, FColorOn)
     else
-      FBitmap.FillEllipseAntialias((EffectiveSize - 1) / 2, (EffectiveSize - 1) / 2, ScaledSize, ScaledSize, FColorOff);
+      img.FillEllipseAntialias((imgSize-1)/2, (imgSize-1)/2, ScaledRadius, ScaledRadius, FColorOff);
   end
   else
-    FBitmap.FillEllipseAntialias((EffectiveSize - 1) / 2, (EffectiveSize - 1) / 2, ScaledSize, ScaledSize, clGray);
+    img.FillEllipseAntialias((imgSize-1)/2, (imgSize-1)/2, ScaledRadius, ScaledRadius, clGray);
 
   if (FStyle = zsRaised) or (FStyle = zsLowered) then
   begin
-    Mask := FBitmap.FilterGrayscale as TBGRABitmap;
+    Mask := img.FilterGrayscale as TBGRABitmap;
     if (FStyle = zsRaised) then
       Mask.Negative;
     Blur := Mask.FilterBlurRadial(ScaledPhongSize, ScaledPhongSize, rbFast) as TBGRABitmap;
@@ -385,7 +395,6 @@ begin
     Mask.Free;
 
     Phong := TPhongShading.Create;
-    if assigned(FTheme) then
     begin
       Phong.AmbientFactor := FAmbientFactor;
       Phong.SpecularIndex := FSpecularIndex;
@@ -401,39 +410,38 @@ begin
       Phong.DiffuseSaturation := FDiffuseSaturation;
       Phong.LightColor := FLightColor;
     end;
-    Phong.Draw(FBitmap, Blur, FAltitude, 0, 0, FBitmap);
+    Phong.Draw(img, Blur, FAltitude, 0, 0, img);
     Phong.Free;
     Blur.Free;
 
-    Mask := TBGRABitmap.Create(EffectiveSize, EffectiveSize, BGRABlack);
-    Mask.FillEllipseAntialias((EffectiveSize - 1) / 2, (EffectiveSize - 1) / 2, ScaledSize, ScaledSize, BGRAWhite);
-    Mask2 := TBGRABitmap.Create(EffectiveSize, EffectiveSize, ColorToBGRA(ColorToRGB(FBkgColor)));
-    Mask2.PutImage(0, 0, FBitmap, dmSet);
+    Mask := TBGRABitmap.Create(imgSize, imgSize, BGRABlack);
+    Mask.FillEllipseAntialias((imgSize-1)/2, (imgSize-1)/2, ScaledRadius, ScaledRadius, BGRAWhite);
+    Mask2 := TBGRABitmap.Create(imgSize, imgSize, ColorToBGRA(ColorToRGB(FBkgColor)));
+    Mask2.PutImage(0, 0, img, dmSet);
     Mask2.ApplyMask(Mask);
     Mask.Free;
-    FBitmap.Fill(FBkgColor);
-    FBitmap.PutImage(0, 0, Mask2, dmDrawWithTransparency);
+    FBitmap.PutImage((FBitmap.Width-imgSize) div 2, (FBitmap.Height-imgSize) div 2, Mask2, dmDrawWithTransparency);
     Mask2.Free;
   end
   else
   begin
-    Mask := TBGRABitmap.Create(EffectiveSize, EffectiveSize, BGRABlack);
-    Mask.FillEllipseAntialias((EffectiveSize - 1) / 2, (EffectiveSize - 1) / 2, ScaledSize, ScaledSize, BGRAWhite);
-    Mask2 := TBGRABitmap.Create(EffectiveSize, EffectiveSize, ColorToBGRA(ColorToRGB(FBkgColor)));
-    Mask2.PutImage(0, 0, FBitmap, dmSet);
+    Mask := TBGRABitmap.Create(imgSize, imgSize, BGRABlack);
+    Mask.FillEllipseAntialias((imgSize-1)/2, (imgSize-1)/2, ScaledRadius, ScaledRadius, BGRAWhite);
+    Mask2 := TBGRABitmap.Create(imgSize, imgSize, ColorToBGRA(ColorToRGB(FBkgColor)));
+    Mask2.PutImage(0, 0, img, dmSet);
     Mask2.ApplyMask(Mask);
     Mask.Free;
-    FBitmap.Fill(FBkgColor);
-    FBitmap.PutImage(0, 0, Mask2, dmDrawWithTransparency);
+    FBitmap.PutImage((FBitmap.Width-imgSize) div 2, (FBitmap.Height-imgSize) div 2, Mask2, dmDrawWithTransparency);
     Mask2.Free;
   end;
+  img.Free;
 
   if FValue then
   begin
-    Mask := TBGRABitmap.Create(EffectiveSize, EffectiveSize);
-    Mask.FillEllipseAntialias((EffectiveSize - 1) / 2, (EffectiveSize - 1) / 2, ScaledSize, ScaledSize, FColorOn);
-    Mask := Mask.FilterBlurRadial(ScaledPhongSize * 2, ScaledPhongSize * 2, rbFast);
-    FBitmap.BlendImageOver(0, 0, Mask, boGlow);
+    Mask := TBGRABitmap.Create(imgSize, imgSize);
+    Mask.FillEllipseAntialias((imgSize-1)/2, (imgSize-1)/2, ScaledRadius, ScaledRadius, FColorOn);
+    Mask := Mask.FilterBlurRadial(ScaledBlurSize, ScaledBlurSize, rbFast);
+    FBitmap.BlendImageOver((FBitmap.Width-imgSize) div 2, (FBitmap.Height-imgSize) div 2, Mask, boGlow);
     Mask.Free;
   end;
 

bcleaqled.pas

@@ -72,6 +72,7 @@ type
     procedure SetEnabled(Value: boolean); override;
     procedure SetVisible(Value: boolean); override;
     procedure Paint; override;
+    procedure Resize; override;
     procedure Redraw;
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
@@ -86,6 +87,7 @@ type
     procedure ApplyDefaultTheme;
   published
     property Align;
+    property BorderSpacing;
     property Cursor;
     property Enabled;
     property Font;
@@ -117,7 +119,7 @@ type
     property ColorOn: TColor read FColorOn write SetColorOn default TColor($00FF9C15);
     property ColorOff: TColor read FColorOff write SetColorOff default TColor($009E5A00);
     property BackgroundColor: TColor read FBkgColor write SetBkgColor default clBtnFace;
-    property Size: integer read FSize write SetSize default 20;
+    property Size: integer read FSize write SetSize default 30;
     property OnChangeValue: TNotifyEvent read FOnChangeValue write FOnChangeValue;
     property Style: TZStyle read FStyle write SetStyle default zsRaised;
     property Clickable: boolean read FClickable write SetClickable default False;
@@ -171,6 +173,12 @@ begin
   Redraw;
 end;
 
+procedure TBCLeaQLED.Resize;
+begin
+  inherited Resize;
+  {$IFDEF LCLgtk2} Invalidate; {$ENDIF}
+end;
+
 procedure TBCLeaQLED.SetStyle(AValue: TZStyle);
 begin
   if FStyle = AValue then
@@ -319,7 +327,7 @@ begin
   FColorOff := TColor($009E5A00);
   FBkgColor := clBtnFace;
   FStyle := zsRaised;
-  FSize := 20;
+  FSize := 30;
   FAltitude := 2;
   FRounding := 3;
   FAmbientFactor := 0.3;
@@ -362,36 +370,38 @@ end;
 
 procedure TBCLeaQLED.Redraw;
 var
-  EffectiveSize: integer;
   Blur: TBGRABitmap;
   Mask, Mask2: TBGRABitmap;
   Phong: TPhongShading;
-  ScaledPhongSize, ScaledSize: integer;
+  ScaledPhongSize, ScaledBlurSize, ScaledSize: integer;
+  img: TBGRABitmap;
+  imgSize: integer;
+  Margin: integer;
 begin
   FBitmap.SetSize(Width, Height);
   FBitmap.Fill(FBkgColor);
 
-  if Width < Height then
-    EffectiveSize := Width
-  else
-    EffectiveSize := Height;
-  if EffectiveSize < 2 then exit;
+  if (Width < 2) or (Height < 2) then Exit;
   ScaledSize := Scale96ToForm(FSize);
   ScaledPhongSize := Scale96ToForm(5);
+  ScaledBlurSize := Scale96ToForm(10);
+  Margin := ScaledBlurSize;
+
+  imgSize := ScaledSize + 2*Margin;
+  img := TBGRABitmap.Create(imgSize, imgSize, ColorToBGRA(ColorToRGB(FBkgColor)));
 
   if Enabled then
   begin
     if FValue then
-      FBitmap.FillRoundRectAntialias((EffectiveSize / 2) - ScaledSize, (EffectiveSize / 2) - ScaledSize, (EffectiveSize / 2) + ScaledSize, (EffectiveSize / 2) + ScaledSize, FRounding, FRounding, FColorOn)
+      img.FillRoundRectAntialias(Margin, Margin, Margin+ScaledSize, Margin+ScaledSize, FRounding, FRounding, FColorOn)
     else
-      FBitmap.FillRoundRectAntialias((EffectiveSize / 2) - ScaledSize, (EffectiveSize / 2) - ScaledSize, (EffectiveSize / 2) + ScaledSize, (EffectiveSize / 2) + ScaledSize, FRounding, FRounding, FColorOff);
-  end
-  else
-    FBitmap.FillRoundRectAntialias((EffectiveSize / 2) - ScaledSize, (EffectiveSize / 2) - ScaledSize, (EffectiveSize / 2) + ScaledSize, (EffectiveSize / 2) + ScaledSize, FRounding, FRounding, clGray);
+      img.FillRoundRectAntialias(Margin, Margin, Margin+ScaledSize, Margin+ScaledSize, FRounding, FRounding, FColorOff);
+  end else
+    img.FillRoundRectAntialias(Margin, Margin, Margin+ScaledSize, Margin+ScaledSize, FRounding, FRounding, clGray);
 
   if (FStyle = zsRaised) or (FStyle = zsLowered) then
   begin
-    Mask := FBitmap.FilterGrayscale as TBGRABitmap;
+    Mask := img.FilterGrayscale as TBGRABitmap;
     if (FStyle = zsRaised) then
       Mask.Negative;
     Blur := Mask.FilterBlurRadial(ScaledPhongSize, ScaledPhongSize, rbFast) as TBGRABitmap;
@@ -399,7 +409,6 @@ begin
     Mask.Free;
 
     Phong := TPhongShading.Create;
-    if assigned(FTheme) then
     begin
       Phong.AmbientFactor := FAmbientFactor;
       Phong.SpecularIndex := FSpecularIndex;
@@ -415,39 +424,38 @@ begin
       Phong.DiffuseSaturation := FDiffuseSaturation;
       Phong.LightColor := FLightColor;
     end;
-    Phong.Draw(FBitmap, Blur, FAltitude, 0, 0, FBitmap);
+    Phong.Draw(img, Blur, FAltitude, 0, 0, img);
     Phong.Free;
     Blur.Free;
 
-    Mask := TBGRABitmap.Create(EffectiveSize, EffectiveSize, BGRABlack);
-    Mask.FillRoundRectAntialias((EffectiveSize / 2) - ScaledSize, (EffectiveSize / 2) - ScaledSize, (EffectiveSize / 2) + ScaledSize, (EffectiveSize / 2) + ScaledSize, FRounding, FRounding, BGRAWhite);
-    Mask2 := TBGRABitmap.Create(EffectiveSize, EffectiveSize, ColorToBGRA(ColorToRGB(FBkgColor)));
-    Mask2.PutImage(0, 0, FBitmap, dmSet);
+    Mask := TBGRABitmap.Create(imgSize, imgSize, BGRABlack);
+    Mask.FillRoundRectAntialias(Margin, Margin, Margin+ScaledSize, Margin+ScaledSize, FRounding, FRounding, BGRAWhite);
+    Mask2 := TBGRABitmap.Create(imgSize, imgSize, ColorToBGRA(ColorToRGB(FBkgColor)));
+    Mask2.PutImage(0, 0, img, dmSet);
     Mask2.ApplyMask(Mask);
     Mask.Free;
-    FBitmap.Fill(FBkgColor);
-    FBitmap.PutImage(0, 0, Mask2, dmDrawWithTransparency);
+    FBitmap.PutImage((FBitmap.Width - imgSize) div 2, (FBitmap.Height - imgSize) div 2, Mask2, dmDrawWithTransparency);
     Mask2.Free;
   end
   else
   begin
-    Mask := TBGRABitmap.Create(EffectiveSize, EffectiveSize, BGRABlack);
-    Mask.FillRoundRectAntialias((EffectiveSize / 2) - ScaledSize, (EffectiveSize / 2) - ScaledSize, (EffectiveSize / 2) + ScaledSize, (EffectiveSize / 2) + ScaledSize, FRounding, FRounding, BGRAWhite);
-    Mask2 := TBGRABitmap.Create(EffectiveSize, EffectiveSize, ColorToBGRA(ColorToRGB(FBkgColor)));
-    Mask2.PutImage(0, 0, FBitmap, dmSet);
+    Mask := TBGRABitmap.Create(imgSize, imgSize, BGRABlack);
+    Mask.FillRoundRectAntialias(Margin, Margin, Margin+ScaledSize, Margin+ScaledSize, FRounding, FRounding, BGRAWhite);
+    Mask2 := TBGRABitmap.Create(imgSize, imgSize, ColorToBGRA(ColorToRGB(FBkgColor)));
+    Mask2.PutImage(0, 0, img, dmSet);
     Mask2.ApplyMask(Mask);
     Mask.Free;
-    FBitmap.Fill(FBkgColor);
-    FBitmap.PutImage(0, 0, Mask2, dmDrawWithTransparency);
+    FBitmap.PutImage((FBitmap.Width-imgSize) div 2, (FBitmap.Height-imgSize) div 2, Mask2, dmDrawWithTransparency);
     Mask2.Free;
   end;
+  img.Free;
 
   if FValue then
   begin
-    Mask := TBGRABitmap.Create(EffectiveSize, EffectiveSize);
-    Mask.FillRoundRectAntialias((EffectiveSize / 2) - ScaledSize, (EffectiveSize / 2) - ScaledSize, (EffectiveSize / 2) + ScaledSize, (EffectiveSize / 2) + ScaledSize, FRounding, FRounding, FColorOn);
-    Mask := Mask.FilterBlurRadial(ScaledPhongSize * 2, ScaledPhongSize * 2, rbFast);
-    FBitmap.BlendImageOver(0, 0, Mask, boGlow);
+    Mask := TBGRABitmap.Create(imgSize, imgSize);
+    Mask.FillRoundRectAntialias(Margin, Margin, Margin+ScaledSize, Margin+ScaledSize, FRounding, FRounding, FColorOn);
+    Mask := Mask.FilterBlurRadial(ScaledBlurSize, ScaledBlurSize, rbFast);
+    FBitmap.BlendImageOver((FBitmap.Width-imgSize) div 2, (FBitmap.Height-imgSize) div 2, Mask, boGlow);
     Mask.Free;
   end;
 

bclearingslider.pas

@@ -7,6 +7,8 @@
  Author: Boban Spasic
  Credits to: hedgehog, circular and lainz from Lazarus forum
  Based on TFluentProgressRing from hedgehog
+
+ 2024-11-20 Massimo Magnano Added Draw of Caption and TextLayouts
 }
 
 unit BCLeaRingSlider;
@@ -80,10 +82,19 @@ type
     FLightPositionX: integer;
     FLightPositionY: integer;
     FLightPositionZ: integer;
+    rCaptionLayout: TTextLayout;
+    rDrawCaption: Boolean;
+    rDrawCaptionPhong: Boolean;
+    rTextLayout: TTextLayout;
+
+    procedure SetCaptionLayout(AValue: TTextLayout);
+    procedure SetDrawCaption(AValue: Boolean);
+    procedure SetDrawCaptionPhong(AValue: Boolean);
     procedure SetLineBkgColor(AValue: TColor);
     procedure SetLineColor(AValue: TColor);
     procedure SetMaxValue(AValue: integer);
     procedure SetMinValue(AValue: integer);
+    procedure SetTextLayout(AValue: TTextLayout);
     procedure SetValue(AValue: integer);
     procedure SetLineWidth(AValue: integer);
     procedure UpdateVerticalPos(X, Y: integer);
@@ -108,10 +119,12 @@ type
     procedure SetEnabled(Value: boolean); override;
     procedure SetVisible(Value: boolean); override;
     procedure Paint; override;
+    procedure Resize; override;
     procedure Redraw;
     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;
+
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -120,8 +133,10 @@ type
     procedure SaveThemeToFile(AFileName: string);
     procedure LoadThemeFromFile(AFileName: string);
     procedure ApplyDefaultTheme;
+
   published
     property Align;
+    property BorderSpacing;
     property Caption;
     property Color;
     property Cursor;
@@ -175,6 +190,10 @@ type
     property PointerSize: integer read FPointerSize write SetPointerSize default 2;
     property Altitude: integer read FAltitude write SetAltitude default 2;
     property Theme: TBCLeaTheme read FTheme write SetTheme;
+    property TextLayout: TTextLayout read rTextLayout write SetTextLayout default tlCenter;
+    property DrawCaption: Boolean read rDrawCaption write SetDrawCaption default False;
+    property DrawCaptionPhong: Boolean read rDrawCaptionPhong write SetDrawCaptionPhong default False;
+    property CaptionLayout: TTextLayout read rCaptionLayout write SetCaptionLayout default tlBottom;
   end;
 
 procedure Register;
@@ -242,6 +261,27 @@ begin
   Invalidate;
 end;
 
+procedure TBCLeaRingSlider.SetCaptionLayout(AValue: TTextLayout);
+begin
+  if rCaptionLayout=AValue then Exit;
+  rCaptionLayout:=AValue;
+  Invalidate;
+end;
+
+procedure TBCLeaRingSlider.SetDrawCaption(AValue: Boolean);
+begin
+  if rDrawCaption=AValue then Exit;
+  rDrawCaption:=AValue;
+  Invalidate;
+end;
+
+procedure TBCLeaRingSlider.SetDrawCaptionPhong(AValue: Boolean);
+begin
+  if rDrawCaptionPhong=AValue then Exit;
+  rDrawCaptionPhong:=AValue;
+  Invalidate;
+end;
+
 procedure TBCLeaRingSlider.SetLineColor(AValue: TColor);
 begin
   if FLineColor = AValue then
@@ -263,6 +303,13 @@ begin
   Invalidate;
 end;
 
+procedure TBCLeaRingSlider.SetTextLayout(AValue: TTextLayout);
+begin
+  if rTextLayout=AValue then Exit;
+  rTextLayout:=AValue;
+  Invalidate;
+end;
+
 procedure TBCLeaRingSlider.SetValue(AValue: integer);
 begin
   if FValue = AValue then
@@ -300,6 +347,12 @@ begin
   Redraw;
 end;
 
+procedure TBCLeaRingSlider.Resize;
+begin
+  inherited Resize;
+  {$IFDEF LCLgtk2} Invalidate; {$ENDIF}
+end;
+
 procedure TBCLeaRingSlider.Redraw;
 const
   pi15 = pi * 1.5;
@@ -314,6 +367,7 @@ var
   Blur: TBGRABitmap;
   Mask, Mask2: TBGRABitmap;
   Phong: TPhongShading;
+  TextSize: TSize;
 
   procedure DoDrawArc(a, b: single; c: TColor);
   begin
@@ -356,7 +410,7 @@ begin
 
 
   FBitmap.Canvas2D.resetTransform;
-  FBitmap.Canvas2D.translate(FBitmap.Width / 2, FBitmap.Height / 2);
+  FBitmap.Canvas2D.translate((FBitmap.Width-1)/2, (FBitmap.Height-1)/2);
   FBitmap.Canvas2D.rotate(pi15);
 
   if FLineWidth = 0 then
@@ -391,10 +445,39 @@ begin
   if FDrawText and FDrawTextPhong then
   begin
     TextStr := IntToStr(FValue);
-    TextBmp := TextShadow(EffectiveSize, EffectiveSize, TextStr, Font.Height,
-      Font.Color, FontShadowColor, FontShadowOFfsetX,
+    TextBmp := TextShadow(FBitmap.Width, FBitmap.Height, TextStr, Font.Height,
+      Font.Color, FontShadowColor, FontShadowOffsetX,
       FontShadowOffsetY, FontShadowRadius, Font.Style, Font.Name) as TBGRABitmap;
-    FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    TextSize:= TextBmp.TextSize(TextStr);
+    TextSize.cy:= TextSize.cy+FontShadowOffsetY; //+2*FontShadowRadius ?
+
+    Case rTextLayout of
+    tlTop: FBitmap.PutImage(0, -(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                            TextBmp, dmDrawWithTransparency);
+    tlCenter: FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    tlBottom: FBitmap.PutImage(0, +(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                               TextBmp, dmDrawWithTransparency);
+    end;
+
+    TextBmp.Free;
+  end;
+
+  if rDrawCaption and rDrawCaptionPhong then
+  begin
+    TextBmp := TextShadow(FBitmap.Width, FBitmap.Height, Caption, Font.Height,
+                          Font.Color, FontShadowColor, FontShadowOffsetX,
+                          FontShadowOffsetY, FontShadowRadius, Font.Style, Font.Name) as TBGRABitmap;
+    TextSize:= TextBmp.TextSize(Caption);
+    TextSize.cy:= TextSize.cy+FontShadowOffsetY; //+2*FontShadowRadius ?
+
+    Case rCaptionLayout of
+    tlTop: FBitmap.PutImage(0, -(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                            TextBmp, dmDrawWithTransparency);
+    tlCenter: FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    tlBottom: FBitmap.PutImage(0, +(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                               TextBmp, dmDrawWithTransparency);
+    end;
+
     TextBmp.Free;
   end;
 
@@ -409,12 +492,12 @@ begin
     Mask.Free;
 
     Phong := TPhongShading.Create;
-    if Assigned(FTheme) then
     begin
       Phong.AmbientFactor := FAmbientFactor;
       Phong.SpecularIndex := FSpecularIndex;
       Phong.LightDestFactor := FLightDestFactor;
-      Phong.LightPosition := Point(FLightPositionX, FLightPositionY);
+      Phong.LightPosition := Point(FLightPositionX + (FBitmap.Width  - EffectiveSize) div 2,
+                                   FLightPositionY + (FBitmap.Height - EffectiveSize) div 2);
       Phong.LightPositionZ := FLightPositionZ;
       Phong.LightSourceIntensity := FLightSourceIntensity;
       Phong.LightSourceDistanceTerm := FLightSourceDistanceTerm;
@@ -429,9 +512,9 @@ begin
     Phong.Free;
     Blur.Free;
 
-    Mask := TBGRABitmap.Create(EffectiveSize, EffectiveSize, BGRABlack);
-    Mask.FillEllipseAntialias(EffectiveSize div 2, EffectiveSize div 2, EffectiveSize div 2, EffectiveSize div 2, BGRAWhite);
-    Mask2 := TBGRABitmap.Create(EffectiveSize, EffectiveSize, ColorToBGRA(ColorToRGB(FBkgColor)));
+    Mask := TBGRABitmap.Create(FBitmap.Width, FBitmap.Height, BGRABlack);
+    Mask.FillEllipseAntialias((FBitmap.Width-1)/2, (FBitmap.Height-1)/2, EffectiveSize div 2, EffectiveSize div 2, BGRAWhite);
+    Mask2 := TBGRABitmap.Create(FBitmap.Width, FBitmap.Height, ColorToBGRA(ColorToRGB(FBkgColor)));
     Mask2.PutImage(0, 0, FBitmap, dmSet);
     Mask2.ApplyMask(Mask);
     Mask.Free;
@@ -443,10 +526,39 @@ begin
   if FDrawText and not FDrawTextPhong then
   begin
     TextStr := IntToStr(FValue);
-    TextBmp := TextShadow(EffectiveSize, EffectiveSize, TextStr, Font.Height,
-      Font.Color, FontShadowColor, FontShadowOFfsetX,
+    TextBmp := TextShadow(FBitmap.Width, FBitmap.Height, TextStr, Font.Height,
+      Font.Color, FontShadowColor, FontShadowOffsetX,
       FontShadowOffsetY, FontShadowRadius, Font.Style, Font.Name) as TBGRABitmap;
-    FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    TextSize:= TextBmp.TextSize(TextStr);
+    TextSize.cy:= TextSize.cy+FontShadowOffsetY; //+2*FontShadowRadius ?
+
+    Case rTextLayout of
+    tlTop: FBitmap.PutImage(0, -(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                            TextBmp, dmDrawWithTransparency);
+    tlCenter: FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    tlBottom: FBitmap.PutImage(0, +(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                               TextBmp, dmDrawWithTransparency);
+    end;
+
+    TextBmp.Free;
+  end;
+
+  if rDrawCaption and not(rDrawCaptionPhong) then
+  begin
+    TextBmp := TextShadow(FBitmap.Width, FBitmap.Height, Caption, Font.Height,
+                          Font.Color, FontShadowColor, FontShadowOffsetX,
+                          FontShadowOffsetY, FontShadowRadius, Font.Style, Font.Name) as TBGRABitmap;
+    TextSize:= TextBmp.TextSize(Caption);
+    TextSize.cy:= TextSize.cy+FontShadowOffsetY; //+2*FontShadowRadius ?
+
+    Case rCaptionLayout of
+    tlTop: FBitmap.PutImage(0, -(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                            TextBmp, dmDrawWithTransparency);
+    tlCenter: FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    tlBottom: FBitmap.PutImage(0, +(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                               TextBmp, dmDrawWithTransparency);
+    end;
+
     TextBmp.Free;
   end;
 
@@ -472,7 +584,10 @@ begin
   Font.Color := clBlack;
   Font.Height := 20;
   FDrawText := True;
+  rTextLayout:= tlCenter;
   FDrawPointer := False;
+  rDrawCaption:= False;
+  rCaptionLayout:= tlBottom;
   ApplyDefaultTheme;
   FBitmap := TBGRABitmap.Create(Width, Height, FBkgColor);
 end;

bcleaselector.pas

@@ -7,6 +7,8 @@
  Author: Boban Spasic
  Credits to: hedgehog, circular and lainz from Lazarus forum
  Based on TFluentProgressRing from hedgehog
+
+ 2024-11-20 Massimo Magnano Added TextLayout
 }
 
 unit BCLeaSelector;
@@ -78,8 +80,10 @@ type
     FLightPositionX: integer;
     FLightPositionY: integer;
     FLightPositionZ: integer;
+    rTextLayout: TTextLayout;
     procedure SetLineBkgColor(AValue: TColor);
     procedure SetLineColor(AValue: TColor);
+    procedure SetTextLayout(AValue: TTextLayout);
     procedure SetTicksCount(AValue: integer);
     procedure SetValue(AValue: integer);
     procedure SetLineWidth(AValue: integer);
@@ -102,11 +106,12 @@ type
     procedure SetStyle(AValue: TZStyle);
     procedure SetDrawTextPhong(AValue: boolean);
     procedure SetTheme(AValue: TBCLeaTheme);
-    procedure SetAltitude(Avalue: integer);
+    procedure SetAltitude(AValue: integer);
   protected
     procedure SetEnabled(Value: boolean); override;
     procedure SetVisible(Value: boolean); override;
     procedure Paint; override;
+    procedure Resize; override;
     procedure Redraw;
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
@@ -121,6 +126,7 @@ type
     procedure ApplyDefaultTheme;
   published
     property Align;
+    property BorderSpacing;
     property Cursor;
     property Enabled;
     property Font;
@@ -173,6 +179,7 @@ type
     property DrawTextPhong: boolean read FDrawTextPhong write SetDrawTextPhong default False;
     property Theme: TBCLeaTheme read FTheme write SetTheme;
     property Altitude: integer read FAltitude write SetAltitude default 2;
+    property TextLayout: TTextLayout read rTextLayout write SetTextLayout default tlCenter;
   end;
 
 
@@ -261,6 +268,13 @@ begin
   Invalidate;
 end;
 
+procedure TBCLeaSelector.SetTextLayout(AValue: TTextLayout);
+begin
+  if rTextLayout=AValue then Exit;
+  rTextLayout:=AValue;
+  Invalidate;
+end;
+
 procedure TBCLeaSelector.SetTicksCount(AValue: integer);
 begin
   if FTicksCount = AValue then
@@ -325,6 +339,12 @@ begin
   Redraw;
 end;
 
+procedure TBCLeaSelector.Resize;
+begin
+  inherited Resize;
+  {$IFDEF LCLgtk2} Invalidate; {$ENDIF}
+end;
+
 procedure TBCLeaSelector.Redraw;
 const
   pi15 = pi * 1.5;
@@ -340,6 +360,7 @@ var
   Phong: TPhongShading;
   ScaledPhongSize: int64;
   i: integer;
+  TextSize: TSize;
 
   procedure DoDrawArc(a, b: single; c: TColor);
   begin
@@ -372,7 +393,7 @@ begin
 
 
   FBitmap.Canvas2D.resetTransform;
-  FBitmap.Canvas2D.translate(FBitmap.Width / 2, FBitmap.Height / 2);
+  FBitmap.Canvas2D.translate((FBitmap.Width-1)/2, (FBitmap.Height-1)/2);
   FBitmap.Canvas2D.rotate(pi15);
 
   if FLineWidth = 0 then
@@ -418,10 +439,20 @@ begin
       TextStr := FItems[FValue]
     else
       TextStr := 'NaN';
-    TextBmp := TextShadow(EffectiveSize, EffectiveSize, TextStr, Font.Height,
+    TextBmp := TextShadow(FBitmap.Width, FBitmap.Height, TextStr, Font.Height,
       Font.Color, FontShadowColor, FontShadowOFfsetX,
       FontShadowOffsetY, FontShadowRadius, Font.Style, Font.Name) as TBGRABitmap;
-    FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    TextSize:= TextBmp.TextSize(TextStr);
+    TextSize.cy:= TextSize.cy+FontShadowOffsetY; //+2*FontShadowRadius ?
+
+    Case rTextLayout of
+    tlTop: FBitmap.PutImage(0, -(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                            TextBmp, dmDrawWithTransparency);
+    tlCenter: FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    tlBottom: FBitmap.PutImage(0, +(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                               TextBmp, dmDrawWithTransparency);
+    end;
+
     TextBmp.Free;
   end;
 
@@ -436,12 +467,12 @@ begin
     Mask.Free;
 
     Phong := TPhongShading.Create;
-    if Assigned(FTheme) then
     begin
       Phong.AmbientFactor := FAmbientFactor;
       Phong.SpecularIndex := FSpecularIndex;
       Phong.LightDestFactor := FLightDestFactor;
-      Phong.LightPosition := Point(FLightPositionX, FLightPositionY);
+      Phong.LightPosition := Point(FLightPositionX + (FBitmap.Width  - EffectiveSize) div 2,
+                                   FLightPositionY + (FBitmap.Height - EffectiveSize) div 2);
       Phong.LightPositionZ := FLightPositionZ;
       Phong.LightSourceIntensity := FLightSourceIntensity;
       Phong.LightSourceDistanceTerm := FLightSourceDistanceTerm;
@@ -457,9 +488,9 @@ begin
     Blur.Free;
 
     //cut out phong-affected area outside the ring and fill with background color
-    Mask := TBGRABitmap.Create(EffectiveSize, EffectiveSize, BGRABlack);
-    Mask.FillEllipseAntialias(EffectiveSize div 2, EffectiveSize div 2, EffectiveSize div 2, EffectiveSize div 2, BGRAWhite);
-    Mask2 := TBGRABitmap.Create(EffectiveSize, EffectiveSize, ColorToBGRA(ColorToRGB(FBkgColor)));
+    Mask := TBGRABitmap.Create(FBitmap.Width, FBitmap.Height, BGRABlack);
+    Mask.FillEllipseAntialias((FBitmap.Width-1)/2, (FBitmap.Height-1)/2, EffectiveSize div 2, EffectiveSize div 2, BGRAWhite);
+    Mask2 := TBGRABitmap.Create(FBitmap.Width, FBitmap.Height, ColorToBGRA(ColorToRGB(FBkgColor)));
     Mask2.PutImage(0, 0, FBitmap, dmSet);
     Mask2.ApplyMask(Mask);
     Mask.Free;
@@ -474,10 +505,20 @@ begin
       TextStr := FItems[FValue]
     else
       TextStr := 'NaN';
-    TextBmp := TextShadow(EffectiveSize, EffectiveSize, TextStr, Font.Height,
+    TextBmp := TextShadow(FBitmap.Width, FBitmap.Height, TextStr, Font.Height,
       Font.Color, FontShadowColor, FontShadowOFfsetX,
       FontShadowOffsetY, FontShadowRadius, Font.Style, Font.Name) as TBGRABitmap;
-    FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    TextSize:= TextBmp.TextSize(TextStr);
+    TextSize.cy:= TextSize.cy+FontShadowOffsetY; //+2*FontShadowRadius ?
+
+    Case rTextLayout of
+    tlTop: FBitmap.PutImage(0, -(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                            TextBmp, dmDrawWithTransparency);
+    tlCenter: FBitmap.PutImage(0, 0, TextBmp, dmDrawWithTransparency);
+    tlBottom: FBitmap.PutImage(0, +(HalfUp(((EffectiveSize-TextSize.cy) / 2))-Trunc(EffectiveLineWidth)),
+                               TextBmp, dmDrawWithTransparency);
+    end;
+
     TextBmp.Free;
   end;
 
@@ -500,6 +541,7 @@ begin
   FDeltaPos := 0;
   FSensitivity := 10;
   FDrawText := True;
+  rTextLayout:= tlCenter;
   FDrawTicks := False;
   ApplyDefaultTheme;
   FBitmap := TBGRABitmap.Create(Width, Height, FBkgColor);

bcmaterialedit.pas

@@ -5,38 +5,264 @@ unit BCMaterialEdit;
 interface
 
 uses
-  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
-  StdCtrls;
+  Classes, Controls, Dialogs, ExtCtrls, Forms, Graphics, {$IFDEF FPC} LCLType,
+  LResources, {$ENDIF} Menus, StdCtrls, SysUtils;
 
 type
 
-  { TBCMaterialEdit }
+  { TBCMaterialEditBase }
 
-  TBCMaterialEdit = class(TCustomPanel)
+  generic TBCMaterialEditBase<T> = class(TCustomPanel)
   private
     FAccentColor: TColor;
     FDisabledColor: TColor;
-    Flbl: TLabel;
-    Fedt: TEdit;
-    Ffocused: boolean;
-    FOnChange: TNotifyEvent;
-    FTexto: string;
-    procedure ChangeEdit(Sender: TObject);
-    procedure EnterEdit(Sender: TObject);
-    procedure ExitEdit(Sender: TObject);
-    procedure SetTexto(AValue: string);
+    FLabel: TBoundLabel;
+    FFocused: boolean;
+    function IsNeededAdjustSize: boolean;
+
+    function GetOnEditChange: TNotifyEvent;
+    function GetOnEditClick: TNotifyEvent;
+    function GetOnEditEditingDone: TNotifyEvent;
+    function GetOnEditEnter: TNotifyEvent;
+    function GetOnEditExit: TNotifyEvent;
+    function GetOnEditKeyDown: TKeyEvent;
+    function GetOnEditKeyPress: TKeyPressEvent;
+    function GetOnEditKeyUp: TKeyEvent;
+    function GetOnEditMouseDown: TMouseEvent;
+    function GetOnEditMouseEnter: TNotifyEvent;
+    function GetOnEditMouseLeave: TNotifyEvent;
+    function GetOnEditMouseMove: TMouseMoveEvent;
+    function GetOnEditMouseUp: TMouseEvent;
+    function GetOnEditMouseWheel: TMouseWheelEvent;
+    function GetOnEditMouseWheelDown: TMouseWheelUpDownEvent;
+    function GetOnEditMouseWheelUp: TMouseWheelUpDownEvent;
+    function GetOnEditUTF8KeyPress: TUTF8KeyPressEvent;
+
+    procedure SetOnEditChange(AValue: TNotifyEvent);
+    procedure SetOnEditClick(AValue: TNotifyEvent);
+    procedure SetOnEditEditingDone(AValue: TNotifyEvent);
+    procedure SetOnEditEnter(AValue: TNotifyEvent);
+    procedure SetOnEditExit(AValue: TNotifyEvent);
+    procedure SetOnEditKeyDown(AValue: TKeyEvent);
+    procedure SetOnEditKeyPress(AValue: TKeyPressEvent);
+    procedure SetOnEditKeyUp(AValue: TKeyEvent);
+    procedure SetOnEditMouseDown(AValue: TMouseEvent);
+    procedure SetOnEditMouseEnter(AValue: TNotifyEvent);
+    procedure SetOnEditMouseLeave(AValue: TNotifyEvent);
+    procedure SetOnEditMouseMove(AValue: TMouseMoveEvent);
+    procedure SetOnEditMouseUp(AValue: TMouseEvent);
+    procedure SetOnEditMouseWheel(AValue: TMouseWheelEvent);
+    procedure SetOnEditMouseWheelDown(AValue: TMouseWheelUpDownEvent);
+    procedure SetOnEditMouseWheelUp(AValue: TMouseWheelUpDownEvent);
+    procedure SetOnEditUTF8KeyPress(AValue: TUTF8KeyPressEvent);
   protected
+    FEdit: T;
+
+    function GetEditAlignment: TAlignment;
+    function GetEditAutoSize: Boolean;
+    function GetEditAutoSelect: Boolean;
+    function GetEditCharCase: TEditCharCase;
+    function GetEditCursor: TCursor;
+    function GetEditDoubleBuffered: Boolean;
+    function GetEditEchoMode: TEchoMode;
+    function GetEditHideSelection: Boolean;
+    function GetEditHint: TTranslateString;
+    function GetEditMaxLength: Integer;
+    function GetEditNumbersOnly: Boolean;
+    function GetEditPasswordChar: Char;
+    function GetEditParentColor: Boolean;
+    function GetEditPopupMenu: TPopupMenu;
+    function GetEditReadOnly: Boolean;
+    function GetEditShowHint: Boolean;
+    function GetEditTag: PtrInt;
+    function GetEditTabStop: Boolean;
+    function GetEditText: TCaption;
+    function GetEditTextHint: TTranslateString;
+    function GetLabelCaption: TCaption;
+    function GetLabelSpacing: Integer;
+
+    procedure SetAnchors(const AValue: TAnchors); override;
+    procedure SetColor(AValue: TColor); override;
+    procedure SetEditAlignment(const AValue: TAlignment);
+    procedure SetEditAutoSize(AValue: Boolean);
+    procedure SetEditAutoSelect(AValue: Boolean);
+    procedure SetEditCharCase(AValue: TEditCharCase);
+    procedure SetEditCursor(AValue: TCursor);
+    procedure SetEditDoubleBuffered(AValue: Boolean);
+    procedure SetEditEchoMode(AValue: TEchoMode);
+    procedure SetEditHideSelection(AValue: Boolean);
+    procedure SetEditHint(const AValue: TTranslateString);
+    procedure SetEditMaxLength(AValue: Integer);
+    procedure SetEditNumbersOnly(AValue: Boolean);
+    procedure SetEditParentColor(AValue: Boolean);
+    procedure SetEditPasswordChar(AValue: Char);
+    procedure SetEditPopupMenu(AValue: TPopupmenu);
+    procedure SetEditReadOnly(AValue: Boolean);
+    procedure SetEditShowHint(AValue: Boolean);
+    procedure SetEditTag(AValue: PtrInt);
+    procedure SetEditTabStop(AValue: Boolean);
+    procedure SetEditText(const AValue: TCaption);
+    procedure SetEditTextHint(const Avalue: TTranslateString);
+    procedure SetLabelCaption(const AValue: TCaption);
+    procedure SetLabelSpacing(AValue: Integer);
+    procedure SetName(const AValue: TComponentName); override;
+
+    procedure DoEnter; override;
+    procedure DoExit; override;
+    procedure DoOnResize; override;
     procedure Paint; override;
   public
     constructor Create(AOwner: TComponent); override;
   published
+    property Align;
+    property Alignment: TAlignment read GetEditAlignment write SetEditAlignment default taLeftJustify;
+    property AccentColor: TColor read FAccentColor write FAccentColor;
+    property Anchors;
+    property AutoSelect: Boolean read GetEditAutoSelect write SetEditAutoSelect default True;
+    property AutoSize: Boolean read GetEditAutoSize write SetEditAutoSize default True;
+    property BiDiMode;
+    property BorderSpacing;
+    property Caption: TCaption read GetLabelCaption write SetLabelCaption;
+    property CharCase: TEditCharCase read GetEditCharCase write SetEditCharCase default ecNormal;
     property Color;
-    property Text: string read FTexto write SetTexto;
-    property Edit: TEdit read Fedt;
-    property Title: TLabel read Flbl;
+    property Constraints;
+    property Cursor: TCursor read GetEditCursor write SetEditCursor default crDefault;
     property DisabledColor: TColor read FDisabledColor write FDisabledColor;
-    property AccentColor: TColor read FAccentColor write FAccentColor;
-    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property DoubleBuffered: Boolean read GetEditDoubleBuffered write SetEditDoubleBuffered;
+    property EchoMode: TEchoMode read GetEditEchoMode write SetEditEchoMode default emNormal;
+    property EditLabel: TBoundLabel read FLabel;
+    property Enabled;
+    property Font;
+    property HideSelection: Boolean read GetEditHideSelection write SetEditHideSelection default True;
+    property Hint: TTranslateString read GetEditHint write SetEditHint;
+    property LabelSpacing: Integer read GetLabelSpacing write SetLabelSpacing default 4;
+    property MaxLength: Integer read GetEditMaxLength write SetEditMaxLength default 0;
+    property NumbersOnly: Boolean read GetEditNumbersOnly write SetEditNumbersOnly default False;
+    property ParentBiDiMode;
+    property ParentColor default False;
+    property ParentFont default False;
+    property PasswordChar: Char read GetEditPasswordChar write SetEditPasswordChar default #0;
+    property PopupMenu: TPopupmenu read GetEditPopupMenu write SetEditPopupMenu;
+    property ReadOnly: Boolean read GetEditReadOnly write SetEditReadOnly default False;
+    property ShowHint: Boolean read GetEditShowHint write SetEditShowHint default False;
+    property Tag: PtrInt read GetEditTag write SetEditTag default 0;
+    property TabOrder;
+    property TabStop: boolean read GetEditTabStop write SetEditTabStop default True;
+    property Text: TCaption read GetEditText write SetEditText;
+    property TextHint: TTranslateString read GetEditTextHint write SetEditTextHint;
+    property Visible;
+
+    property OnChange: TNotifyEvent read GetOnEditChange write SetOnEditChange;
+    property OnChangeBounds;
+    property OnClick: TNotifyEvent read GetOnEditClick write SetOnEditClick;
+    property OnEditingDone: TNotifyEvent read GetOnEditEditingDone write SetOnEditEditingDone;
+    property OnEnter: TNotifyEvent read GetOnEditEnter write SetOnEditEnter;
+    property OnExit: TNotifyEvent read GetOnEditExit write SetOnEditExit;
+    property OnKeyDown: TKeyEvent read GetOnEditKeyDown write SetOnEditKeyDown;
+    property OnKeyPress: TKeyPressEvent read GetOnEditKeyPress write SetOnEditKeyPress;
+    property OnKeyUp: TKeyEvent read GetOnEditKeyUp write SetOnEditKeyUp;
+    property OnMouseDown: TMouseEvent read GetOnEditMouseDown write SetOnEditMouseDown;
+    property OnMouseEnter: TNotifyEvent read GetOnEditMouseEnter write SetOnEditMouseEnter;
+    property OnMouseLeave: TNotifyEvent read GetOnEditMouseLeave write SetOnEditMouseLeave;
+    property OnMouseMove: TMouseMoveEvent read GetOnEditMouseMove write SetOnEditMouseMove;
+    property OnMouseUp: TMouseEvent read GetOnEditMouseUp write SetOnEditMouseUp;
+    property OnMouseWheel: TMouseWheelEvent read GetOnEditMouseWheel write SetOnEditMouseWheel;
+    property OnMouseWheelDown: TMouseWheelUpDownEvent read GetOnEditMouseWheelDown write SetOnEditMouseWheelDown;
+    property OnMouseWheelUp: TMouseWheelUpDownEvent read GetOnEditMouseWheelUp write SetOnEditMouseWheelUp;
+    property OnResize;
+    property OnUTF8KeyPress: TUTF8KeyPressEvent read GetOnEditUTF8KeyPress write SetOnEditUTF8KeyPress;
+  end;
+
+  { TBCMaterialEdit }
+
+  TBCMaterialEdit = class(specialize TBCMaterialEditBase<TEdit>)
+  private
+    function GetEditDragCursor: TCursor;
+    function GetEditDragMode: TDragMode;
+
+    function GetOnEditContextPopup: TContextPopupEvent;
+    function GetOnEditDblClick: TNotifyEvent;
+    function GetOnEditDragDrop: TDragDropEvent;
+    function GetOnEditDragOver: TDragOverEvent;
+    function GetOnEditEndDrag: TEndDragEvent;
+    function GetOnEditStartDrag: TStartDragEvent;
+
+    procedure SetEditDragCursor(AValue: TCursor);
+    procedure SetEditDragMode(AValue: TDragMode);
+
+    procedure SetOnEditContextPopup(AValue: TContextPopupEvent);
+    procedure SetOnEditDblClick(AValue: TNotifyEvent);
+    procedure SetOnEditDragDrop(AValue: TDragDropEvent);
+    procedure SetOnEditDragOver(AValue: TDragOverEvent);
+    procedure SetOnEditEndDrag(AValue: TEndDragEvent);
+    procedure SetOnEditStartDrag(AValue: TStartDragEvent);
+  published
+    property Align;
+    property Alignment;
+    property AccentColor;
+    property Anchors;
+    property AutoSelect;
+    property AutoSize;
+    property BiDiMode;
+    property BorderSpacing;
+    property Caption;
+    property CharCase;
+    property Color;
+    property Constraints;
+    property Cursor;
+    property DisabledColor;
+    property DoubleBuffered;
+    property DragCursor: TCursor read GetEditDragCursor write SetEditDragCursor default crDrag;
+    property DragMode: TDragMode read GetEditDragMode write SetEditDragMode default dmManual;
+    property Font;
+    property EchoMode;
+    property Edit: TEdit read FEdit;
+    property EditLabel;
+    property Enabled;
+    property HideSelection;
+    property Hint;
+    property LabelSpacing;
+    property MaxLength;
+    property NumbersOnly;
+    property ParentBiDiMode;
+    property ParentColor;
+    property ParentFont;
+    property PasswordChar;
+    property PopupMenu;
+    property ReadOnly;
+    property ShowHint;
+    property Tag;
+    property TabOrder;
+    property TabStop;
+    property Text;
+    property TextHint;
+    property Visible;
+
+    property OnChange;
+    property OnChangeBounds;
+    property OnClick;
+    property OnContextPopup;
+    property OnDbClick: TNotifyEvent read GetOnEditDblClick write SetOnEditDblClick;
+    property OnDragDrop: TDragDropEvent read GetOnEditDragDrop write SetOnEditDragDrop;
+    property OnDragOver: TDragOverEvent read GetOnEditDragOver write SetOnEditDragOver;
+    property OnEditingDone;
+    property OnEndDrag: TEndDragEvent read GetOnEditEndDrag write SetOnEditEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnKeyDown;
+    property OnKeyPress;
+    property OnKeyUp;
+    property OnMouseDown;
+    property OnMouseEnter;
+    property OnMouseLeave;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnResize;
+    property OnStartDrag: TStartDragEvent read GetOnEditStartDrag write SetOnEditStartDrag;
+    property OnUTF8KeyPress;
   end;
 
 procedure Register;
@@ -45,84 +271,649 @@ implementation
 
 procedure Register;
 begin
+  {$IFDEF FPC}
+    {$I icons\bcmaterialedit_icon.lrs}
+  {$ENDIF}
   RegisterComponents('BGRA Controls', [TBCMaterialEdit]);
 end;
 
-{ TBCMaterialEdit }
+{ TBCMaterialEditBase }
 
-procedure TBCMaterialEdit.EnterEdit(Sender: TObject);
+function TBCMaterialEditBase.GetEditAlignment: TAlignment;
 begin
-  Ffocused := True;
-  Invalidate;
-  Flbl.Font.Color := accentColor;
+  result := FEdit.Alignment;
+end;
+
+function TBCMaterialEditBase.GetEditAutoSize: Boolean;
+begin
+  result := FEdit.AutoSize;
+end;
+
+function TBCMaterialEditBase.GetEditAutoSelect: Boolean;
+begin
+  result := FEdit.AutoSelect;
+end;
+
+function TBCMaterialEditBase.GetEditCharCase: TEditCharCase;
+begin
+  result := FEdit.CharCase;
+end;
+
+function TBCMaterialEditBase.GetEditCursor: TCursor;
+begin
+  result := FEdit.Cursor;
+end;
+
+function TBCMaterialEditBase.GetEditDoubleBuffered: Boolean;
+begin
+  result := FEdit.DoubleBuffered;
+end;
+
+function TBCMaterialEditBase.GetEditEchoMode: TEchoMode;
+begin
+  result := FEdit.EchoMode;
+end;
+
+function TBCMaterialEditBase.GetEditHideSelection: Boolean;
+begin
+  result := FEdit.HideSelection;
+end;
+
+function TBCMaterialEditBase.GetEditHint: TTranslateString;
+begin
+  result := FEdit.Hint;
+end;
+
+function TBCMaterialEditBase.GetEditMaxLength: Integer;
+begin
+  result := FEdit.MaxLength;
+end;
+
+function TBCMaterialEditBase.GetEditNumbersOnly: Boolean;
+begin
+  result := FEdit.NumbersOnly;
+end;
+
+function TBCMaterialEditBase.GetEditPasswordChar: Char;
+begin
+  result := FEdit.PasswordChar;
+end;
+
+function TBCMaterialEditBase.GetEditParentColor: Boolean;
+begin
+  Result := Self.ParentColor;
+end;
+
+function TBCMaterialEditBase.GetEditPopupMenu: TPopupMenu;
+begin
+  if (csDestroying in ComponentState) then Exit(nil);
+
+  result := FEdit.PopupMenu;
+end;
+
+function TBCMaterialEditBase.GetEditReadOnly: Boolean;
+begin
+  result := FEdit.ReadOnly;
+end;
+
+function TBCMaterialEditBase.GetEditShowHint: Boolean;
+begin
+  result := FEdit.ShowHint;
+end;
+
+function TBCMaterialEditBase.GetEditTag: PtrInt;
+begin
+  result := FEdit.Tag;
+end;
+
+function TBCMaterialEditBase.GetEditTabStop: Boolean;
+begin
+  result := FEdit.TabStop;
+end;
+
+function TBCMaterialEditBase.GetEditText: TCaption;
+begin
+  result := FEdit.Text;
+end;
+
+function TBCMaterialEditBase.GetEditTextHint: TCaption;
+begin
+  result := FEdit.TextHint;
+end;
+
+function TBCMaterialEditBase.GetLabelCaption: TCaption;
+begin
+  result := FLabel.Caption
+end;
+
+function TBCMaterialEditBase.GetLabelSpacing: Integer;
+begin
+  result := FLabel.BorderSpacing.Bottom;
+end;
+
+function TBCMaterialEditBase.GetOnEditChange: TNotifyEvent;
+begin
+  result := FEdit.OnChange;
+end;
+
+function TBCMaterialEditBase.GetOnEditClick: TNotifyEvent;
+begin
+  result := FEdit.OnClick;
+end;
+
+function TBCMaterialEditBase.GetOnEditEditingDone: TNotifyEvent;
+begin
+  result := FEdit.OnEditingDone;
+end;
+
+function TBCMaterialEditBase.GetOnEditEnter: TNotifyEvent;
+begin
+  result := FEdit.OnEnter;
+end;
+
+function TBCMaterialEditBase.GetOnEditExit: TNotifyEvent;
+begin
+  result := FEdit.OnExit;
+end;
+
+function TBCMaterialEditBase.GetOnEditKeyDown: TKeyEvent;
+begin
+  result := FEdit.OnKeyDown;
+end;
+
+function TBCMaterialEditBase.GetOnEditKeyPress: TKeyPressEvent;
+begin
+  result := FEdit.OnKeyPress;
+end;
+
+function TBCMaterialEditBase.GetOnEditKeyUp: TKeyEvent;
+begin
+  result := FEdit.OnKeyUp;
+end;
+
+function TBCMaterialEditBase.GetOnEditMouseDown: TMouseEvent;
+begin
+  result := FEdit.OnMouseDown;
+end;
+
+function TBCMaterialEditBase.GetOnEditMouseEnter: TNotifyEvent;
+begin
+  result := FEdit.OnMouseEnter;
+end;
+
+function TBCMaterialEditBase.GetOnEditMouseLeave: TNotifyEvent;
+begin
+  result := FEdit.OnMouseLeave;
+end;
+
+function TBCMaterialEditBase.GetOnEditMouseMove: TMouseMoveEvent;
+begin
+  result := FEdit.OnMouseMove;
+end;
+
+function TBCMaterialEditBase.GetOnEditMouseUp: TMouseEvent;
+begin
+  result := FEdit.OnMouseUp;
+end;
+
+function TBCMaterialEditBase.GetOnEditMouseWheel: TMouseWheelEvent;
+begin
+  result := FEdit.OnMouseWheel;
+end;
+
+function TBCMaterialEditBase.GetOnEditMouseWheelDown: TMouseWheelUpDownEvent;
+begin
+  result := FEdit.OnMouseWheelDown;
+end;
+
+function TBCMaterialEditBase.GetOnEditMouseWheelUp: TMouseWheelUpDownEvent;
+begin
+  result := FEdit.OnMouseWheelUp;
+end;
+
+function TBCMaterialEditBase.GetOnEditUTF8KeyPress: TUTF8KeyPressEvent;
+begin
+  result := FEdit.OnUTF8KeyPress;
+end;
+
+procedure TBCMaterialEditBase.SetOnEditChange(AValue: TNotifyEvent);
+begin
+  FEdit.OnChange := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetOnEditClick(AValue: TNotifyEvent);
+begin
+  FEdit.OnClick := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetOnEditEditingDone(AValue: TNotifyEvent);
+begin
+  FEdit.OnEditingDone := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetOnEditEnter(AValue: TNotifyEvent);
+begin
+  FEdit.OnEnter := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetOnEditExit(AValue: TNotifyEvent);
+begin
+  FEdit.OnExit := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetOnEditKeyDown(AValue: TKeyEvent);
+begin
+  FEdit.OnKeyDown := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetOnEditKeyPress(AValue: TKeyPressEvent);
+begin
+  FEdit.OnKeyPress := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetOnEditKeyUp(AValue: TKeyEvent);
+begin
+  FEdit.OnKeyUp := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetOnEditMouseDown(AValue: TMouseEvent);
+begin
+  FEdit.OnMouseDown := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetOnEditMouseEnter(AValue: TNotifyEvent);
+begin
+  FEdit.OnMouseEnter := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetOnEditMouseLeave(AValue: TNotifyEvent);
+begin
+  FEdit.OnMouseLeave := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetOnEditMouseMove(AValue: TMouseMoveEvent);
+begin
+  FEdit.OnMouseMove := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetOnEditMouseUp(AValue: TMouseEvent);
+begin
+  FEdit.OnMouseUp := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetOnEditMouseWheel(AValue: TMouseWheelEvent);
+begin
+  FEdit.OnMouseWheel := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetOnEditMouseWheelDown(AValue: TMouseWheelUpDownEvent);
+begin
+  FEdit.OnMouseWheelDown := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetOnEditMouseWheelUp(AValue: TMouseWheelUpDownEvent);
+begin
+  FEdit.OnMouseWheelUp := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetOnEditUTF8KeyPress(AValue: TUTF8KeyPressEvent);
+begin
+  FEdit.OnUTF8KeyPress := AValue;
+end;
+
+function TBCMaterialEditBase.IsNeededAdjustSize: boolean;
+begin
+  if (Self.Align in [alLeft, alRight, alClient]) then Exit(False);
+  if (akTop in Self.Anchors) and (akBottom in Self.Anchors) then Exit(False);
+  result := FEdit.AutoSize;
+end;
+
+procedure TBCMaterialEditBase.SetAnchors(const AValue: TAnchors);
+begin
+  if (Self.Anchors = AValue) then Exit;
+  inherited SetAnchors(AValue);
+
+  if not (csLoading in ComponentState) then Self.DoOnResize;
+end;
+
+procedure TBCMaterialEditBase.SetColor(AValue: TColor);
+begin
+  inherited SetColor(AValue);
+  FEdit.Color := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditAlignment(const AValue: TAlignment);
+begin
+  FEdit.Alignment := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditAutoSize(AValue: Boolean);
+begin
+  if (FEdit.AutoSize = AValue) then Exit;
+  FEdit.AutoSize := AValue;
+
+  if not (csLoading in ComponentState) then Self.DoOnResize;
+end;
+
+procedure TBCMaterialEditBase.SetEditAutoSelect(AValue: Boolean);
+begin
+  FEdit.AutoSelect := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditCharCase(AValue: TEditCharCase);
+begin
+  FEdit.CharCase := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditCursor(AValue: TCursor);
+begin
+  FEdit.Cursor := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditDoubleBuffered(AValue: Boolean);
+begin
+  FEdit.DoubleBuffered := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditEchoMode(AValue: TEchoMode);
+begin
+  FEdit.EchoMode := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditHideSelection(AValue: Boolean);
+begin
+  FEdit.HideSelection := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditHint(const AValue: TTranslateString);
+begin
+  FEdit.Hint := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditMaxLength(AValue: Integer);
+begin
+  FEdit.MaxLength := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditNumbersOnly(AValue: Boolean);
+begin
+  FEdit.NumbersOnly := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditParentColor(AValue: Boolean);
+begin
+  FEdit.ParentColor  := AValue;
+  FLabel.ParentColor := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditPasswordChar(AValue: Char);
+begin
+  FEdit.PasswordChar := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditTabStop(AValue: Boolean);
+begin
+  FEdit.TabStop := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditPopupMenu(AValue: TPopupmenu);
+begin
+  FEdit.PopupMenu := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditReadOnly(AValue: Boolean);
+begin
+  FEdit.ReadOnly := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditShowHint(AValue: Boolean);
+begin
+  FEdit.ShowHint := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditTag(AValue: PtrInt);
+begin
+  FEdit.Tag := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditTextHint(const Avalue: TTranslateString);
+begin
+  FEdit.TextHint := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetEditText(const AValue: TCaption);
+begin
+  FEdit.Text := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetLabelCaption(const AValue: TCaption);
+begin
+  FLabel.Caption := AValue;
+end;
+
+procedure TBCMaterialEditBase.SetLabelSpacing(AValue: Integer);
+begin
+  if (FLabel.BorderSpacing.Bottom = AValue) then Exit;
+  FLabel.BorderSpacing.Bottom := AValue;
+
+  if not (csLoading in ComponentState) then Self.DoOnResize;
+end;
+
+procedure TBCMaterialEditBase.SetName(const AValue: TComponentName);
+begin
+  if (csDesigning in ComponentState) then
+  begin
+    if (FLabel.Caption = '') or (AnsiSameText(FLabel.Caption, AValue)) then
+      FLabel.Caption := 'Label';
+
+    if (FLabel.Name = '') or (AnsiSameText(FLabel.Name, AValue)) then
+      FLabel.Name := AValue + 'SubLabel';
+
+    if (FEdit.Text = '') or (AnsiSameText(FEdit.Text, AValue)) then
+      FEdit.Text := AValue;
+
+    if (FEdit.Name = '') or (AnsiSameText(FEdit.Name, AValue)) then
+      FEdit.Name := AValue + 'SubEdit';
+  end;
+  inherited SetName(AValue);
 end;
 
-procedure TBCMaterialEdit.ChangeEdit(Sender: TObject);
+procedure TBCMaterialEditBase.DoEnter;
 begin
-  if Assigned(FOnChange) then
-    FOnChange(Self);
+  inherited DoEnter;
+  FFocused := True;
+  Invalidate;
 end;
 
-procedure TBCMaterialEdit.ExitEdit(Sender: TObject);
+procedure TBCMaterialEditBase.DoExit;
 begin
-  Ffocused := False;
+  FFocused := False;
   Invalidate;
-  Flbl.Font.Color := DisabledColor;
+  inherited DoExit;
 end;
 
-procedure TBCMaterialEdit.SetTexto(AValue: string);
+procedure TBCMaterialEditBase.DoOnResize;
+var
+  AutoSizedHeight: longint;
 begin
-  if FTexto = AValue then
-    Exit;
-  FTexto := AValue;
-  Flbl.Caption := FTexto;
-  //Fedt.TextHint := FTexto;
+  if IsNeededAdjustSize then
+  begin
+    FEdit.Align := alBottom;
+    AutoSizedHeight :=
+      FLabel.Height +
+      FLabel.BorderSpacing.Around +
+      FLabel.BorderSpacing.Bottom +
+      FLabel.BorderSpacing.Top +
+      FEdit.Height +
+      FEdit.BorderSpacing.Around +
+      FEdit.BorderSpacing.Bottom +
+      FEdit.BorderSpacing.Top;
+
+    if Self.Height <> AutoSizedHeight then
+      Self.Height := AutoSizedHeight;
+  end else
+  begin
+    FEdit.Align := alClient;
+  end;
+  inherited DoOnResize;
 end;
 
-procedure TBCMaterialEdit.Paint;
+procedure TBCMaterialEditBase.Paint;
+var
+  LeftPos, RightPos: integer;
 begin
   inherited Paint;
   Canvas.Brush.Color := Color;
   Canvas.Pen.Color := Color;
   Canvas.Rectangle(0, 0, Width, Height);
-  if (fFocused) then
+
+  if Assigned(Parent) and (Parent.Color = Color) then
+  begin
+    LeftPos := FEdit.Left;
+    RightPos := FEdit.Left + FEdit.Width;
+  end else
+  begin
+    LeftPos := 0;
+    RightPos := Width;
+  end;
+
+  if (FFocused) and (Self.Enabled) then
   begin
     Canvas.Pen.Color := AccentColor;
-    Canvas.Line(0, Height - 2, Width, Height - 2);
-    Canvas.Line(0, Height - 1, Width, Height - 1);
-  end
-  else
+    Canvas.Line(LeftPos, Height - 2, RightPos, Height - 2);
+    Canvas.Line(LeftPos, Height - 1, RightPos, Height - 1);
+    FLabel.Font.Color := AccentColor;
+  end else
   begin
     Canvas.Pen.Color := DisabledColor;
-    Canvas.Line(0, Height - 1, Width, Height - 1);
+    Canvas.Line(LeftPos, Height - 1, RightPos, Height - 1);
+    FLabel.Font.Color := DisabledColor;
   end;
 end;
 
-constructor TBCMaterialEdit.Create(AOwner: TComponent);
+constructor TBCMaterialEditBase.Create(AOwner: TComponent);
 begin
+  FEdit := T.Create(Self);
+  FLabel := TBoundLabel.Create(Self);
   inherited Create(AOwner);
-  Self.BevelOuter := bvNone;
-  Self.Color := clWhite;
-  AccentColor := clHighlight;
-  DisabledColor := $00B8AFA8;
-  Flbl := TLabel.Create(Self);
-  Flbl.Align := alTop;
-  Flbl.Caption := 'Buscar';
-  Flbl.BorderSpacing.Around := 4;
-  Flbl.Font.Style := [fsBold];
-  Flbl.Font.Color := $00B8AFA8;
-  Flbl.Parent := Self;
-  Fedt := TEdit.Create(Self);
-  Fedt.Color := Color;
-  Fedt.Font.Color := clBlack;
-  Fedt.OnEnter := @EnterEdit;
-  Fedt.OnExit := @ExitEdit;
-  Fedt.OnChange:=@ChangeEdit;
-  Fedt.Align := alClient;
-  Fedt.BorderStyle := bsNone;
-  //Fedt.TextHint := 'Buscar';
-  Fedt.BorderSpacing.Around := 4;
-  Fedt.Parent := Self;
+  Self.AccentColor := clHighlight;
+  Self.BorderStyle := bsNone;
+  Self.Color := clWindow;
+  Self.DisabledColor := $00B8AFA8;
+  Self.ParentColor := False;
+
+  FLabel.Align := alTop;
+  FLabel.AutoSize := True;
+  FLabel.BorderSpacing.Around := 0;
+  FLabel.BorderSpacing.Bottom := 4;
+  FLabel.BorderSpacing.Left := 4;
+  FLabel.BorderSpacing.Right := 4;
+  FLabel.BorderSpacing.Top := 4;
+  FLabel.Font.Color := $00B8AFA8;
+  FLabel.Font.Style := [fsBold];
+  FLabel.Parent := Self;
+  FLabel.ParentFont := False;
+  FLabel.ParentBiDiMode := True;
+  FLabel.SetSubComponent(True);
+
+  FEdit.Align := alBottom;
+  FEdit.AutoSelect := True;
+  FEdit.AutoSize := True;
+  FEdit.BorderSpacing.Around := 0;
+  FEdit.BorderSpacing.Bottom := 4;
+  FEdit.BorderSpacing.Left := 4;
+  FEdit.BorderSpacing.Right := 4;
+  FEdit.BorderSpacing.Top := 0;
+  FEdit.BorderStyle := bsNone;
+  FEdit.Color := Color;
+  FEdit.Font.Color := clBlack;
+  FEdit.Parent := Self;
+  FEdit.ParentFont := True;
+  FEdit.ParentBiDiMode := True;
+  FEdit.TabStop := True;
+  FEdit.SetSubComponent(True);
+end;
+
+{ TBCMaterialEdit }
+
+function TBCMaterialEdit.GetEditDragCursor: TCursor;
+begin
+  result := FEdit.DragCursor;
+end;
+
+function TBCMaterialEdit.GetEditDragMode: TDragMode;
+begin
+  result := FEdit.DragMode;
+end;
+
+function TBCMaterialEdit.GetOnEditContextPopup: TContextPopupEvent;
+begin
+  result := FEdit.OnContextPopup;
+end;
+
+function TBCMaterialEdit.GetOnEditDblClick: TNotifyEvent;
+begin
+  result := FEdit.OnDblClick;
+end;
+
+function TBCMaterialEdit.GetOnEditDragDrop: TDragDropEvent;
+begin
+  result := FEdit.OnDragDrop;
+end;
+
+function TBCMaterialEdit.GetOnEditDragOver: TDragOverEvent;
+begin
+  result := FEdit.OnDragOver;
+end;
+
+function TBCMaterialEdit.GetOnEditEndDrag: TEndDragEvent;
+begin
+  result := FEdit.OnEndDrag;
+end;
+
+function TBCMaterialEdit.GetOnEditStartDrag: TStartDragEvent;
+begin
+  result := FEdit.OnStartDrag;
+end;
+
+procedure TBCMaterialEdit.SetEditDragCursor(AValue: TCursor);
+begin
+  FEdit.DragCursor := AValue;
+end;
+
+procedure TBCMaterialEdit.SetEditDragMode(AValue: TDragMode);
+begin
+  FEdit.DragMode := AValue;
+end;
+
+procedure TBCMaterialEdit.SetOnEditContextPopup(AValue: TContextPopupEvent);
+begin
+  FEdit.OnContextPopup := AValue;
+end;
+
+procedure TBCMaterialEdit.SetOnEditDblClick(AValue: TNotifyEvent);
+begin
+  FEdit.OnDblClick := AValue;
+end;
+
+procedure TBCMaterialEdit.SetOnEditDragDrop(AValue: TDragDropEvent);
+begin
+  FEdit.OnDragDrop := AValue;
+end;
+
+procedure TBCMaterialEdit.SetOnEditDragOver(AValue: TDragOverEvent);
+begin
+  FEdit.OnDragOver := AValue;
+end;
+
+procedure TBCMaterialEdit.SetOnEditEndDrag(AValue: TEndDragEvent);
+begin
+  FEdit.OnEndDrag := AValue;
+end;
+
+procedure TBCMaterialEdit.SetOnEditStartDrag(AValue: TStartDragEvent);
+begin
+  FEdit.OnStartDrag := AValue;
 end;
 
 end.

bcmaterialfloatspinedit.pas

@@ -5,38 +5,114 @@ unit BCMaterialFloatSpinEdit;
 interface
 
 uses
-  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
-  StdCtrls, Spin;
+  BCMaterialEdit, Classes, Controls, Dialogs, ExtCtrls, Forms, Graphics,
+  {$IFDEF FPC} LCLType, LResources, {$ENDIF} Menus, Spin, StdCtrls, SysUtils;
 
 type
 
   { TBCMaterialFloatSpinEdit }
 
-  TBCMaterialFloatSpinEdit = class(TCustomPanel)
+  TBCMaterialFloatSpinEdit = class(specialize TBCMaterialEditBase<TFloatSpinEdit>)
   private
-    FAccentColor: TColor;
-    FDisabledColor: TColor;
-    Flbl: TLabel;
-    Fedt: TFloatSpinEdit;
-    Ffocused: boolean;
-    FOnChange: TNotifyEvent;
-    FTexto: string;
-    procedure ChangeEdit(Sender: TObject);
-    procedure EnterEdit(Sender: TObject);
-    procedure ExitEdit(Sender: TObject);
-    procedure SetTexto(AValue: string);
-  protected
-    procedure Paint; override;
-  public
-    constructor Create(AOwner: TComponent); override;
+    function GetEditDecimalPlaces: integer;
+    function GetEditEditorEnabled: boolean;
+    function GetEditIncrement: double;
+    function GetEditMinValue: double;
+    function GetEditMaxValue: double;
+    function GetEditValue: double;
+    function GetEditValueEmpty: boolean;
+
+    procedure SetEditDecimalPlaces(AValue: integer);
+    procedure SetEditEditorEnabled(AValue: boolean);
+    procedure SetEditIncrement(AValue: double);
+    procedure SetEditMinValue(AValue: double);
+    procedure SetEditMaxValue(AValue: double);
+    procedure SetEditValue(AValue: double);
+    procedure SetEditValueEmpty(AValue: boolean);
+
+    function GetOnEditMouseWheelHorz: TMouseWheelEvent;
+    function GetOnEditMouseWheelLeft: TMouseWheelUpDownEvent;
+    function GetOnEditMouseWheelRight: TMouseWheelUpDownEvent;
+
+    procedure SetOnEditMouseWheelHorz(AValue: TMouseWheelEvent);
+    procedure SetOnEditMouseWheelLeft(AValue: TMouseWheelUpDownEvent);
+    procedure SetOnEditMouseWheelRight(AValue: TMouseWheelUpDownEvent);
   published
+    property Align;
+    property Alignment;
+    property Anchors;
+    property AutoSelect;
+    property AutoSize;
+  //property BiDiMode;
+    property BorderSpacing;
+    property Caption;
+  //property CharCase;
     property Color;
-    property Text: string read FTexto write SetTexto;
-    property Edit: TFloatSpinEdit read Fedt;
-    property Title: TLabel read Flbl;
-    property DisabledColor: TColor read FDisabledColor write FDisabledColor;
-    property AccentColor: TColor read FAccentColor write FAccentColor;
-    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property Constraints;
+    property Cursor;
+    property DecimalPlaces: integer read GetEditDecimalPlaces write SetEditDecimalPlaces;
+    property DisabledColor;
+  //property DoubleBuffered;
+  //property EchoMode;
+    property Edit: TFloatSpinEdit read FEdit;
+    property EditorEnabled: boolean read GetEditEditorEnabled write SetEditEditorEnabled default True;
+    property EditLabel;
+    property Enabled;
+    property Font;
+    property Height;
+  //property HideSelection;
+    property Hint;
+    property Increment: double read GetEditIncrement write SetEditIncrement;
+    property Left;
+    property MinValue: double read GetEditMinValue write SetEditMinValue;
+  //property MaxLength;
+    property MaxValue: double read GetEditMaxValue write SetEditMaxValue;
+    property LabelSpacing;
+    property Name;
+  //property ParentBiDiMode;
+    property ParentColor;
+    property ParentFont;
+    property PopupMenu;
+    property ReadOnly;
+    property ShowHint;
+    property TabOrder;
+    property TabStop;
+  //property Text;
+  //property TextHint;
+    property Tag;
+    property Top;
+    property Value: double read GetEditValue write SetEditValue;
+    property ValueEmpty: boolean read GetEditValueEmpty write SetEditValueEmpty default False;
+    property Visible;
+    property Width;
+
+    property OnChange;
+    property OnChangeBounds;
+    property OnClick;
+  //property OnContextPopup;
+  //property OnDragDrop;
+  //property OnDragOver;
+    property OnEditingDone;
+  //property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnKeyDown;
+    property OnKeyPress;
+    property OnKeyUp;
+    property OnMouseDown;
+    property OnMouseEnter;
+    property OnMouseLeave;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnMouseWheelHorz: TMouseWheelEvent read GetOnEditMouseWheelHorz write SetOnEditMouseWheelHorz;
+    property OnMouseWheelLeft: TMouseWheelUpDownEvent read GetOnEditMouseWheelLeft write SetOnEditMouseWheelLeft;
+    property OnMouseWheelRight: TMouseWheelUpDownEvent read GetOnEditMouseWheelRight write SetOnEditMouseWheelRight;
+    property OnResize;
+  //property OnStartDrag;
+    property OnUTF8KeyPress;
   end;
 
 procedure Register;
@@ -45,86 +121,110 @@ implementation
 
 procedure Register;
 begin
+  {$IFDEF FPC}
+    {$I icons\bcmaterialfloatspinedit_icon.lrs}
+  {$ENDIF}
   RegisterComponents('BGRA Controls', [TBCMaterialFloatSpinEdit]);
 end;
 
-{ TBCMaterialFloatSpinEdit }
+function TBCMaterialFloatSpinEdit.GetEditDecimalPlaces: integer;
+begin
+  result := FEdit.DecimalPlaces;
+end;
 
-procedure TBCMaterialFloatSpinEdit.EnterEdit(Sender: TObject);
+function TBCMaterialFloatSpinEdit.GetEditEditorEnabled: boolean;
 begin
-  Ffocused := True;
-  Invalidate;
-  Flbl.Font.Color := AccentColor;
+  result := FEdit.EditorEnabled;
 end;
 
-procedure TBCMaterialFloatSpinEdit.ChangeEdit(Sender: TObject);
+function TBCMaterialFloatSpinEdit.GetEditIncrement: double;
 begin
-  if Assigned(FOnChange) then
-    FOnChange(Self);
+  result := FEdit.Increment;
 end;
 
-procedure TBCMaterialFloatSpinEdit.ExitEdit(Sender: TObject);
+function TBCMaterialFloatSpinEdit.GetEditMinValue: double;
 begin
-  Ffocused := False;
-  Invalidate;
-  Flbl.Font.Color := DisabledColor;
+  result := FEdit.MinValue;
 end;
 
-procedure TBCMaterialFloatSpinEdit.SetTexto(AValue: string);
+function TBCMaterialFloatSpinEdit.GetEditMaxValue: double;
 begin
-  if FTexto = AValue then
-    Exit;
-  FTexto := AValue;
-  Flbl.Caption := FTexto;
-  //Fedt.TextHint := FTexto;
+  result := FEdit.MaxValue;
 end;
 
-procedure TBCMaterialFloatSpinEdit.Paint;
+function TBCMaterialFloatSpinEdit.GetEditValue: double;
 begin
-  inherited Paint;
-  Canvas.Brush.Color := Color;
-  Canvas.Pen.Color := Color;
-  Canvas.Rectangle(0, 0, Width, Height);
-  if (fFocused) then
-  begin
-    Canvas.Pen.Color := AccentColor;
-    Canvas.Line(0, Height - 2, Width, Height - 2);
-    Canvas.Line(0, Height - 1, Width, Height - 1);
-  end
-  else
-  begin
-    Canvas.Pen.Color := DisabledColor;
-    Canvas.Line(0, Height - 1, Width, Height - 1);
-  end;
+  result := FEdit.Value;
+end;
+
+function TBCMaterialFloatSpinEdit.GetEditValueEmpty: boolean;
+begin
+  result := FEdit.ValueEmpty;
+end;
+
+procedure TBCMaterialFloatSpinEdit.SetEditDecimalPlaces(AValue: integer);
+begin
+  FEdit.DecimalPlaces := AValue;
+end;
+
+procedure TBCMaterialFloatSpinEdit.SetEditEditorEnabled(AValue: boolean);
+begin
+  FEdit.EditorEnabled := AValue;
+end;
+
+procedure TBCMaterialFloatSpinEdit.SetEditIncrement(AValue: double);
+begin
+  FEdit.Increment := AValue;
 end;
 
-constructor TBCMaterialFloatSpinEdit.Create(AOwner: TComponent);
-begin
-  inherited Create(AOwner);
-  Self.BevelOuter := bvNone;
-  Self.Color := clWhite;
-  AccentColor := clHighlight;
-  DisabledColor := $00B8AFA8;
-  Flbl := TLabel.Create(Self);
-  Flbl.Align := alTop;
-  Flbl.Caption := 'Buscar';
-  Flbl.BorderSpacing.Around := 4;
-  Flbl.Font.Style := [fsBold];
-  Flbl.Font.Color := $00B8AFA8;
-  Flbl.Parent := Self;
-  Fedt := TFloatSpinEdit.Create(Self);
-  Fedt.Color := Color;
-  Fedt.Font.Color := clBlack;
-  Fedt.OnEnter := @EnterEdit;
-  Fedt.OnExit := @ExitEdit;
-  Fedt.OnChange:=@ChangeEdit;
-  Fedt.Align := alClient;
-  Fedt.BorderStyle := bsNone;
-  //Fedt.TextHint := 'Buscar';
-  Fedt.BorderSpacing.Around := 4;
-  Fedt.Parent := Self;
-  Fedt.MinValue := 0;
-  Fedt.MaxValue := MaxInt;
+procedure TBCMaterialFloatSpinEdit.SetEditMinValue(AValue: double);
+begin
+  FEdit.MinValue := AValue;
+end;
+
+procedure TBCMaterialFloatSpinEdit.SetEditMaxValue(AValue: double);
+begin
+  FEdit.MaxValue := AValue;
+end;
+
+procedure TBCMaterialFloatSpinEdit.SetEditValue(AValue: double);
+begin
+  FEdit.Value := AValue;
+end;
+
+procedure TBCMaterialFloatSpinEdit.SetEditValueEmpty(AValue: boolean);
+begin
+  FEdit.ValueEmpty := AValue;
+end;
+
+function TBCMaterialFloatSpinEdit.GetOnEditMouseWheelHorz: TMouseWheelEvent;
+begin
+  result := FEdit.OnMouseWheelHorz;
+end;
+
+function TBCMaterialFloatSpinEdit.GetOnEditMouseWheelLeft: TMouseWheelUpDownEvent;
+begin
+  result := FEdit.OnMouseWheelLeft;
+end;
+
+function TBCMaterialFloatSpinEdit.GetOnEditMouseWheelRight: TMouseWheelUpDownEvent;
+begin
+  result := FEdit.OnMouseWheelRight;
+end;
+
+procedure TBCMaterialFloatSpinEdit.SetOnEditMouseWheelHorz(AValue: TMouseWheelEvent);
+begin
+  FEdit.OnMouseWheelHorz := AValue;
+end;
+
+procedure TBCMaterialFloatSpinEdit. SetOnEditMouseWheelLeft(AValue: TMouseWheelUpDownEvent);
+begin
+  FEdit.OnMouseWheelLeft := AValue;
+end;
+
+procedure TBCMaterialFloatSpinEdit.SetOnEditMouseWheelRight(AValue: TMouseWheelUpDownEvent);
+begin
+  FEdit.OnMouseWheelRight := AValue;
 end;
 
 end.

bcmaterialspinedit.pas

@@ -5,38 +5,108 @@ unit BCMaterialSpinEdit;
 interface
 
 uses
-  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
-  StdCtrls, Spin;
+  BCMaterialEdit, Classes, Controls, Dialogs, ExtCtrls, Forms, Graphics,
+  {$IFDEF FPC} LCLType, LResources, {$ENDIF} Menus, Spin, StdCtrls, SysUtils;
 
 type
 
   { TBCMaterialSpinEdit }
 
-  TBCMaterialSpinEdit = class(TCustomPanel)
+  TBCMaterialSpinEdit = class(specialize TBCMaterialEditBase<TSpinEdit>)
   private
-    FAccentColor: TColor;
-    FDisabledColor: TColor;
-    Flbl: TLabel;
-    Fedt: TSpinEdit;
-    Ffocused: boolean;
-    FOnChange: TNotifyEvent;
-    FTexto: string;
-    procedure ChangeEdit(Sender: TObject);
-    procedure EnterEdit(Sender: TObject);
-    procedure ExitEdit(Sender: TObject);
-    procedure SetTexto(AValue: string);
-  protected
-    procedure Paint; override;
-  public
-    constructor Create(AOwner: TComponent); override;
+    function GetEditEditorEnabled: boolean;
+    function GetEditIncrement: double;
+    function GetEditMinValue: double;
+    function GetEditMaxValue: double;
+    function GetEditValue: double;
+
+    procedure SetEditEditorEnabled(AValue: boolean);
+    procedure SetEditIncrement(AValue: double);
+    procedure SetEditMinValue(AValue: double);
+    procedure SetEditMaxValue(AValue: double);
+    procedure SetEditValue(AValue: double);
+
+    function GetOnEditMouseWheelHorz: TMouseWheelEvent;
+    function GetOnEditMouseWheelLeft: TMouseWheelUpDownEvent;
+    function GetOnEditMouseWheelRight: TMouseWheelUpDownEvent;
+
+    procedure SetOnEditMouseWheelHorz(AValue: TMouseWheelEvent);
+    procedure SetOnEditMouseWheelLeft(AValue: TMouseWheelUpDownEvent);
+    procedure SetOnEditMouseWheelRight(AValue: TMouseWheelUpDownEvent);
   published
+    property Align;
+    property Alignment;
+    property Anchors;
+    property AutoSelect;
+    property AutoSize;
+  //property BiDiMode;
+    property BorderSpacing;
+    property Caption;
+  //property CharCase;
     property Color;
-    property Text: string read FTexto write SetTexto;
-    property Edit: TSpinEdit read Fedt;
-    property Title: TLabel read Flbl;
-    property DisabledColor: TColor read FDisabledColor write FDisabledColor;
-    property AccentColor: TColor read FAccentColor write FAccentColor;
-    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property Constraints;
+    property Cursor;
+    property DisabledColor;
+  //property DoubleBuffered;
+  //property EchoMode;
+    property Edit: TSpinEdit read FEdit;
+    property EditorEnabled: boolean read GetEditEditorEnabled write SetEditEditorEnabled default True;
+    property EditLabel;
+    property Enabled;
+    property Font;
+    property Height;
+  //property HideSelection;
+    property Hint;
+    property Increment: double read GetEditIncrement write SetEditIncrement;
+    property Left;
+    property MinValue: double read GetEditMinValue write SetEditMinValue;
+  //property MaxLength;
+    property MaxValue: double read GetEditMaxValue write SetEditMaxValue;
+    property LabelSpacing;
+    property Name;
+  //property ParentBiDiMode;
+    property ParentColor;
+    property ParentFont;
+    property PopupMenu;
+    property ReadOnly;
+    property ShowHint;
+    property TabOrder;
+    property TabStop;
+    property Tag;
+  //property Text;
+  //property TextHint;
+    property Top;
+    property Value: double read GetEditValue write SetEditValue;
+    property Visible;
+    property Width;
+
+    property OnChange;
+    property OnChangeBounds;
+    property OnClick;
+    //property OnContextPopup;
+    //property OnDragDrop;
+    //property OnDragOver;
+    property OnEditingDone;
+    //property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnKeyDown;
+    property OnKeyPress;
+    property OnKeyUp;
+    property OnMouseDown;
+    property OnMouseEnter;
+    property OnMouseLeave;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnMouseWheelHorz: TMouseWheelEvent read GetOnEditMouseWheelHorz write SetOnEditMouseWheelHorz;
+    property OnMouseWheelLeft: TMouseWheelUpDownEvent read GetOnEditMouseWheelLeft write SetOnEditMouseWheelLeft;
+    property OnMouseWheelRight: TMouseWheelUpDownEvent read GetOnEditMouseWheelRight write SetOnEditMouseWheelRight;
+    property OnResize;
+    //property OnStartDrag;
+    property OnUTF8KeyPress;
   end;
 
 procedure Register;
@@ -45,86 +115,90 @@ implementation
 
 procedure Register;
 begin
+  {$IFDEF FPC}
+    {$I icons\bcmaterialspinedit_icon.lrs}
+  {$ENDIF}
   RegisterComponents('BGRA Controls', [TBCMaterialSpinEdit]);
 end;
 
-{ TBCMaterialSpinEdit }
+function TBCMaterialSpinEdit.GetEditEditorEnabled: boolean;
+begin
+  result := FEdit.EditorEnabled;
+end;
 
-procedure TBCMaterialSpinEdit.EnterEdit(Sender: TObject);
+function TBCMaterialSpinEdit.GetEditIncrement: double;
 begin
-  Ffocused := True;
-  Invalidate;
-  Flbl.Font.Color := AccentColor;
+  result := FEdit.Increment;
 end;
 
-procedure TBCMaterialSpinEdit.ChangeEdit(Sender: TObject);
+function TBCMaterialSpinEdit.GetEditMinValue: double;
 begin
-  if Assigned(FOnChange) then
-    FOnChange(Self);
+  result := FEdit.MinValue;
 end;
 
-procedure TBCMaterialSpinEdit.ExitEdit(Sender: TObject);
+function TBCMaterialSpinEdit.GetEditMaxValue: double;
 begin
-  Ffocused := False;
-  Invalidate;
-  Flbl.Font.Color := DisabledColor;
+  result := FEdit.MaxValue;
 end;
 
-procedure TBCMaterialSpinEdit.SetTexto(AValue: string);
+function TBCMaterialSpinEdit.GetEditValue: double;
 begin
-  if FTexto = AValue then
-    Exit;
-  FTexto := AValue;
-  Flbl.Caption := FTexto;
-  //Fedt.TextHint := FTexto;
+  result := FEdit.Value;
 end;
 
-procedure TBCMaterialSpinEdit.Paint;
+procedure TBCMaterialSpinEdit.SetEditEditorEnabled(AValue: boolean);
 begin
-  inherited Paint;
-  Canvas.Brush.Color := Color;
-  Canvas.Pen.Color := Color;
-  Canvas.Rectangle(0, 0, Width, Height);
-  if (fFocused) then
-  begin
-    Canvas.Pen.Color := AccentColor;
-    Canvas.Line(0, Height - 2, Width, Height - 2);
-    Canvas.Line(0, Height - 1, Width, Height - 1);
-  end
-  else
-  begin
-    Canvas.Pen.Color := DisabledColor;
-    Canvas.Line(0, Height - 1, Width, Height - 1);
-  end;
+  FEdit.EditorEnabled := AValue;
+end;
+
+procedure TBCMaterialSpinEdit.SetEditIncrement(AValue: double);
+begin
+  FEdit.Increment := AValue;
+end;
+
+procedure TBCMaterialSpinEdit.SetEditMinValue(AValue: double);
+begin
+  FEdit.MinValue := AValue;
+end;
+
+procedure TBCMaterialSpinEdit.SetEditMaxValue(AValue: double);
+begin
+  FEdit.MaxValue := AValue;
 end;
 
-constructor TBCMaterialSpinEdit.Create(AOwner: TComponent);
-begin
-  inherited Create(AOwner);
-  Self.BevelOuter := bvNone;
-  Self.Color := clWhite;
-  AccentColor := clHighlight;
-  DisabledColor := $00B8AFA8;
-  Flbl := TLabel.Create(Self);
-  Flbl.Align := alTop;
-  Flbl.Caption := 'Buscar';
-  Flbl.BorderSpacing.Around := 4;
-  Flbl.Font.Style := [fsBold];
-  Flbl.Font.Color := $00B8AFA8;
-  Flbl.Parent := Self;
-  Fedt := TSpinEdit.Create(Self);
-  Fedt.Color := Color;
-  Fedt.Font.Color := clBlack;
-  Fedt.OnEnter := @EnterEdit;
-  Fedt.OnExit := @ExitEdit;
-  Fedt.OnChange:=@ChangeEdit;
-  Fedt.Align := alClient;
-  Fedt.BorderStyle := bsNone;
-  //Fedt.TextHint := 'Buscar';
-  Fedt.BorderSpacing.Around := 4;
-  Fedt.Parent := Self;
-  Fedt.MinValue := 0;
-  Fedt.MaxValue := MaxInt;
+procedure TBCMaterialSpinEdit.SetEditValue(AValue: double);
+begin
+  FEdit.Value := AValue;
+end;
+
+function TBCMaterialSpinEdit.GetOnEditMouseWheelHorz: TMouseWheelEvent;
+begin
+  result := FEdit.OnMouseWheelHorz;
+end;
+
+function TBCMaterialSpinEdit.GetOnEditMouseWheelLeft: TMouseWheelUpDownEvent;
+begin
+  result := FEdit.OnMouseWheelLeft;
+end;
+
+function TBCMaterialSpinEdit.GetOnEditMouseWheelRight: TMouseWheelUpDownEvent;
+begin
+  result := FEdit.OnMouseWheelRight;
+end;
+
+procedure TBCMaterialSpinEdit.SetOnEditMouseWheelHorz(AValue: TMouseWheelEvent);
+begin
+  FEdit.OnMouseWheelHorz := AValue;
+end;
+
+procedure TBCMaterialSpinEdit. SetOnEditMouseWheelLeft(AValue: TMouseWheelUpDownEvent);
+begin
+  FEdit.OnMouseWheelLeft := AValue;
+end;
+
+procedure TBCMaterialSpinEdit.SetOnEditMouseWheelRight(AValue: TMouseWheelUpDownEvent);
+begin
+  FEdit.OnMouseWheelRight := AValue;
 end;
 
 end.

bcroundedimage.pas

@@ -9,6 +9,9 @@
   - 2020-09-06: Initial version supporting circle, rounded rectangle and square.
                 Changing the quality of the resample, setting the rounding.
                 OnPaintEvent to customize the final drawing.
+  - 2025-01: MaxM, Changed class ancestor to TCustomBGRAGraphicControl;
+                   Added TBGRABitmap Bitmap draw;
+                   Added Stretch, Proportional, Alignments.
 }
 unit BCRoundedImage;
 
@@ -18,13 +21,15 @@ interface
 
 uses
   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
-  BGRABitmap, BGRABitmapTypes;
+  BGRABitmap, BGRABitmapTypes, BGRAGraphicControl, BCTypes;
 
 type
   TBCRoundedImage = class;
 
   // Event to draw before the image is sent to canvas
-  TBCRoundedImagePaintEvent = procedure (const Sender: TBCRoundedImage; const Bitmap: TBGRABitmap) of object;
+  //TBCRoundedImagePaintEvent = procedure (const Sender: TBCRoundedImage; const Bitmap: TBGRABitmap) of object;
+  TBCRoundedImagePaintEvent = TBGRARedrawEvent;
+
   // Supported styles are circle, rounded rectangle and square
   TBCRoundedImageStyle = (isCircle, isRoundedRectangle, isSquare);
 
@@ -32,24 +37,46 @@ type
 
   { TBCRoundedImage }
 
-  TBCRoundedImage = class(TGraphicControl)
+  TBCRoundedImage = class(TCustomBGRAGraphicControl)
   private
     FBorderStyle: TRoundRectangleOptions;
     FOnPaintEvent: TBCRoundedImagePaintEvent;
     FPicture: TPicture;
+    FImageBitmap: TBGRABitmap;
     FQuality: TResampleFilter;
     FStyle: TBCRoundedImageStyle;
     FRounding: single;
+    FProportional: Boolean;
+    FOnChange: TNotifyEvent;
+    FAlignment: TAlignment;
+    FStretch: Boolean;
+    FVerticalAlignment: TTextLayout;
+
+    function GetOnPaintEvent: TBCRoundedImagePaintEvent;
+    procedure SetAlignment(AValue: TAlignment);
+    procedure SetBitmap(AValue: TBGRABitmap);
     procedure SetBorderStyle(AValue: TRoundRectangleOptions);
+    procedure SetOnPaintEvent(AValue: TBCRoundedImagePaintEvent);
     procedure SetPicture(AValue: TPicture);
+    procedure SetProportional(AValue: Boolean);
     procedure SetQuality(AValue: TResampleFilter);
+    procedure SetStretch(AValue: Boolean);
     procedure SetStyle(AValue: TBCRoundedImageStyle);
     procedure SetRounding(AValue: single);
+    procedure SetVerticalAlignment(AValue: TTextLayout);
+
   protected
+    procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: boolean); override;
+
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure Paint; override;
+
+    procedure Draw(ABitmap: TBGRABitmap);
+
+    property Bitmap: TBGRABitmap read FImageBitmap write setBitmap;
+
   published
     // The image that's used as background
     property Picture: TPicture read FPicture write SetPicture;
@@ -61,9 +88,19 @@ type
     property Rounding: single read FRounding write SetRounding;
     // The quality when resizing the image
     property Quality: TResampleFilter read FQuality write SetQuality;
+    // Stretch Proportianally
+    property Proportional: Boolean read FProportional write SetProportional;
+    property Stretch: Boolean read FStretch write SetStretch default True;
+
+    // Alignments of the Image inside the Control
+    property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
+    property VerticalAlignment: TTextLayout read FVerticalAlignment write SetVerticalAlignment default tlCenter;
+
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+
     // You can paint before the bitmap is drawn on canvas
-    property OnPaintEvent: TBCRoundedImagePaintEvent read FOnPaintEvent write FOnPaintEvent;
-  published
+    property OnPaintEvent: TBCRoundedImagePaintEvent read GetOnPaintEvent write SetOnPaintEvent; deprecated 'Use OnRedraw instead';
+
     property Anchors;
     property Align;
     property OnMouseEnter;
@@ -71,20 +108,65 @@ type
     property OnClick;
   end;
 
+
+{ #todo -oMaxM : we could move it to a common unit and use it in BGRAImageList too }
+function CalcProportionalRect(AWidth, AHeight, AImageWidth, AImageHeight: Integer;
+                               AHorizAlign: TAlignment; AVertAlign: TTextLayout): TRect;
+
+
 procedure Register;
 
 implementation
 
+function CalcProportionalRect(AWidth, AHeight, AImageWidth, AImageHeight: Integer; AHorizAlign: TAlignment;
+  AVertAlign: TTextLayout): TRect;
+var
+  rW, rH:Single;
+  newWidth,
+  newHeight:Integer;
+
+begin
+  FillChar(Result, sizeof(Result), 0);
+  if (AImageWidth > 0) and (AImageHeight > 0) then
+  begin
+    rW := AImageWidth / AWidth;
+    rH := AImageHeight / AHeight;
+
+    if (rW > rH)
+    then begin
+           newHeight:= round(AImageHeight / rW);
+           newWidth := AWidth;
+           end
+    else begin
+           newWidth := round(AImageWidth / rH);
+           newHeight := AHeight;
+         end;
+
+    case AHorizAlign of
+    taCenter: Result.Left:= (AWidth-newWidth) div 2;
+    taRightJustify: Result.Left:= AWidth-newWidth;
+    end;
+    case AVertAlign of
+    tlCenter: Result.Top:= (AHeight-newHeight) div 2;
+    tlBottom: Result.Top:= AHeight-newHeight;
+    end;
+
+    Result.Right:= Result.Left+newWidth;
+    Result.Bottom:= Result.Top+newHeight;
+  end;
+end;
+
 procedure Register;
 begin
   RegisterComponents('BGRA Controls', [TBCRoundedImage]);
 end;
 
-procedure TBCRoundedImage.SetPicture(AValue: TPicture);
+procedure TBCRoundedImage.SetProportional(AValue: Boolean);
 begin
-  if FPicture = AValue then
-    Exit;
-  FPicture := AValue;
+  if FProportional=AValue then Exit;
+  FProportional:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
   Invalidate;
 end;
 
@@ -92,14 +174,78 @@ procedure TBCRoundedImage.SetBorderStyle(AValue: TRoundRectangleOptions);
 begin
   if FBorderStyle=AValue then Exit;
   FBorderStyle:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
   Invalidate;
 end;
 
+function TBCRoundedImage.GetOnPaintEvent: TBCRoundedImagePaintEvent;
+begin
+  Result:= OnRedraw;
+end;
+
+procedure TBCRoundedImage.SetAlignment(AValue: TAlignment);
+begin
+  if FAlignment=AValue then Exit;
+  FAlignment:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBCRoundedImage.SetBitmap(AValue: TBGRABitmap);
+begin
+  if (AValue <> FImageBitmap) then
+  begin
+    // Clear actual image
+    FImageBitmap.Free;
+
+    FImageBitmap :=TBGRABitmap.Create(Width, Height, BGRAPixelTransparent);
+
+    if (AValue<>nil) then FImageBitmap.Assign(AValue, True); // Associate the new bitmap
+
+    if Assigned(FOnChange) then FOnChange(Self);
+    Invalidate;
+  end;
+end;
+
+procedure TBCRoundedImage.SetPicture(AValue: TPicture);
+begin
+  if (AValue <> FPicture) then
+  begin
+    // Clear actual Picture
+    FPicture.Free;
+
+    FPicture :=TPicture.Create;
+
+    if (AValue<>nil) then FPicture.Assign(AValue); // Associate the new Picture
+
+    if Assigned(FOnChange) then FOnChange(Self);
+    Invalidate;
+  end;
+end;
+
+procedure TBCRoundedImage.SetOnPaintEvent(AValue: TBCRoundedImagePaintEvent);
+begin
+  OnRedraw:= AValue;
+end;
+
 procedure TBCRoundedImage.SetQuality(AValue: TResampleFilter);
 begin
   if FQuality = AValue then
     Exit;
   FQuality := AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBCRoundedImage.SetStretch(AValue: Boolean);
+begin
+  if FStretch=AValue then Exit;
+  FStretch:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
   Invalidate;
 end;
 
@@ -108,6 +254,8 @@ begin
   if FStyle = AValue then
     Exit;
   FStyle := AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
   Invalidate;
 end;
 
@@ -116,53 +264,126 @@ begin
   if FRounding = AValue then
     Exit;
   FRounding := AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBCRoundedImage.SetVerticalAlignment(AValue: TTextLayout);
+begin
+  if FVerticalAlignment=AValue then Exit;
+  FVerticalAlignment:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
   Invalidate;
 end;
 
+{$hints off}
+procedure TBCRoundedImage.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: boolean);
+begin
+  PreferredWidth  := 100;
+  PreferredHeight := 100;
+end;
+
 constructor TBCRoundedImage.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
+
+  FAlignment:= taCenter;
+  FVerticalAlignment:= tlCenter;
+  FStretch:= True;
+
+  // Create the Image Bitmap
   FPicture := TPicture.Create;
+  FImageBitmap := TBGRABitmap.Create;
+
   FRounding := 10;
   FQuality := rfBestQuality;
+  FBGRA.FillTransparent;
 end;
 
 destructor TBCRoundedImage.Destroy;
 begin
   FPicture.Free;
+  FImageBitmap.Free;
+
   inherited Destroy;
 end;
 
 procedure TBCRoundedImage.Paint;
+begin
+  if (ClientWidth <> FBGRA.Width) or (ClientHeight <> FBGRA.Height)
+  then FBGRA.SetSize(ClientWidth, ClientHeight);
+
+  Draw(FBGRA);
+
+  if Assigned(OnRedraw) then OnRedraw(Self, FBGRA);
+
+  FBGRA.Draw(Canvas, 0, 0, False);
+end;
+
+procedure TBCRoundedImage.Draw(ABitmap: TBGRABitmap);
 var
-  bgra: TBGRABitmap;
-  image: TBGRABitmap;
+  image,
+  imageD: TBGRABitmap;
+  imgRect: TRect;
+
 begin
-  if (FPicture.Width = 0) or (FPicture.Height = 0) then
-    Exit;
-  // Picture
-  image := TBGRABitmap.Create(FPicture.Bitmap);
-  bgra := TBGRABitmap.Create(Width, Height, BGRAPixelTransparent);
+  ABitmap.FillTransparent;
+
+  if ((FPicture.Width = 0) or (FPicture.Height = 0)) and
+      FImageBitmap.Empty then exit;
+
   try
-    // Quality
-    image.ResampleFilter := FQuality;
-    BGRAReplace(image, image.Resample(Width, Height));
+    if FImageBitmap.Empty
+    then image := TBGRABitmap.Create(FPicture.Bitmap)
+    else image := TBGRABitmap.Create(FImageBitmap.Bitmap);
+
+    imageD:= TBGRABitmap.Create(Width, Height, BGRAPixelTransparent);
+
+    if FProportional
+    then imgRect:= CalcProportionalRect(Width, Height, image.Width, image.Height,
+                                        FAlignment, FVerticalAlignment)
+    else begin
+           if FStretch
+           then imgRect:= Rect(0,0,Width,Height)
+           else begin
+                  case FAlignment of
+                  taLeftJustify: imgRect.Left:= 0;
+                  taCenter: imgRect.Left:= (Width-image.Width) div 2;
+                  taRightJustify: imgRect.Left:= Width-image.Width;
+                  end;
+                  case FVerticalAlignment of
+                  tlTop: imgRect.Top:= 0;
+                  tlCenter: imgRect.Top:= (Height-image.Height) div 2;
+                  tlBottom: imgRect.Top:= Height-image.Height;
+                  end;
+
+                  imgRect.Right:= imgRect.Left+image.Width;
+                  imgRect.Bottom:= imgRect.Top+image.Height;
+                end;
+         end;
+
+    if FStretch or FProportional then
+    begin
+      // Stretch with Quality
+      image.ResampleFilter := FQuality;
+      BGRAReplace(image, image.Resample(imgRect.Width, imgRect.Height));
+    end;
+
+    imageD.PutImage(imgRect.Left, imgRect.Top, image, dmDrawWithTransparency);
+
     // Style
     case FStyle of
-      isCircle: bgra.FillEllipseAntialias(Width div 2, Height div 2,
-          Width div 2, Height div 2, image);
-      // Rounding, BorderStyle
-      isRoundedRectangle: bgra.FillRoundRectAntialias(0, 0, Width,
-          Height, FRounding, FRounding, image, FBorderStyle);
-      else
-        bgra.PutImage(0, 0, image, dmDrawWithTransparency);
+    isCircle: ABitmap.FillEllipseAntialias(Width div 2, Height div 2,
+                          (Width div 2)-FRounding, (Height div 2)-FRounding, imageD);
+    isRoundedRectangle: ABitmap.FillRoundRectAntialias(0, 0, Width,
+                                    Height, FRounding, FRounding, imageD, FBorderStyle);
+    else ABitmap.PutImage(0, 0, imageD, dmDrawWithTransparency);
     end;
-    // OnPaintEvent
-    if Assigned(FOnPaintEvent) then
-      FOnPaintEvent(Self, bgra);
-    bgra.Draw(Canvas, 0, 0, False);
+
   finally
-    bgra.Free;
+    imageD.Free;
     image.Free;
   end;
 end;

bcstylesform.pas

@@ -16,7 +16,10 @@ unit BCStylesForm;
 interface
 
 uses
-  Classes, SysUtils, {$IFDEF FPC}FileUtil, ComponentEditors, PropEdits,{$ELSE}
+  Classes, SysUtils,
+  {$IFDEF FPC}
+  FileUtil, ComponentEditors, PropEdits, LazVersion,
+  {$ELSE}
   Windows, DesignIntf, DesignEditors, PropertyCategories,
   ToolIntf, ExptIntf, DesignWindows,
   {$ENDIF}
@@ -392,11 +395,18 @@ constructor TBCfrmStyle.Create(AControl: TControl;
   {$IFDEF FPC}//#
   function _LoadImage(AIdx: Integer; const AName: String): Integer;
   begin
+    {$if laz_fullversion<4990000}
     Result := IDEImages.GetImageIndex(AIdx,AName);
     if Result=-1 then
       Result := IDEImages.LoadImage(AIdx,AName);
+    {$else}
+    Result := IDEImages.GetImageIndex(AName,AIdx);
+    if Result=-1 then
+      Result := IDEImages.LoadImage(AName,AIdx);
+    {$endif}
   end;
   {$ENDIF}
+
 begin
   inherited Create(Application);
 

bctrackbarupdown.pas

@@ -296,7 +296,7 @@ begin
   FEmptyText:= false;
   DoSelectAll;
   Invalidate;
-  NotifyChange;
+  if not (csLoading in ComponentState) then NotifyChange;
 end;
 
 procedure TCustomBCTrackbarUpdown.SetArrowColor(AValue: TColor);

bgracontrols.logic

@@ -1,5 +1,6 @@
+cd ($LogicDir)
 manager update_bgracontrols_force.json
-archive https://github.com/bgrabitmap/bgracontrols/archive/master.zip
+archive https://github.com/bgrabitmap/bgracontrols/archive/v$(Version).zip
 package bgracontrols.lpk
 package bgrapascalscriptcomponent.lpk
 const bgracontrolsinfo.pas BGRAControlsVersion

bgracontrols.lpk

@@ -21,7 +21,7 @@
       </Parsing>
       <CodeGeneration>
         <Optimizations>
-          <OptimizationLevel Value="0"/>
+          <OptimizationLevel Value="2"/>
           <VariablesInRegisters Value="True"/>
         </Optimizations>
       </CodeGeneration>
@@ -33,8 +33,8 @@
     </CompilerOptions>
     <Description Value="BGRA Controls is a set of graphical UI elements that you can use with Lazarus LCL applications."/>
     <License Value="Modified LGPL"/>
-    <Version Major="9" Release="1" Build="6"/>
-    <Files Count="79">
+    <Version Major="9" Release="1" Build="7"/>
+    <Files Count="81">
       <Item1>
         <Filename Value="atshapelinebgra.pas"/>
         <HasRegisterProc Value="True"/>
@@ -72,7 +72,6 @@
       </Item7>
       <Item8>
         <Filename Value="bcdefaultthememanager.pas"/>
-        <AddToUsesPkgSection Value="False"/>
         <UnitName Value="BCDefaultThemeManager"/>
       </Item8>
       <Item9>
@@ -115,7 +114,6 @@
       </Item16>
       <Item17>
         <Filename Value="bckeyboard.pas"/>
-        <AddToUsesPkgSection Value="False"/>
         <UnitName Value="BCKeyboard"/>
       </Item17>
       <Item18>
@@ -249,185 +247,195 @@
         <UnitName Value="BGRACustomDrawn"/>
       </Item44>
       <Item45>
-        <Filename Value="bgradrawerflashprogressbar.pas"/>
-        <UnitName Value="BGRADrawerFlashProgressBar"/>
-      </Item45>
-      <Item46>
         <Filename Value="bgraflashprogressbar.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAFlashProgressBar"/>
-      </Item46>
-      <Item47>
+      </Item45>
+      <Item46>
         <Filename Value="bgragraphiccontrol.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAGraphicControl"/>
-      </Item47>
-      <Item48>
+      </Item46>
+      <Item47>
         <Filename Value="bgraimagelist.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAImageList"/>
-      </Item48>
-      <Item49>
+      </Item47>
+      <Item48>
         <Filename Value="bgraimagemanipulation.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAImageManipulation"/>
-      </Item49>
-      <Item50>
+      </Item48>
+      <Item49>
         <Filename Value="bgraimagetheme.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAImageTheme"/>
-      </Item50>
-      <Item51>
+      </Item49>
+      <Item50>
         <Filename Value="bgraknob.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAKnob"/>
-      </Item51>
-      <Item52>
+      </Item50>
+      <Item51>
         <Filename Value="bgraresizespeedbutton.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAResizeSpeedButton"/>
-      </Item52>
-      <Item53>
+      </Item51>
+      <Item52>
         <Filename Value="bgrashape.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAShape"/>
-      </Item53>
-      <Item54>
+      </Item52>
+      <Item53>
         <Filename Value="bgraspeedbutton.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRASpeedButton"/>
-      </Item54>
-      <Item55>
+      </Item53>
+      <Item54>
         <Filename Value="bgraspriteanimation.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRASpriteAnimation"/>
-      </Item55>
-      <Item56>
+      </Item54>
+      <Item55>
         <Filename Value="bgrasvgimagelist.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRASVGImageList"/>
-      </Item56>
-      <Item57>
+      </Item55>
+      <Item56>
         <Filename Value="bgrasvgtheme.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRASVGTheme"/>
-      </Item57>
-      <Item58>
+      </Item56>
+      <Item57>
         <Filename Value="bgratheme.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRATheme"/>
-      </Item58>
-      <Item59>
+      </Item57>
+      <Item58>
         <Filename Value="bgrathemebutton.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAThemeButton"/>
-      </Item59>
-      <Item60>
+      </Item58>
+      <Item59>
         <Filename Value="bgrathemecheckbox.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAThemeCheckBox"/>
-      </Item60>
-      <Item61>
+      </Item59>
+      <Item60>
         <Filename Value="bgrathemeradiobutton.pas"/>
         <HasRegisterProc Value="True"/>
         <AddToUsesPkgSection Value="False"/>
         <UnitName Value="BGRAThemeRadioButton"/>
-      </Item61>
-      <Item62>
+      </Item60>
+      <Item61>
         <Filename Value="bgravirtualscreen.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRAVirtualScreen"/>
-      </Item62>
-      <Item63>
+      </Item61>
+      <Item62>
         <Filename Value="colorspeedbutton.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="ColorSpeedButton"/>
-      </Item63>
-      <Item64>
+      </Item62>
+      <Item63>
         <Filename Value="dtanalogclock.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="DTAnalogClock"/>
-      </Item64>
-      <Item65>
+      </Item63>
+      <Item64>
         <Filename Value="dtanalogcommon.pas"/>
         <UnitName Value="DTAnalogCommon"/>
-      </Item65>
-      <Item66>
+      </Item64>
+      <Item65>
         <Filename Value="dtanaloggauge.pas"/>
         <HasRegisterProc Value="True"/>
         <AddToUsesPkgSection Value="False"/>
         <UnitName Value="DTAnalogGauge"/>
-      </Item66>
-      <Item67>
+      </Item65>
+      <Item66>
         <Filename Value="dtthemedclock.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="dtthemedclock"/>
-      </Item67>
-      <Item68>
+      </Item66>
+      <Item67>
         <Filename Value="dtthemedgauge.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="dtthemedgauge"/>
-      </Item68>
-      <Item69>
+      </Item67>
+      <Item68>
         <Filename Value="materialcolors.pas"/>
         <UnitName Value="MaterialColors"/>
-      </Item69>
-      <Item70>
+      </Item68>
+      <Item69>
         <Filename Value="bgrasvgimagelistform/bgrasvgimagelistform.pas"/>
         <UnitName Value="bgrasvgimagelistform"/>
-      </Item70>
-      <Item71>
+      </Item69>
+      <Item70>
         <Filename Value="bclealcddisplay.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCLeaLCDDisplay"/>
-      </Item71>
-      <Item72>
+      </Item70>
+      <Item71>
         <Filename Value="bclealed.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCLeaLED"/>
-      </Item72>
-      <Item73>
+      </Item71>
+      <Item72>
         <Filename Value="bcleaqled.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCLeaQLED"/>
-      </Item73>
-      <Item74>
+      </Item72>
+      <Item73>
         <Filename Value="bclearingslider.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCLeaRingSlider"/>
-      </Item74>
-      <Item75>
+      </Item73>
+      <Item74>
         <Filename Value="bcleaselector.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCLeaSelector"/>
-      </Item75>
-      <Item76>
+      </Item74>
+      <Item75>
         <Filename Value="bcleatheme.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCLeaTheme"/>
-      </Item76>
-      <Item77>
+      </Item75>
+      <Item76>
         <Filename Value="bclealcddisplay_editorregister.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCLeaLCDDisplay_EditorRegister"/>
-      </Item77>
-      <Item78>
+      </Item76>
+      <Item77>
         <Filename Value="bcleaboard.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCLeaBoard"/>
-      </Item78>
-      <Item79>
+      </Item77>
+      <Item78>
         <Filename Value="bcleaengrave.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCLeaEngrave"/>
+      </Item78>
+      <Item79>
+        <Filename Value="supergauge.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="supergauge"/>
       </Item79>
+      <Item80>
+        <Filename Value="supergaugecommon.pas"/>
+        <UnitName Value="supergaugecommon"/>
+      </Item80>
+      <Item81>
+        <Filename Value="bgradialogs.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="BGRADialogs"/>
+      </Item81>
     </Files>
     <CompatibilityMode Value="True"/>
     <LazDoc Paths="fpdoc"/>
     <RequiredPkgs Count="2">
       <Item1>
         <PackageName Value="BGRABitmapPack"/>
-        <MinVersion Major="11" Minor="5" Release="5" Valid="True"/>
+        <MinVersion Major="11" Minor="6" Release="4" Valid="True"/>
       </Item1>
       <Item2>
         <PackageName Value="IDEIntf"/>

bgracontrols.pas

@@ -9,23 +9,23 @@ interface
 
 uses
   atshapelinebgra, BCButton, BCButtonFocus, BCCheckComboBox, BCComboBox, 
-  BCEffect, BCExpandPanels, bcfilters, BCFluentProgressRing, BCFluentSlider, 
-  BCGameGrid, BCGradientButton, BCImageButton, BCLabel, BCListBox, 
-  BCListBoxEx, BCMaterialDesignButton, BCMaterialEdit, 
-  BCMaterialFloatSpinEdit, BCMaterialProgressBarMarquee, BCMaterialSpinEdit, 
-  BCMDButton, BCMDButtonFocus, BCPanel, BCRadialProgressBar, BCRoundedImage, 
-  BCRTTI, BCSamples, BCStylesForm, BCSVGButton, BCSVGViewer, BCToolBar, 
+  BCDefaultThemeManager, BCEffect, BCExpandPanels, bcfilters, 
+  BCFluentProgressRing, BCFluentSlider, BCGameGrid, BCGradientButton, 
+  BCImageButton, BCKeyboard, BCLabel, BCListBox, BCListBoxEx, 
+  BCMaterialDesignButton, BCMaterialEdit, BCMaterialFloatSpinEdit, 
+  BCMaterialProgressBarMarquee, BCMaterialSpinEdit, BCMDButton, 
+  BCMDButtonFocus, BCPanel, BCRadialProgressBar, BCRoundedImage, BCRTTI, 
+  BCSamples, BCStylesForm, BCSVGButton, BCSVGViewer, BCToolBar, 
   BCTrackbarUpdown, BGRAColorTheme, bgracontrolsinfo, BGRACustomDrawn, 
-  BGRADrawerFlashProgressBar, BGRAFlashProgressBar, BGRAGraphicControl, 
-  BGRAImageList, BGRAImageManipulation, BGRAImageTheme, BGRAKnob, 
-  BGRAResizeSpeedButton, BGRAShape, BGRASpeedButton, BGRASpriteAnimation, 
-  BGRASVGImageList, BGRASVGTheme, BGRATheme, BGRAThemeButton, 
-  BGRAThemeCheckBox, BGRAThemeRadioButton, BGRAVirtualScreen, 
-  ColorSpeedButton, DTAnalogClock, DTAnalogCommon, DTAnalogGauge, 
-  dtthemedclock, dtthemedgauge, MaterialColors, bgrasvgimagelistform, 
-  BCLeaLCDDisplay, BCLeaLED, BCLeaQLED, BCLeaRingSlider, BCLeaSelector, 
-  BCLeaTheme, BCLeaLCDDisplay_EditorRegister, BCLeaBoard, BCLeaEngrave, 
-  LazarusPackageIntf;
+  BGRAFlashProgressBar, BGRAGraphicControl, BGRAImageList, 
+  BGRAImageManipulation, BGRAImageTheme, BGRAKnob, BGRAResizeSpeedButton, 
+  BGRAShape, BGRASpeedButton, BGRASpriteAnimation, BGRASVGImageList, 
+  BGRASVGTheme, BGRATheme, BGRAThemeButton, BGRAThemeCheckBox, 
+  BGRAThemeRadioButton, BGRAVirtualScreen, ColorSpeedButton, DTAnalogClock, 
+  DTAnalogCommon, DTAnalogGauge, dtthemedclock, dtthemedgauge, MaterialColors, 
+  bgrasvgimagelistform, BCLeaLCDDisplay, BCLeaLED, BCLeaQLED, BCLeaRingSlider, 
+  BCLeaSelector, BCLeaTheme, BCLeaLCDDisplay_EditorRegister, BCLeaBoard, 
+  BCLeaEngrave, supergauge, supergaugecommon, BGRADialogs, LazarusPackageIntf;
 
 implementation
 
@@ -93,6 +93,8 @@ begin
     @BCLeaLCDDisplay_EditorRegister.Register);
   RegisterUnit('BCLeaBoard', @BCLeaBoard.Register);
   RegisterUnit('BCLeaEngrave', @BCLeaEngrave.Register);
+  RegisterUnit('supergauge', @supergauge.Register);
+  RegisterUnit('BGRADialogs', @BGRADialogs.Register);
 end;
 
 initialization

bgracontrolsinfo.pas

@@ -9,7 +9,7 @@ uses
   Classes, SysUtils;
 
 const
-  BGRAControlsVersion = 9000106;
+  BGRAControlsVersion = 9000107;
 
   function BGRAControlsVersionStr: string;
 

bgradialogs.pas

@@ -0,0 +1,393 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+{
+  Additional dialogs to take advantage of our controls
+
+  2025-01 Massimo Magnano
+}
+unit BGRADialogs;
+
+{$mode objfpc}{$H+}
+
+{$ifdef WINDOWS}
+  //{$define Show_PreviewControl}  //THIS IS JUST FOR TESTING, It is not recommended for now under Windows
+{$endif}
+
+interface
+
+uses
+  {$ifdef Show_PreviewControl}
+  Windows, Graphics,
+  {$endif}
+  Classes, SysUtils, ExtDlgs, Controls, StdCtrls, ExtCtrls,
+  BGRABitmapTypes, BCRoundedImage;
+
+resourcestring
+  rsSelectAPreviewFile = 'Select the File to preview';
+
+type
+
+  { TBGRAOpenPictureDialog }
+
+  TBGRAOpenPictureDialog = class(TPreviewFileDialog)
+   private
+    FDefaultFilter: string;
+    FImageCtrl: TBCRoundedImage;
+    FPicturePanel: TPanel;
+    FPictureDetails: TLabel;
+    FPreviewFilename: string;
+
+  protected
+    {$ifdef Show_PreviewControl}
+    DialogWnd,
+    pParentWnd, pBrotherWnd : HWnd;
+    {$endif}
+
+    class procedure WSRegisterClass; override;
+    function  IsFilterStored: Boolean; virtual;
+    procedure InitPreviewControl; override;
+    procedure ClearPreview; virtual;
+    procedure UpdatePreview; virtual;
+
+    {$ifdef Show_PreviewControl}
+    procedure GetDialogWnd;
+    procedure ResizePreviewControl;
+    {$endif}
+
+    property ImageCtrl: TBCRoundedImage read FImageCtrl;
+    property PicturePanel: TPanel read FPicturePanel;
+    property PictureDetails: TLabel read FPictureDetails;
+
+  public
+    constructor Create(TheOwner: TComponent); override;
+    procedure DoClose; override;
+    procedure DoSelectionChange; override;
+    procedure DoShow; override;
+    function GetFilterExt: String;
+    property DefaultFilter: string read FDefaultFilter;
+  published
+    property Filter stored IsFilterStored;
+  end;
+
+  { TSavePictureDialog }
+
+  TBGRASavePictureDialog = class(TBGRAOpenPictureDialog)
+  protected
+    class procedure WSRegisterClass; override;
+    function DefaultTitle: string; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+  end;
+
+
+//Functions to Get Filters String useful in Dialogs
+function GetBGRAFormatFilter(AFormat: TBGRAImageFormat): String;
+procedure BuildBGRAFilterStrings(AUseReaders: Boolean; var Descriptions, Filters: String);
+function BuildBGRAImageReaderFilter: String;
+function BuildBGRAImageWriterFilter: String;
+
+procedure Register;
+
+implementation
+
+uses
+  WSExtDlgs, Masks, FileUtil, LazFileUtils, LCLStrConsts, LCLType;
+
+function GetBGRAFormatFilter(AFormat: TBGRAImageFormat): String;
+begin
+  Result := StringReplace('*.' + BGRAImageFormat[AFormat].Extensions, ';', ';*.', [rfReplaceAll]);
+end;
+
+procedure BuildBGRAFilterStrings(AUseReaders: Boolean; var Descriptions, Filters: String);
+var
+  iFormat: TBGRAImageFormat;
+  Filter: String;
+  addExt: Boolean;
+
+begin
+  Descriptions := '';
+  Filters := '';
+
+  for iFormat:=Low(TBGRAImageFormat) to High(TBGRAImageFormat) do
+  begin
+    if AUseReaders
+    then addExt:= (iFormat<>ifUnknown) and (DefaultBGRAImageReader[iFormat] <> nil)
+    else addExt:= (iFormat<>ifUnknown) and (DefaultBGRAImageWriter[iFormat] <> nil);
+
+    if addExt then
+    begin
+      if (iFormat>ifJpeg) then
+      begin
+        Descriptions := Descriptions + '|';
+        Filters := Filters + ';';
+      end;
+
+      Filter := GetBGRAFormatFilter(iFormat);
+      FmtStr(Descriptions, '%s%s (%s)|%s',
+            [Descriptions, BGRAImageFormat[iFormat].TypeName, Filter, Filter]);
+      FmtStr(Filters, '%s%s', [Filters, Filter]);
+    end;
+  end;
+
+  FmtStr(Descriptions, '%s (%s)|%1:s|%s', [rsGraphic, Filters, Descriptions]);
+end;
+
+
+function BuildBGRAImageReaderFilter: String;
+var
+  Filters: string;
+
+begin
+  Result := '';
+  BuildBGRAFilterStrings(True, Result, Filters);
+end;
+
+function BuildBGRAImageWriterFilter: String;
+var
+  Filters: string;
+
+begin
+  Result := '';
+  BuildBGRAFilterStrings(False, Result, Filters);
+end;
+
+{ TBGRAOpenPictureDialog }
+
+class procedure TBGRAOpenPictureDialog.WSRegisterClass;
+begin
+  inherited WSRegisterClass;
+  RegisterOpenPictureDialog;
+end;
+
+function TBGRAOpenPictureDialog.IsFilterStored: Boolean;
+begin
+  Result := (Filter<>FDefaultFilter);
+end;
+
+procedure TBGRAOpenPictureDialog.DoClose;
+begin
+  inherited DoClose;
+//  PreviewFileControl.ParentWindow:=0;
+end;
+
+procedure TBGRAOpenPictureDialog.DoSelectionChange;
+begin
+  UpdatePreview;
+  inherited DoSelectionChange;
+end;
+
+procedure TBGRAOpenPictureDialog.DoShow;
+begin
+  ClearPreview;
+  inherited DoShow;
+end;
+
+procedure TBGRAOpenPictureDialog.InitPreviewControl;
+begin
+  inherited InitPreviewControl;
+
+  PreviewFileControl.Width:=300;
+  PreviewFileControl.Height:=300;
+  FPicturePanel.Parent:=PreviewFileControl;
+  FPicturePanel.Align:=alClient;
+  { #note -oMaxM : We create it here because the LCL assumes there is a groupbox
+                   with only an image inside and crashes if it find it before this point }
+  FPictureDetails:=TLabel.Create(Self);
+    with FPictureDetails do begin
+      Name:='FPictureDetails';
+      Parent:= FPicturePanel;
+      Top:=PreviewFileControl.Height-20;
+      Height:=20;
+      Width:=PreviewFileControl.Width;
+      Align:=alBottom;
+      Caption:='';
+    end;
+
+  FImageCtrl.Align:=alClient;
+end;
+
+procedure TBGRAOpenPictureDialog.ClearPreview;
+begin
+  FPicturePanel.VerticalAlignment:=taVerticalCenter;
+  FPicturePanel.Caption:= rsSelectAPreviewFile;
+  FImageCtrl.Bitmap:=nil;
+  FImageCtrl.Visible:= False;
+  FPictureDetails.Caption:='';
+end;
+
+procedure TBGRAOpenPictureDialog.UpdatePreview;
+var
+  CurFilename: String;
+  FileIsValid: boolean;
+
+begin
+  {$ifdef Show_PreviewControl}
+  if (DialogWnd = 0) then GetDialogWnd;
+  ResizePreviewControl;
+  {$endif}
+
+  FPicturePanel.Caption:= '';
+  FPictureDetails.Caption:='';
+
+  CurFilename := FileName;
+  if CurFilename = FPreviewFilename then exit;
+
+  FPreviewFilename := CurFilename;
+  FileIsValid := FileExistsUTF8(FPreviewFilename)
+                 and (not DirPathExists(FPreviewFilename))
+                 and FileIsReadable(FPreviewFilename);
+  if FileIsValid then
+    try
+      FImageCtrl.Bitmap.LoadFromFile(FPreviewFilename);
+      FImageCtrl.Visible:= True;
+      FImageCtrl.Invalidate; { #todo -oMaxM : an event in TBGRBitmap might be useful }
+
+      FPictureDetails.Caption:= Format('%d x %d x %d dpi', [FImageCtrl.Bitmap.Width, FImageCtrl.Bitmap.Height, Trunc(FImageCtrl.Bitmap.ResolutionX)]);
+    except
+      FileIsValid := False;
+    end;
+  if not FileIsValid then ClearPreview;
+end;
+
+{$ifdef Show_PreviewControl}
+procedure TBGRAOpenPictureDialog.GetDialogWnd;
+var
+  pHandle: HWND;
+  thID, prID, appID:DWord;
+
+begin
+  pBrotherWnd:= 0;
+  pParentWnd:= 0;
+
+  //LCL doesn't pass us the Dialog Handle, so we have to look for it the old fashioned way
+  appID:= GetProcessId;
+  repeat
+    DialogWnd:= FindWindowEx(0, DialogWnd, PChar('#32770'), nil);
+    thID:= GetWindowThreadProcessId(DialogWnd, prID);
+  until (DialogWnd=0) or (prID = appID);
+
+  //Get Parent and Brother Control
+  //  this depends on the OS and needs to be tested as much as possible (for now it works with Windows 10)
+  if (DialogWnd<>0) then
+  begin
+    pHandle:= FindWindowEx(DialogWnd, 0, PChar('DUIViewWndClassName'), nil);
+    if (pHandle<>0) then  //Windows 10
+    begin
+      pParentWnd:= FindWindowEx(pHandle, 0, PChar('DirectUIHWND'), nil);
+      if (pParentWnd<>0) then
+      begin
+        repeat
+          pBrotherWnd:= FindWindowEx(pParentWnd, pBrotherWnd, PChar('CtrlNotifySink'), nil);
+          pHandle:= FindWindowEx(pBrotherWnd, 0, PChar('SHELLDLL_DefView'), nil);
+        until (pBrotherWnd=0) or (pHandle<>0);
+
+        if (pBrotherWnd<>0) and (pHandle<>0) then PreviewFileControl.ParentWindow:=pParentWnd;
+      end;
+    end;
+  end;
+end;
+
+procedure TBGRAOpenPictureDialog.ResizePreviewControl;
+var
+  rectParent, rectBrother: TRect;
+
+begin
+  if (DialogWnd<>0) and (pParentWnd<>0) and (pBrotherWnd<>0) then
+  begin
+    if GetClientRect(pParentWnd, rectParent) and GetWindowRect(pBrotherWnd, rectBrother) then
+    begin
+      ScreenToClient(pParentWnd, rectBrother.TopLeft);
+      ScreenToClient(pParentWnd, rectBrother.BottomRight);
+      PreviewFileControl.SetBounds(rectBrother.Left+4+rectBrother.Width, rectBrother.Top+4,
+                                   rectParent.Right-rectBrother.Right-8,
+                                   rectParent.Bottom-rectBrother.Top-8);
+    end;
+  end;
+end;
+{$endif}
+
+constructor TBGRAOpenPictureDialog.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  FDefaultFilter := BuildBGRAImageReaderFilter+'|'+
+                    Format(rsAllFiles,[GetAllFilesMask, GetAllFilesMask,'']);
+  Filter:=FDefaultFilter;
+
+  {$ifdef Show_PreviewControl}
+  DialogWnd:= 0;
+  pBrotherWnd:= 0;
+  pParentWnd:= 0;
+  {$endif}
+
+  FPicturePanel:=TPanel.Create(Self);
+  with FPicturePanel do begin
+    Name:='FPicturePanel';
+    BorderStyle:=bsNone;
+    BevelOuter:=bvNone;
+    VerticalAlignment:=taVerticalCenter;
+  end;
+
+  FImageCtrl:=TBCRoundedImage.Create(Self);
+  with FImageCtrl do begin
+    Name:='FImageCtrl';
+    Parent:=FPicturePanel;
+    Style:=isSquare;
+    Proportional:=true;
+  end;
+end;
+
+function TBGRAOpenPictureDialog.GetFilterExt: String;
+var
+  ParsedFilter: TParseStringList;
+begin
+  Result := '';
+
+  ParsedFilter := TParseStringList.Create(Filter, '|');
+  try
+    if (FilterIndex > 0) and (FilterIndex * 2 <= ParsedFilter.Count) then
+    begin
+      Result := AnsiLowerCase(ParsedFilter[FilterIndex * 2 - 1]);
+      // remove *.*
+      if (Result <> '') and (Result[1] = '*') then Delete(Result, 1, 1);
+      if (Result <> '') and (Result[1] = '.') then Delete(Result, 1, 1);
+      if (Result <> '') and (Result[1] = '*') then Delete(Result, 1, 1);
+      // remove all after ;
+      if Pos(';', Result) > 0 then Delete(Result, Pos(';', Result), MaxInt);
+    end;
+
+    if Result = '' then Result := DefaultExt;
+  finally
+    ParsedFilter.Free;
+  end;
+end;
+
+{ TSavePictureDialog }
+
+class procedure TBGRASavePictureDialog.WSRegisterClass;
+begin
+  inherited WSRegisterClass;
+  RegisterSavePictureDialog;
+end;
+
+function TBGRASavePictureDialog.DefaultTitle: string;
+begin
+  Result := rsfdFileSaveAs;
+end;
+
+constructor TBGRASavePictureDialog.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  FDefaultFilter := BuildBGRAImageWriterFilter+'|'+
+                    Format(rsAllFiles,[GetAllFilesMask, GetAllFilesMask,'']);
+  Filter:=FDefaultFilter;
+
+  fCompStyle:=csSaveFileDialog;
+end;
+
+procedure Register;
+begin
+  RegisterComponents('BGRA Dialogs',[TBGRAOpenPictureDialog, TBGRASavePictureDialog]);
+end;
+
+
+end.
+

bgradrawerflashprogressbar.pas

@@ -1,226 +0,0 @@
-unit BGRADrawerFlashProgressBar;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, {$IFDEF BGRABITMAP_USE_MSEGUI} mclasses, {$ENDIF} SysUtils, Types, BGRABitmap, BGRABitmapTypes, BGRAGraphics, BGRAGradients,
-  Math;
-
-type
-
-  TBGRAProgressBarRedrawEvent = procedure(Sender: TObject; Bitmap: TBGRABitmap; xpos: integer) of object;
-
-  { TBGRADrawerFlashProgressBar }
-
-  TBGRADrawerFlashProgressBar = class(TPersistent)
-  private
-    FBackgroundColor: TColor;
-    FBackgroundRandomize: boolean;
-    FBackgroundRandomizeMaxIntensity: word;
-    FBackgroundRandomizeMinIntensity: word;
-    FBarColor: TColor;
-    FMaxValue: integer;
-    FMinValue: integer;
-    FOnChange: TNotifyEvent;
-    FRandSeed: integer;
-    FValue: integer;
-    xpos: integer;
-    procedure SetBackgroundRandomize(AValue: boolean);
-    procedure SetBackgroundRandomizeMaxIntensity(AValue: word);
-    procedure SetBackgroundRandomizeMinIntensity(AValue: word);
-    procedure SetBarColor(AValue: TColor);
-    procedure SetBackgroundColor(AValue: TColor);
-    procedure SetMaxValue(AValue: integer);
-    procedure SetMinValue(AValue: integer);
-    procedure SetRandSeed(AValue: integer);
-    procedure SetValue(AValue: integer);
-  public
-    procedure Draw(ABitmap: TBGRABitmap);
-  public
-    property OnChange: TNotifyEvent read FOnChange write FOnChange;
-    property RandSeed: integer read FRandSeed write SetRandSeed;
-    property BarColor: TColor read FBarColor write SetBarColor;
-    property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor;
-    property BackgroundRandomizeMinIntensity: word
-      read FBackgroundRandomizeMinIntensity write SetBackgroundRandomizeMinIntensity;
-    property BackgroundRandomizeMaxIntensity: word
-      read FBackgroundRandomizeMaxIntensity write SetBackgroundRandomizeMaxIntensity;
-    property BackgroundRandomize: boolean read FBackgroundRandomize
-      write SetBackgroundRandomize;
-    property XPosition: integer read xpos;
-  public
-    property MinValue: integer read FMinValue write SetMinValue;
-    property MaxValue: integer read FMaxValue write SetMaxValue;
-    property Value: integer read FValue write SetValue;
-  end;
-
-implementation
-
-{ TBGRADrawerFlashProgressBar }
-
-procedure TBGRADrawerFlashProgressBar.SetBarColor(AValue: TColor);
-begin
-  if FBarColor = AValue then
-    Exit;
-  FBarColor := AValue;
-  if Assigned(FOnChange) then
-    FOnChange(Self);
-  if Assigned(FOnChange) then
-    FOnChange(Self);
-end;
-
-procedure TBGRADrawerFlashProgressBar.SetBackgroundRandomize(AValue: boolean);
-begin
-  if FBackgroundRandomize = AValue then
-    Exit;
-  FBackgroundRandomize := AValue;
-  if Assigned(FOnChange) then
-    FOnChange(Self);
-end;
-
-procedure TBGRADrawerFlashProgressBar.SetBackgroundRandomizeMaxIntensity(AValue: word);
-begin
-  if FBackgroundRandomizeMaxIntensity = AValue then
-    Exit;
-  FBackgroundRandomizeMaxIntensity := AValue;
-  if Assigned(FOnChange) then
-    FOnChange(Self);
-end;
-
-procedure TBGRADrawerFlashProgressBar.SetBackgroundRandomizeMinIntensity(AValue: word);
-begin
-  if FBackgroundRandomizeMinIntensity = AValue then
-    Exit;
-  FBackgroundRandomizeMinIntensity := AValue;
-  if Assigned(FOnChange) then
-    FOnChange(Self);
-end;
-
-procedure TBGRADrawerFlashProgressBar.SetBackgroundColor(AValue: TColor);
-begin
-  if FBackgroundColor = AValue then
-    Exit;
-  FBackgroundColor := AValue;
-  if Assigned(FOnChange) then
-    FOnChange(Self);
-end;
-
-procedure TBGRADrawerFlashProgressBar.SetMaxValue(AValue: integer);
-begin
-  if FMaxValue = AValue then
-    exit;
-  FMaxValue := AValue;
-  if FValue > FMaxValue then
-    FValue := FMaxValue;
-  if FMinValue > FMaxValue then
-    FMinValue := FMaxValue;
-  if Assigned(FOnChange) then
-    FOnChange(Self);
-end;
-
-procedure TBGRADrawerFlashProgressBar.SetMinValue(AValue: integer);
-begin
-  if FMinValue = AValue then
-    exit;
-  FMinValue := AValue;
-  if FValue < FMinValue then
-    FValue := FMinValue;
-  if FMaxValue < FMinValue then
-    FMaxValue := FMinValue;
-  if Assigned(FOnChange) then
-    FOnChange(Self);
-end;
-
-procedure TBGRADrawerFlashProgressBar.SetRandSeed(AValue: integer);
-begin
-  if FRandSeed = AValue then
-    Exit;
-  FRandSeed := AValue;
-end;
-
-procedure TBGRADrawerFlashProgressBar.SetValue(AValue: integer);
-begin
-  if FValue = AValue then
-    exit;
-  FValue := AValue;
-  if FValue < FMinValue then
-    FValue := FMinValue;
-  if FValue > FMaxValue then
-    FValue := FMaxValue;
-  if Assigned(FOnChange) then
-    FOnChange(Self);
-end;
-
-procedure TBGRADrawerFlashProgressBar.Draw(ABitmap: TBGRABitmap);
-var
-  content: TRect;
-  y, tx, ty: integer;
-  bgColor: TBGRAPixel;
-
-  function ApplyLightness(c: TBGRAPixel; lightness: word): TBGRAPixel;
-  begin
-    Result := GammaCompression(SetLightness(GammaExpansion(c), lightness));
-  end;
-
-  procedure DrawBar(bounds: TRect);
-  var
-    lCol: TBGRAPixel;
-  begin
-    lCol := BarColor;
-
-    DoubleGradientAlphaFill(ABitmap, bounds,
-      ApplyLightness(lCol, 37000), ApplyLightness(lCol, 29000),
-      ApplyLightness(lCol, 26000), ApplyLightness(lCol, 18000),
-      gdVertical, gdVertical, gdVertical, 0.53);
-
-    InflateRect(bounds, -1, -1);
-
-    DoubleGradientAlphaFill(ABitmap, bounds,
-      ApplyLightness(lCol, 28000), ApplyLightness(lCol, 22000),
-      ApplyLightness(lCol, 19000), ApplyLightness(lCol, 11000),
-      gdVertical, gdVertical, gdVertical, 0.53);
-  end;
-
-begin
-  ABitmap.FillTransparent;
-  tx := ABitmap.Width;
-  ty := ABitmap.Height;
-
-  ABitmap.Rectangle(0, 0, tx, ty, BGRA(255, 255, 255, 6), BackgroundColor, dmSet);
-  if (tx > 2) and (ty > 2) then
-    ABitmap.Rectangle(1, 1, tx - 1, ty - 1, BGRA(29, 29, 29), dmSet);
-
-  if (tx > 4) and (ty > 4) then
-  begin
-    content  := Rect(2, 2, tx - 2, ty - 2);
-    randseed := FRandSeed;
-    if BackgroundRandomize then
-    for y := content.Top to content.Bottom - 1 do
-    begin
-      bgColor := BackgroundColor;
-      bgColor.Intensity := RandomRange(BackgroundRandomizeMinIntensity, BackgroundRandomizeMaxIntensity);
-      ABitmap.HorizLine(content.Left, y, content.Right - 1, bgColor, dmSet);
-    end;
-    if tx >= 6 then
-      ABitmap.DrawVertLine(content.Right - 1, content.Top, content.Bottom - 1,
-        BGRA(0, 0, 0, 32));
-    if FMaxValue > FMinValue then
-    begin
-      xpos := round((FValue - FMinValue) / (FMaxValue - FMinValue) *
-        (content.right - content.left)) + content.left;
-      if xpos > content.left then
-      begin
-        DrawBar(rect(content.left, content.top, xpos, content.bottom));
-        if xpos < content.right then
-        begin
-          ABitmap.SetPixel(xpos, content.top, BGRA(62, 62, 62));
-          ABitmap.SetVertLine(xpos, content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
-        end;
-      end;
-    end;
-  end;
-end;
-
-end.

bgraflashprogressbar.pas

@@ -1,4 +1,3 @@
-// SPDX-License-Identifier: LGPL-3.0-linking-exception
 {
   Created by BGRA Controls Team
   Dibo, Circular, lainz (007) and contributors.
@@ -12,6 +11,18 @@
 - Edivando S. Santos Brasil | [email protected]
   (Compatibility with delphi VCL 11/2018)
 
+- Massimo Magnano
+    2024-12  Added Marquee and MultiProgress Style
+             Added Caption, CaptionShowPercent, CaptionShowPercentAlign, CaptionShowPercentDigits;
+             Changed Values to Double Type;
+             Deleted Unit BGRADrawerFlashProgressBar;
+             New Test with all Features
+             Added Timer Style
+    2025-01  Added Marquee Bounce and Stepit Method,
+             TimerPlayPause works also for Marquee (useful for debugging)
+             Added Graph Style and ShowDividers, Renamed MultiProgress properties
+             Added ShowBarAnimation
+    2025-02  Added use of Font.Color
 ***************************** END CONTRIBUTOR(S) *****************************}
 unit BGRAFlashProgressBar;
 
@@ -20,44 +31,138 @@ unit BGRAFlashProgressBar;
 interface
 
 uses
-  Classes, SysUtils, {$IFDEF FPC}LResources, LMessages,{$ENDIF} Forms, Controls, Graphics,
-  {$IFNDEF FPC}Messages, Windows, BGRAGraphics, GraphType, FPImage, {$ENDIF}
-  BCBaseCtrls, Dialogs, BGRABitmap, BGRADrawerFlashProgressBar;
+  Classes, {$IFDEF BGRABITMAP_USE_MSEGUI} mclasses, {$ENDIF}
+  SysUtils, Types, Forms, Controls, Graphics,
+  {$IFDEF FPC} LResources, LMessages,
+  {$ELSE} Messages, Windows, BGRAGraphics, GraphType, FPImage, {$ENDIF}
+  BCBaseCtrls, BGRABitmap, BGRABitmapTypes, BGRAGraphics, BGRAGradients,
+  Math, fptimer;
 
 type
+  TBGRAPBarStyle = (pbstNormal, pbstMultiProgress, pbstMarquee, pbstTimer, pbstGraph);
+  TBGRAPBarMarqueeDirection = (pbmdToRight, pbmdToLeft);
+  TBGRAPBarMarqueeSpeed = (pbmsSlow, pbmsMedium, pbmsFast);
+
+  TBGRAProgressBarRedrawEvent = procedure(Sender: TObject; Bitmap: TBGRABitmap; xpos: integer) of object;
+
   { TBGRAFlashProgressBar }
 
+  TGraphValue = record
+    XValue, YValue: Double;
+  end;
+  TGraphValues = array of TGraphValue;
+
   TBGRAFlashProgressBar = class(TBGRAGraphicCtrl)
   private
-    FBGRA: TBGRABitmap;
-    FDrawer: TBGRADrawerFlashProgressBar;
-    FOnRedraw: TBGRAProgressBarRedrawEvent;
-    function GetBackgroundColor: TColor;
-    function GetBackgroundRandomize: boolean;
-    function GetBackgroundRandomizeMaxIntensity: word;
-    function GetBackgroundRandomizeMinIntensity: word;
-    function GetBarColor: TColor;
-    function GetMaxValue: integer;
-    function GetMinValue: integer;
-    function GetValue: integer;
-    procedure OnChangeDrawer(Sender: TObject);
-    procedure SetBackgroundColor(AValue: TColor);
+    function GetMax: Integer;
+    function GetMin: Integer;
+    function GetPosition: Integer;
     procedure SetBackgroundRandomize(AValue: boolean);
     procedure SetBackgroundRandomizeMaxIntensity(AValue: word);
     procedure SetBackgroundRandomizeMinIntensity(AValue: word);
     procedure SetBarColor(AValue: TColor);
-    procedure SetMaxValue(const AValue: integer);
-    procedure SetMinValue(const AValue: integer);
-    procedure SetValue(const AValue: integer);
+    procedure SetBackgroundColor(AValue: TColor);
+    procedure SetBarColorSub(AValue: TColor);
+    procedure SetCaptionPercentDigits(AValue: Integer);
+    procedure SetCaptionPercentTimerFormat(AValue: String);
+    procedure SetCaptionShowPercent(AValue: Boolean);
+    procedure SetCaptionPercentAlign(AValue: TAlignment);
+    procedure SetCaptionPercentSubAlign(AValue: TAlignment);
+    procedure SetCaptionShowPercentSub(AValue: Boolean);
+    procedure SetGraphShowYLine(AValue: Boolean);
+    procedure SetGraphYLineAfter(AValue: String);
+    procedure SetGraphYLineCaption(AValue: String);
+    procedure SetGraphYLineDigits(AValue: Integer);
+    procedure SetMax(AValue: Integer);
+    procedure SetMin(AValue: Integer);
+    procedure SetPosition(AValue: Integer);
+    procedure SetShowBarAnimation(AValue: Boolean);
+    procedure SetShowDividers(AValue: Boolean);
+    procedure SetMarqueeBounce(AValue: Word);
+    procedure SetMarqueeDirection(AValue: TBGRAPBarMarqueeDirection);
+    procedure SetMarqueeSpeed(AValue: TBGRAPBarMarqueeSpeed);
+    procedure SetMarqueeWidth(AValue: Word);
+    procedure SetMaxValue(AValue: Double);
+    procedure SetMaxYValue(AValue: Double);
+    procedure SetMinValue(AValue: Double);
+    procedure SetMinYValue(AValue: Double);
+    procedure SetRandSeed(AValue: integer);
+    procedure SetGraphShowYDividers(AValue: Boolean);
+    procedure SetStyle(AValue: TBGRAPBarStyle);
+    procedure SetTimerInterval(AValue: Cardinal);
+    procedure SetValueSub(AValue: Double);
+
   protected
-    procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
-      WithThemeSpace: boolean); override;
+    FBGRA: TBGRABitmap;
+    FCaptionPercentDigits: Integer;
+    FCaptionPercentTimerFormat: String;
+    FCaptionShowPercent: Boolean;
+    FCaptionPercentAlign: TAlignment;
+    FCaptionPercentSubAlign: TAlignment;
+    FCaptionShowPercentSub: Boolean;
+    FMarqueeBounce: Word;
+    FOnRedraw: TBGRAProgressBarRedrawEvent;
+    FBackgroundColor: TColor;
+    FBackgroundRandomize: boolean;
+    FBackgroundRandomizeMaxIntensity: word;
+    FBackgroundRandomizeMinIntensity: word;
+    FShowDividers,
+    FGraphShowYDividers: Boolean;
+    FBarColor,
+    FBarColorSub: TColor;
+    FMarqueeDirection: TBGRAPBarMarqueeDirection;
+    FMarqueeSpeed: TBGRAPBarMarqueeSpeed;
+    FMarqueeWidth,
+    rMarqueeWidth: Word;
+    FOnTimerTimer: TNotifyEvent;
+    FTimerAutoRestart: Boolean;
+    FOnTimerEnd: TNotifyEvent;
+    FOnTimerStart: TNotifyEvent;
+    FTimerInterval: Cardinal;
+    FMaxValue,
+    FMinValue,
+    FMinYValue,
+    FMaxYValue,
+    FValue,
+    FValueSub: Double;
+    FOnChange: TNotifyEvent;
+    FRandSeed: integer;
+    FStyle: TBGRAPBarStyle;
+    FGraphShowYLine: Boolean;
+    FGraphYLineAfter: String;
+    FGraphYLineCaption: String;
+    FGraphYLineDigits: Integer;
+    FShowBarAnimation: Boolean;
+
+    xpos,
+    xposSub,
+    marqueeLeft,
+    marqueeRight,
+    marqueeCount,
+    marqueeBCount,
+    barAnimLeft: Integer;
+    marqueeWall,
+    marqueeBouncing: Boolean;
+    marqueeCurMode: TBGRAPBarMarqueeDirection;
+    internalTimer: TFPTimer;
+    closing: Boolean;
+    GraphValues: TGraphValues;  //array of Real Graph Values
+    GraphPoints: array of TPointF; //array of Calculated xpos and ypos
+
+    class function GetControlClassDefaultSize: TSize; override;
+    procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: boolean); override;
+    procedure DoOnResize; override;
     procedure WMEraseBkgnd(var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF}); message {$IFDEF FPC}LM_ERASEBKGND{$ELSE}WM_ERASEBKGND{$ENDIF};
     procedure Paint; override;
+    procedure Loaded; override;
+    procedure TextChanged; override;
+
+    procedure TimerOnTimer(Sender: TObject);
+
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
-  public
+
     { Streaming }
     {$IFDEF FPC}
     procedure SaveToFile(AFileName: string);
@@ -65,9 +170,76 @@ type
     procedure OnFindClass({%H-}Reader: TReader; const AClassName: string;
       var ComponentClass: TComponentClass);
     {$ENDIF}
+
+    procedure Draw(ABitmap: TBGRABitmap);
+
+    procedure SetValue(AValue: Double); overload;
+
+    //Set Current Value and it's Y Value in Graph Style
+    procedure SetValue(AValue, AYValue: Double); overload;
+
+    //Step It, if Style is pbstNormal then Inc/Dec Value,
+    //         if pbstMarquee then do next Animation Step (AIncrement is ignored)
+    //         if pbstTimer then Value is decremented of 100ms (AIncrement is ignored)
+    procedure StepIt(AIncrement: Double);
+
+    //Timer Restart applies only if Style is pbstTimer
+    procedure TimerReStart;
+    //Timer Play/Pause applies only if Style is pbstMarquee or pbstTimer
+    procedure TimerPlayPause;
+
+    //For Compatibility with TProgressBar code
+    property Position: Integer read GetPosition write SetPosition;
+    property Min: Integer read GetMin write SetMin;
+    property Max: Integer read GetMax write SetMax;
+
+    property XPosition: integer read xpos;
+    property XPositionSub: integer read xposSub;
+
   published
     property Align;
+    property BorderSpacing;
     property Anchors;
+    property Caption;
+    property CaptionShowPercent: Boolean read FCaptionShowPercent write SetCaptionShowPercent default False;
+    property CaptionPercentAlign: TAlignment read FCaptionPercentAlign write SetCaptionPercentAlign default taCenter;
+    property CaptionShowPercentSub: Boolean read FCaptionShowPercentSub write SetCaptionShowPercentSub default False;
+    property CaptionPercentSubAlign: TAlignment read FCaptionPercentSubAlign write SetCaptionPercentSubAlign default taLeftJustify;
+    property CaptionPercentDigits: Integer read FCaptionPercentDigits write SetCaptionPercentDigits default 0;
+    property CaptionPercentTimerFormat: String read FCaptionPercentTimerFormat write SetCaptionPercentTimerFormat;
+    property Font;
+    property ParentFont;
+    property MinValue: Double read FMinValue write SetMinValue;
+    property MaxValue: Double read FMaxValue write SetMaxValue;
+    property MinYValue: Double read FMinYValue write SetMinYValue;
+    property MaxYValue: Double read FMaxYValue write SetMaxYValue;
+    property Value: Double read FValue write SetValue;
+    property ValueSub: Double read FValueSub write SetValueSub;
+    property Color; deprecated 'User BarColor instead';
+    property RandSeed: integer read FRandSeed write SetRandSeed;
+    property BarColor: TColor read FBarColor write SetBarColor;
+    property BarColorSub: TColor read FBarColorSub write SetBarColorSub;
+    property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor;
+    property BackgroundRandomizeMinIntensity: Word read FBackgroundRandomizeMinIntensity write SetBackgroundRandomizeMinIntensity;
+    property BackgroundRandomizeMaxIntensity: Word read FBackgroundRandomizeMaxIntensity write SetBackgroundRandomizeMaxIntensity;
+    property BackgroundRandomize: Boolean read FBackgroundRandomize write SetBackgroundRandomize;
+    property ShowDividers: Boolean read FShowDividers write SetShowDividers default False;
+    property ShowBarAnimation: Boolean read FShowBarAnimation write SetShowBarAnimation default False;
+    property Style: TBGRAPBarStyle read FStyle write SetStyle default pbstNormal;
+    property MarqueeWidth: Word read FMarqueeWidth write SetMarqueeWidth default 0;
+    property MarqueeSpeed: TBGRAPBarMarqueeSpeed read FMarqueeSpeed write SetMarqueeSpeed default pbmsMedium;
+    property MarqueeDirection: TBGRAPBarMarqueeDirection read FMarqueeDirection write SetMarqueeDirection default pbmdToRight;
+    property MarqueeBounce: Word read FMarqueeBounce write SetMarqueeBounce;
+
+    property TimerInterval: Cardinal read FTimerInterval write SetTimerInterval default 100;
+    property TimerAutoRestart: Boolean read FTimerAutoRestart write FTimerAutoRestart default True;
+
+    property GraphShowYDividers: Boolean read FGraphShowYDividers write SetGraphShowYDividers default False;
+    property GraphShowYLine: Boolean read FGraphShowYLine write SetGraphShowYLine default False;
+    property GraphYLineCaption: String read FGraphYLineCaption write SetGraphYLineCaption;
+    property GraphYLineAfter: String read FGraphYLineAfter write SetGraphYLineAfter;
+    property GraphYLineDigits: Integer read FGraphYLineDigits write SetGraphYLineDigits default 0;
+
     property OnClick;
     property OnMouseDown;
     property OnMouseEnter;
@@ -77,23 +249,26 @@ type
     property OnMouseWheel;
     property OnMouseWheelUp;
     property OnMouseWheelDown;
-    property MinValue: integer Read GetMinValue Write SetMinValue;
-    property MaxValue: integer Read GetMaxValue Write SetMaxValue;
-    property Value: integer Read GetValue Write SetValue;
-    property Color; deprecated 'User BarColor instead';
-    property BarColor: TColor read GetBarColor write SetBarColor;
-    property BackgroundColor: TColor read GetBackgroundColor write SetBackgroundColor;
-    property BackgroundRandomizeMinIntensity: word read GetBackgroundRandomizeMinIntensity write SetBackgroundRandomizeMinIntensity;
-    property BackgroundRandomizeMaxIntensity: word read GetBackgroundRandomizeMaxIntensity write SetBackgroundRandomizeMaxIntensity;
-    property BackgroundRandomize: boolean read GetBackgroundRandomize write SetBackgroundRandomize;
-    property OnRedraw: TBGRAProgressBarRedrawEvent read FOnredraw write FOnRedraw;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property OnRedraw: TBGRAProgressBarRedrawEvent read FOnRedraw write FOnRedraw;
+    property OnTimerStart: TNotifyEvent read FOnTimerStart write FOnTimerStart;
+    property OnTimerEnd: TNotifyEvent read FOnTimerEnd write FOnTimerEnd;
+    property OnTimerTimer: TNotifyEvent read FOnTimerTimer write FOnTimerTimer;
   end;
 
 {$IFDEF FPC}procedure Register;{$ENDIF}
 
 implementation
 
-uses BGRABitmapTypes;
+uses DateUtils, BGRATextFX;
+
+const
+  BAR_ANIM_TIMER = 20;
+  BAR_ANIM_INC = 4;
+  MARQUEE_TIMER_SLOW = 50;
+  MARQUEE_TIMER_MED  = 20;
+  MARQUEE_TIMER_FAST = 10;
+  MARQUEE_INC = 2;
 
 {$IFDEF FPC}
 procedure Register;
@@ -102,36 +277,524 @@ begin
 end;
 {$ENDIF}
 
-procedure TBGRAFlashProgressBar.SetMinValue(const AValue: integer);
+{ TBGRAFlashProgressBar }
+
+procedure TBGRAFlashProgressBar.SetBarColor(AValue: TColor);
+begin
+  if FBarColor = AValue then exit;
+  FBarColor := AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+function TBGRAFlashProgressBar.GetMax: Integer;
 begin
-  FDrawer.MinValue := AValue;
+  Result:= Trunc(FMaxValue);
 end;
 
-procedure TBGRAFlashProgressBar.SetValue(const AValue: integer);
+function TBGRAFlashProgressBar.GetMin: Integer;
 begin
-  FDrawer.Value := AValue;
+  Result:= Trunc(FMinValue);
+end;
+
+function TBGRAFlashProgressBar.GetPosition: Integer;
+begin
+  Result:= Trunc(FValue);
+end;
+
+procedure TBGRAFlashProgressBar.SetBackgroundRandomize(AValue: boolean);
+begin
+  if FBackgroundRandomize = AValue then exit;
+  FBackgroundRandomize := AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetBackgroundRandomizeMaxIntensity(AValue: word);
+begin
+  if FBackgroundRandomizeMaxIntensity = AValue then exit;
+  FBackgroundRandomizeMaxIntensity := AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetBackgroundRandomizeMinIntensity(AValue: word);
+begin
+  if FBackgroundRandomizeMinIntensity = AValue then exit;
+  FBackgroundRandomizeMinIntensity := AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetBackgroundColor(AValue: TColor);
+begin
+  if FBackgroundColor = AValue then exit;
+  FBackgroundColor := AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetBarColorSub(AValue: TColor);
+begin
+  if FBarColorSub = AValue then exit;
+  FBarColorSub := AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetCaptionPercentDigits(AValue: Integer);
+begin
+  if FCaptionPercentDigits=AValue then Exit;
+  FCaptionPercentDigits:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetCaptionPercentTimerFormat(AValue: String);
+begin
+  if FCaptionPercentTimerFormat=AValue then Exit;
+  FCaptionPercentTimerFormat:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetCaptionShowPercent(AValue: Boolean);
+begin
+  if FCaptionShowPercent=AValue then Exit;
+  FCaptionShowPercent:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetCaptionPercentAlign(AValue: TAlignment);
+begin
+  if FCaptionPercentAlign=AValue then Exit;
+  FCaptionPercentAlign:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetCaptionPercentSubAlign(AValue: TAlignment);
+begin
+  if FCaptionPercentSubAlign=AValue then Exit;
+  FCaptionPercentSubAlign:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetCaptionShowPercentSub(AValue: Boolean);
+begin
+  if FCaptionShowPercentSub=AValue then Exit;
+  FCaptionShowPercentSub:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetGraphShowYLine(AValue: Boolean);
+begin
+  if FGraphShowYLine=AValue then Exit;
+  FGraphShowYLine:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetGraphYLineAfter(AValue: String);
+begin
+  if FGraphYLineAfter=AValue then Exit;
+  FGraphYLineAfter:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetGraphYLineCaption(AValue: String);
+begin
+  if FGraphYLineCaption=AValue then Exit;
+  FGraphYLineCaption:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetGraphYLineDigits(AValue: Integer);
+begin
+  if FGraphYLineDigits=AValue then Exit;
+  FGraphYLineDigits:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetMax(AValue: Integer);
+begin
+  SetMaxValue(AValue);
+end;
+
+procedure TBGRAFlashProgressBar.SetMin(AValue: Integer);
+begin
+  SetMinValue(AValue);
+end;
+
+procedure TBGRAFlashProgressBar.SetPosition(AValue: Integer);
+begin
+  SetValue(AValue);
+end;
+
+procedure TBGRAFlashProgressBar.SetShowBarAnimation(AValue: Boolean);
+begin
+  if FShowBarAnimation=AValue then Exit;
+  FShowBarAnimation:=AValue;
+
+  if (FStyle in [pbstNormal, pbstMultiProgress, pbstGraph]) and
+     not(csLoading in ComponentState) and
+     not(csDesigning in ComponentState) then
+  begin
+    barAnimLeft:= 0;
+    if FShowBarAnimation then internalTimer.Interval:= BAR_ANIM_TIMER;
+    internalTimer.Enabled:= FShowBarAnimation;
+  end;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetShowDividers(AValue: Boolean);
+begin
+  if FShowDividers=AValue then Exit;
+  FShowDividers:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetMarqueeBounce(AValue: Word);
+begin
+  marqueeBCount:= AValue;
+  if FMarqueeBounce=AValue then Exit;
+  FMarqueeBounce:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetMarqueeDirection(AValue: TBGRAPBarMarqueeDirection);
+begin
+  if (FMarqueeDirection <> AValue) then
+  begin
+    FMarqueeDirection:= AValue;
+    marqueeCurMode:= AValue;
+
+    if Assigned(FOnChange) then FOnChange(Self);
+    Invalidate;
+  end;
+end;
+
+procedure TBGRAFlashProgressBar.SetMarqueeSpeed(AValue: TBGRAPBarMarqueeSpeed);
+begin
+  FMarqueeSpeed:=AValue;
+  case FMarqueeSpeed of
+  pbmsSlow: internalTimer.Interval:= MARQUEE_TIMER_SLOW;
+  pbmsMedium: internalTimer.Interval:= MARQUEE_TIMER_MED;
+  pbmsFast: internalTimer.Interval:= MARQUEE_TIMER_FAST;
+  end;
+end;
+
+procedure TBGRAFlashProgressBar.SetMarqueeWidth(AValue: Word);
+begin
+  if FMarqueeWidth=AValue then Exit;
+  FMarqueeWidth:= AValue;
+  if (FMarqueeWidth = 0)
+  then rMarqueeWidth:= Width div 4
+  else rMarqueeWidth:= FMarqueeWidth;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetMaxValue(AValue: Double);
+begin
+  if FMaxValue = AValue then exit;
+
+  FMaxValue := AValue;
+  if (FValue > FMaxValue) then FValue := FMaxValue;
+  if (FMinValue > FMaxValue) then FMinValue := FMaxValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetMaxYValue(AValue: Double);
+begin
+  if FMaxYValue=AValue then Exit;
+  FMaxYValue:=AValue;
+end;
+
+procedure TBGRAFlashProgressBar.SetMinValue(AValue: Double);
+begin
+  if FMinValue = AValue then exit;
+
+  FMinValue := AValue;
+  if (FValue < FMinValue) then FValue := FMinValue;
+  if (FMaxValue < FMinValue) then FMaxValue := FMinValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetMinYValue(AValue: Double);
+begin
+  if FMinYValue=AValue then Exit;
+  FMinYValue:=AValue;
+end;
+
+procedure TBGRAFlashProgressBar.SetRandSeed(AValue: integer);
+begin
+  if FRandSeed = AValue then exit;
+  FRandSeed := AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetGraphShowYDividers(AValue: Boolean);
+begin
+  if FGraphShowYDividers=AValue then Exit;
+  FGraphShowYDividers:=AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetStyle(AValue: TBGRAPBarStyle);
+begin
+  if (FStyle <> AValue) then
+  begin
+    FStyle:= AValue;
+
+    Case FStyle of
+      pbstNormal,
+      pbstMultiProgress: begin
+        if FShowBarAnimation and
+           not(csLoading in ComponentState) and
+           not(csDesigning in ComponentState)
+        then begin
+               barAnimLeft:= 0;
+               internalTimer.Interval:= BAR_ANIM_TIMER;
+               internalTimer.Enabled:= True;
+             end
+        else internalTimer.Enabled:= False;
+      end;
+      pbstMarquee: begin
+        SetMarqueeSpeed(FMarqueeSpeed);
+
+        if (FMarqueeDirection = pbmdToRight)
+        then marqueeLeft:= 2
+        else marqueeLeft:= -FMarqueeWidth;
+
+        if FTimerAutoRestart and
+           not(csLoading in ComponentState) and
+           not(csDesigning in ComponentState) then internalTimer.Enabled:= True;
+      end;
+      pbstTimer: begin
+        FValue:= FMaxValue;
+        internalTimer.Interval:= FTimerInterval;
+
+        if FTimerAutoRestart and
+           not(csLoading in ComponentState) and
+           not(csDesigning in ComponentState) then internalTimer.Enabled:= True;
+      end;
+      pbstGraph: begin
+        //Save space for the 2 points to close the polygon
+        if (Length(GraphPoints) < 2) then SetLength(GraphPoints, 2);
+
+        if FShowBarAnimation and
+           not(csLoading in ComponentState) and
+           not(csDesigning in ComponentState)
+        then begin
+               internalTimer.Interval:= BAR_ANIM_TIMER;
+               internalTimer.Enabled:= True;
+             end
+        else internalTimer.Enabled:= False;
+      end;
+    end;
+
+    if Assigned(FOnChange) then FOnChange(Self);
+    Invalidate;
+  end;
+end;
+
+procedure TBGRAFlashProgressBar.SetTimerInterval(AValue: Cardinal);
+begin
+  if FTimerInterval=AValue then Exit;
+  FTimerInterval:=AValue;
+
+  if (FStyle = pbstTimer) then internalTimer.Interval:= AValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.SetValueSub(AValue: Double);
+begin
+  if FValueSub = AValue then exit;
+
+  FValueSub := AValue;
+  if (FValueSub < FMinValue) then FValueSub := FMinValue;
+  if (FValueSub > FValue) then FValueSub := FValue;
+
+  if Assigned(FOnChange) then FOnChange(Self);
+  Invalidate;
+end;
+
+procedure TBGRAFlashProgressBar.TimerOnTimer(Sender: TObject);
+begin
+  try
+  if closing then exit;
+
+  Case FStyle of
+    pbstNormal,
+    pbstMultiProgress,
+    pbstGraph: if FShowBarAnimation then begin
+        inc(barAnimLeft, BAR_ANIM_INC);
+
+        //Wait 16 times after reached the end
+        if (barAnimLeft+18 > xpos) then barAnimLeft:= -16*BAR_ANIM_INC;
+    end;
+    pbstMarquee: begin
+      if (FMarqueeBounce > 0) then
+      begin
+        if marqueeBouncing then
+        begin
+          if (marqueeCount = 0) //we've reached the rebound wall
+          then begin
+                 marqueeCount:= 3; //Set the bounce length (3*2pixels)
+
+                 if (marqueeCurMode = pbmdToRight)
+                 then marqueeCurMode:= pbmdToLeft
+                 else marqueeCurMode:= pbmdToRight;
+
+                 //decreases the rebound counter only if we are in the real wall
+                 if marqueeWall then dec(marqueeBCount);
+
+                 if (marqueeBCount > 0)
+                 then marqueeBouncing:= True
+                 else begin
+                        //Stop Bouncing
+                        if marqueeWall then marqueeBCount:= FMarqueeBounce;
+                        marqueeBouncing:= False;
+                      end;
+               end
+          else dec(marqueeCount);
+        end;
+      end;
+
+      //Move the bar 2 pixels
+      if (marqueeCurMode = pbmdToRight)
+      then inc(marqueeLeft, MARQUEE_INC)
+      else dec(marqueeLeft, MARQUEE_INC);
+    end;
+    pbstTimer: begin
+      { #note -oMaxM : If we had to be more precise we should keep the Start time and subtract the current time }
+      FValue:= IncMilliSecond(FValue, -internalTimer.Interval);
+      if (FValue <= 0)
+      then begin
+             if Assigned(FOnTimerEnd) then FOnTimerEnd(Self);
+
+             if FTimerAutoRestart then FValue:= FMaxValue;
+             internalTimer.Enabled:= FTimerAutoRestart;
+           end
+      else if Assigned(FOnTimerTimer) then FOnTimerTimer(Self);
+    end;
+  end;
+
+  Invalidate;
+
+  except
+    //MaxM: Ignore Exception sometimes it happens when we are closing
+  end;
 end;
 
 {$hints off}
-procedure TBGRAFlashProgressBar.CalculatePreferredSize(
-  var PreferredWidth, PreferredHeight: integer; WithThemeSpace: boolean);
+class function TBGRAFlashProgressBar.GetControlClassDefaultSize: TSize;
+begin
+  Result.CX := 380;
+  Result.CY := 34;
+end;
+
+procedure TBGRAFlashProgressBar.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: boolean);
 begin
-  PreferredWidth  := 379;
-  PreferredHeight := 33;
+  PreferredWidth  := 380;
+  PreferredHeight := 34;
+end;
+
+procedure TBGRAFlashProgressBar.DoOnResize;
+begin
+  inherited DoOnResize;
+
+  if (FMarqueeWidth = 0)
+  then rMarqueeWidth:= Width div 4
+  else rMarqueeWidth:= FMarqueeWidth;
 end;
 
 {$hints on}
 
 procedure TBGRAFlashProgressBar.Paint;
 begin
-  if (ClientWidth <> FBGRA.Width) or (ClientHeight <> FBGRA.Height) then
-    FBGRA.SetSize(ClientWidth, ClientHeight);
-  FDrawer.Draw(FBGRA);
-  if Assigned(OnRedraw) then
-    OnRedraw(Self, FBGRA, {%H-}FDrawer.XPosition);
+  if (ClientWidth <> FBGRA.Width) or (ClientHeight <> FBGRA.Height)
+  then FBGRA.SetSize(ClientWidth, ClientHeight);
+
+  Draw(FBGRA);
+
+  if Assigned(OnRedraw) then OnRedraw(Self, FBGRA, {%H-}XPosition);
+
   FBGRA.Draw(Canvas, 0, 0, False);
 end;
 
+procedure TBGRAFlashProgressBar.Loaded;
+begin
+  inherited Loaded;
+
+  Case FStyle of
+    pbstNormal,
+    pbstMultiProgress,
+    pbstGraph: begin
+      if FShowBarAnimation then internalTimer.Interval:= BAR_ANIM_TIMER;
+      internalTimer.Enabled:= FShowBarAnimation;
+    end;
+    pbstMarquee: begin
+      if (FMarqueeDirection = pbmdToRight)
+      then marqueeLeft:= 2
+      else marqueeLeft:= -FMarqueeWidth;
+
+      if FTimerAutoRestart and not(csDesigning in ComponentState) then internalTimer.Enabled:= True;
+    end;
+    pbstTimer: begin
+      FValue:= FMaxValue;
+      internalTimer.Interval:= FTimerInterval;
+
+      if FTimerAutoRestart and not(csDesigning in ComponentState) then internalTimer.Enabled:= True;
+    end;
+  end;
+end;
+
+procedure TBGRAFlashProgressBar.TextChanged;
+begin
+  Invalidate;
+end;
+
 {$hints off}
 procedure TBGRAFlashProgressBar.WMEraseBkgnd(var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF});
 begin
@@ -144,33 +807,90 @@ begin
   inherited Create(AOwner);
 
   with GetControlClassDefaultSize do
-    SetInitialBounds(0, 0, CX, 33);
+    SetInitialBounds(0, 0, CX, CY);
 
-  // Bitmap and Drawer
+  // Bitmap
   FBGRA := TBGRABitmap.Create(Width, Height);
-  FDrawer := TBGRADrawerFlashProgressBar.Create;
-  FDrawer.OnChange := OnChangeDrawer;
+
   // Functionality
-  MinValue := 0;
-  MaxValue := 100;
-  Value := 30;
+  FMinValue := 0;
+  FMaxValue := 100;
+  FValue := 30;
+  FValueSub := 10;
+  xpos:= 0;
+  xposSub:= 0;
+
   // Functionality and Style
   Randomize;
-  FDrawer.RandSeed := RandSeed;
+  FRandSeed := RandSeed;
+  FCaptionShowPercent:= False;
+  FCaptionPercentAlign:= taCenter;
+  FCaptionPercentSubAlign:= taLeftJustify;
+  FCaptionPercentDigits:= 0;
+  Caption:= '';
+
   // Style
-  BarColor := BGRA(102, 163, 226);
-  BackgroundColor := BGRA(47,47,47);
-  BackgroundRandomize := True;
-  BackgroundRandomizeMinIntensity := 4000;
-  BackgroundRandomizeMaxIntensity := 5000;
+  FStyle:=pbstNormal;
+  FBarColor := BGRA(102, 163, 226);
+  FBarColorSub := BGRA(240, 240, 15);
+  FBackgroundColor := BGRA(47,47,47);
+  FBackgroundRandomize := True;
+  FBackgroundRandomizeMinIntensity := 4000;
+  FBackgroundRandomizeMaxIntensity := 5000;
+  FShowDividers:= False;
+  FGraphShowYDividers:= False;
+  FShowBarAnimation:= False;
+  barAnimLeft:= 0;
+
+  //Marquee
+  FMarqueeWidth:= 0; //AutoWidth
+  rMarqueeWidth:= 95; //PreferredWidth div 4
+  FMarqueeSpeed:= pbmsMedium;
+  FMarqueeDirection:= pbmdToRight;
+  marqueeCurMode:= pbmdToRight;
+  marqueeLeft:= 0;
+  marqueeRight:= 0;
+  marqueeBouncing:= False;
+
+  //Timer
+  FTimerInterval:= 100;
+  FTimerAutoRestart:= True;
+  FCaptionPercentTimerFormat:= 'nn:ss.zzz';
+
+  //Graph
+  FMinYValue := 0;
+  FMaxYValue := 100;
+  GraphValues:= nil;
+  GraphPoints:= nil;
+  FGraphShowYDividers:= False;
+  FGraphShowYLine:= False;
+  FGraphYLineCaption:= '';
+  FGraphYLineAfter:= '';
+  FGraphYLineDigits:= 0;
+
+  internalTimer:= TFPTimer.Create(Self);
+  internalTimer.UseTimerThread:= True;
+  internalTimer.Enabled:= False;
+  internalTimer.Interval:= MARQUEE_TIMER_MED;
+  internalTimer.OnTimer:= TimerOnTimer;
+  closing:= False;
 end;
 
 destructor TBGRAFlashProgressBar.Destroy;
 begin
-  FreeAndNil(FBGRA);
-  FDrawer.Free;
+  //Avoid Exception when internalTimer is Enabled
+  closing:= True;
+  internalTimer.Enabled:=False;
+  CheckSynchronize(40);
+
+  internalTimer.Free;
+  GraphValues:= nil;
+  GraphPoints:= nil;
+  FBGRA.Free;
+
   inherited Destroy;
 end;
+
 {$IFDEF FPC}
 procedure TBGRAFlashProgressBar.SaveToFile(AFileName: string);
 var
@@ -206,81 +926,523 @@ begin
 end;
 {$ENDIF}
 
-procedure TBGRAFlashProgressBar.SetMaxValue(const AValue: integer);
-begin
-  FDrawer.MaxValue := AValue;
-end;
+procedure TBGRAFlashProgressBar.Draw(ABitmap: TBGRABitmap);
+var
+  content: TRect;
+  y, tx, ty,
+  marqueeOver: integer;
+  bgColor: TBGRAPixel;
+  pStr: String;
+  pValue: Double;
 
-procedure TBGRAFlashProgressBar.OnChangeDrawer(Sender: TObject);
-begin
-  Invalidate;
-end;
+  function ApplyLightness(c: TBGRAPixel; lightness: word): TBGRAPixel;
+  begin
+    Result := GammaCompression(SetLightness(GammaExpansion(c), lightness));
+  end;
 
-function TBGRAFlashProgressBar.GetBackgroundColor: TColor;
-begin
-  Result := FDrawer.BackgroundColor;
-end;
+  procedure DrawBar(bounds: TRect; AColor: TColor);
+  var
+    lCol: TBGRAPixel;
+  begin
+    lCol := AColor;
 
-function TBGRAFlashProgressBar.GetBackgroundRandomize: boolean;
-begin
-  Result := FDrawer.BackgroundRandomize;
-end;
+    DoubleGradientAlphaFill(ABitmap, bounds,
+      ApplyLightness(lCol, 37000), ApplyLightness(lCol, 29000),
+      ApplyLightness(lCol, 26000), ApplyLightness(lCol, 18000),
+      gdVertical, gdVertical, gdVertical, 0.53);
 
-function TBGRAFlashProgressBar.GetBackgroundRandomizeMaxIntensity: word;
-begin
-  Result := FDrawer.BackgroundRandomizeMaxIntensity;
-end;
+    InflateRect(bounds, -1, -1);
 
-function TBGRAFlashProgressBar.GetBackgroundRandomizeMinIntensity: word;
-begin
-  Result := FDrawer.BackgroundRandomizeMinIntensity;
-end;
+    DoubleGradientAlphaFill(ABitmap, bounds,
+      ApplyLightness(lCol, 28000), ApplyLightness(lCol, 22000),
+      ApplyLightness(lCol, 19000), ApplyLightness(lCol, 11000),
+      gdVertical, gdVertical, gdVertical, 0.53);
+  end;
 
-function TBGRAFlashProgressBar.GetBarColor: TColor;
-begin
-  Result := FDrawer.BarColor;
-end;
+  procedure DrawBarAnimation;
+  begin
+    if FShowBarAnimation and (barAnimLeft >= 0)
+    then ABitmap.GradientFill(barAnimLeft, content.Top, barAnimLeft+36, content.Bottom,
+                              BGRA(255, 255, 255, 64), BGRA(255, 255, 255, 2), gtReflected,
+                              PointF(barAnimLeft+18, content.Bottom-content.Top/2), PointF(barAnimLeft+36, content.Bottom-content.Top/2),
+                              dmLinearBlend);
+  end;
 
-function TBGRAFlashProgressBar.GetMaxValue: integer;
-begin
-  Result := FDrawer.MaxValue;
-end;
+  procedure DrawText(ACaption: String; AAlign: TAlignment);
+  var
+     fx: TBGRATextEffect;
+     lColB: TBGRAPixel;
 
-function TBGRAFlashProgressBar.GetMinValue: integer;
-begin
-  Result := FDrawer.MinValue;
-end;
+  begin
+    try
+       if (Font.Size=0)
+       then fx:= TBGRATextEffect.Create(ACaption, Font.Name, ABitmap.Height div 2, True)
+       else fx:= TBGRATextEffect.Create(ACaption, Font, True);
+
+       if (Font.Color = clDefault) or (Font.Color = clNone)
+       then lColB:= ApplyLightness(FBarColor, 59000)
+       else lColB:= ColorToBGRA(Font.Color);
+
+       y:= (ABitmap.Height-fx.TextHeight) div 2;
+
+       Case AAlign of
+         taLeftJustify: begin
+           fx.DrawOutline(ABitmap, 4, y, BGRABlack, taLeftJustify);
+           fx.Draw(ABitmap, 4, y, lColB, taLeftJustify);
+         end;
+         taRightJustify: begin
+           fx.DrawOutline(ABitmap, tx-4, y, BGRABlack, taRightJustify);
+           fx.Draw(ABitmap, tx-4, y, lColB, taRightJustify);
+         end;
+         taCenter: begin
+           fx.DrawOutline(ABitmap, ABitmap.Width div 2, y, BGRABlack, taCenter);
+           fx.Draw(ABitmap, ABitmap.Width div 2, y, lColB, taCenter);
+         end;
+       end;
+
+    finally
+      fx.Free;
+    end;
+  end;
+
+  procedure DrawDividers(DrawYDiv: Boolean);
+  var
+    lColD: TBGRAPixel;
+    posS: Single;
+    i: Integer;
+
+  begin
+    lColD:= BGRA(128, 128, 128, 128);
+    for i:= 1 to 9 do
+    begin
+      posS:= content.left+(i*10*(content.right-content.left)/100);
+      ABitmap.DrawLineAntialias(posS, 2, posS, content.Bottom-1, lColD, 1, True);
+    end;
+
+    if DrawYDiv then
+      for i:= 1 to 9 do
+      begin
+        posS:= content.Bottom-1-(i*10*(content.Bottom-content.Top)/100);
+        ABitmap.DrawLineAntialias(2, posS, content.Right-1, posS, lColD, 1, True);
+      end;
+  end;
+
+  procedure DrawG;
+  var
+    lCol,
+    lColB: TBGRAPixel;
+    posS: Single;
+    curIndex: Integer;
+    fx: TBGRATextEffect;
+
+  begin
+    lCol := FBarColor;
+
+    if (Font.Color = clDefault) or (Font.Color = clNone)
+    then lColB:= ApplyLightness(FBarColor, 37000)
+    else lColB:= ColorToBGRA(Font.Color);
+
+    posS:= content.left+((FValue-FMinValue)/(FMaxValue-FMinValue)*(content.right-content.left));
+    if (posS > content.Right-1) then posS:= content.Right-1;
+
+    //Fixed Points to Close the Path
+    GraphPoints[0].x:= posS;
+    GraphPoints[0].y:= content.Bottom-1;
+    GraphPoints[1].x:= content.Left;
+    GraphPoints[1].y:= content.Bottom-1;
+
+    //Draw Value Position
+    xpos:= Round(posS);
+    ABitmap.RectangleAntialias(content.left, content.Top, xpos, content.Bottom-1, lColB, 1, lColB);
+
+    if FShowDividers then DrawDividers(FGraphShowYDividers);
+
+    //Draw the Graph
+    if (Length(GraphPoints) > 2) then
+    begin
+      ABitmap.DrawPolygonAntialias(GraphPoints, lCol, 1, lCol);
+
+      if FGraphShowYLine then
+      begin
+        curIndex:= Length(GraphValues)-1;
+
+        //Check if we have at least one Value
+        if (curIndex >= 0) then
+        begin
+          lColB:= BGRA(0, 0, 0, 192);
+          pStr:= FGraphYLineCaption+FloatToStrF(GraphValues[curIndex].YValue, ffFixed, 15, FGraphYLineDigits)+FGraphYLineAfter;
+
+          //Get last Value Y Point and draw a horizontal line
+          curIndex:= Length(GraphPoints)-1;
+          posS:= GraphPoints[curIndex].y;
+          ABitmap.DrawLineAntialias(2, posS, tx-4, posS, lColB, 1, True);
+
+          try
+             fx:= TBGRATextEffect.Create(pStr, Font.Name, 12, True);
+
+             //Write the text above the line if possible else write below
+             if (Round(posS-fx.TextHeight) >= 2) then posS:= posS-fx.TextHeight;
+
+             fx.Draw(ABitmap, tx-6, Round(posS), lColB, taRightJustify);
+
+          finally
+            fx.Free;
+          end;
+        end;
+      end;
+    end;
+
+    DrawBarAnimation; { #note -oMaxM : Evaluate how it seems }
+
+    //Draw Value Text
+    pStr:= '';
+    if FCaptionShowPercent then
+    begin
+      pValue:= 100*(FValue - FMinValue)/FMaxValue;
+      if (pValue <> 0) then pStr:= FloatToStrF(pValue, ffFixed, 15, FCaptionPercentDigits)+'%'
+    end;
+    DrawText(Caption+pStr, FCaptionPercentAlign);
+ end;
 
-function TBGRAFlashProgressBar.GetValue: integer;
 begin
-  Result := FDrawer.Value;
+  try
+  ABitmap.FillTransparent;
+  tx := ABitmap.Width;
+  ty := ABitmap.Height;
+
+  ABitmap.Rectangle(0, 0, tx, ty, BGRA(255, 255, 255, 6), FBackgroundColor, dmSet);
+  if (tx > 2) and (ty > 2) then
+    ABitmap.Rectangle(1, 1, tx - 1, ty - 1, BGRA(29, 29, 29), dmSet);
+
+  if (tx > 4) and (ty > 4) then
+  begin
+    content  := Rect(2, 2, tx - 2, ty - 2);
+    randseed := FRandSeed;
+    if FBackgroundRandomize then
+    for y := content.Top to content.Bottom - 1 do
+    begin
+      bgColor := FBackgroundColor;
+      bgColor.Intensity := RandomRange(FBackgroundRandomizeMinIntensity, FBackgroundRandomizeMaxIntensity);
+      ABitmap.HorizLine(content.Left, y, content.Right - 1, bgColor, dmSet);
+    end;
+    if tx >= 6 then
+      ABitmap.DrawVertLine(content.Right - 1, content.Top, content.Bottom - 1,
+        BGRA(0, 0, 0, 32));
+
+    Case FStyle of
+      pbstNormal: begin
+        if FMaxValue > FMinValue then
+        begin
+          //Draw Value Bar
+          xpos := round((FValue - FMinValue) / (FMaxValue - FMinValue) *
+                        (content.right - content.left)) + content.left;
+          if xpos > content.left then
+          begin
+            DrawBar(rect(content.left, content.top, xpos, content.bottom), FBarColor);
+            if xpos < content.right then
+            begin
+              ABitmap.SetPixel(xpos, content.top, BGRA(62, 62, 62));
+              ABitmap.SetVertLine(xpos, content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
+            end;
+
+            if FShowDividers then DrawDividers(False);
+
+            DrawBarAnimation;
+
+            //Draw Value Text
+            pStr:= '';
+            if FCaptionShowPercent then
+            begin
+              pValue:= 100*(FValue - FMinValue)/FMaxValue;
+              if (pValue <> 0) then pStr:= FloatToStrF(pValue, ffFixed, 15, FCaptionPercentDigits)+'%'
+            end;
+            DrawText(Caption+pStr, FCaptionPercentAlign);
+          end;
+        end
+        else if FShowDividers then DrawDividers(False);
+      end;
+      pbstMultiProgress: begin
+        if FMaxValue > FMinValue then
+        begin
+          //Draw Value Bar
+          xpos := round((FValue - FMinValue) / (FMaxValue - FMinValue) *
+                        (content.right - content.left)) + content.left;
+          if xpos > content.left then
+          begin
+            DrawBar(rect(content.left, content.top, xpos, content.bottom), FBarColor);
+            if xpos < content.right then
+            begin
+              ABitmap.SetPixel(xpos, content.top, BGRA(62, 62, 62));
+              ABitmap.SetVertLine(xpos, content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
+            end;
+          end;
+
+          //Draw ValueSub Bar
+          xposSub := round((FValueSub - FMinValue) / (FMaxValue - FMinValue) *
+                           (content.right - content.left)) + content.left;
+          if xposSub > content.left then
+          begin
+            DrawBar(rect(content.left, content.top, xposSub, content.bottom), FBarColorSub);
+            if xposSub < content.right then
+            begin
+              ABitmap.SetPixel(xposSub, content.top, BGRA(62, 62, 62));
+              ABitmap.SetVertLine(xposSub, content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
+            end;
+          end;
+
+          if FShowDividers then DrawDividers(False);
+
+          DrawBarAnimation;
+
+         //Draw Value Text
+          pStr:= '';
+          if FCaptionShowPercent then
+          begin
+            pValue:= 100*(FValue - FMinValue)/FMaxValue;
+            if (pValue <> 0) then pStr:= FloatToStrF(pValue, ffFixed, 15, FCaptionPercentDigits)+'%'
+          end;
+          DrawText(Caption+pStr, FCaptionPercentAlign);
+
+          //Draw ValueSub Text
+          pStr:= '';
+          if FCaptionShowPercentSub then
+          begin
+            pValue:= 100*(FValueSub - FMinValue)/FMaxValue;
+            if (pValue <> 0) then pStr:= FloatToStrF(pValue, ffFixed, 15, FCaptionPercentDigits)+'%'
+          end;
+          DrawText(pStr, FCaptionPercentSubAlign);
+        end
+        else if FShowDividers then DrawDividers(False);
+      end;
+      pbstMarquee: begin
+        if (marqueeCurMode = pbmdToRight)
+        then begin
+               //check if the whole bar is out put it back to the beginning
+               if (marqueeLeft >= content.Right)
+               then marqueeLeft:= content.Left;
+
+               //Calculate the Right
+               marqueeRight:= marqueeLeft+(rMarqueeWidth-1);
+
+               //Check if part of the bar is out calculate the visible piece on the left
+               marqueeOver:= 0;
+               marqueeWall:= (marqueeRight >= content.Right-1);
+               if marqueeWall then
+               begin
+                 if (FMarqueeBounce > 0)
+                 then begin
+                        //Put perfectly on the Right edge
+                        marqueeRight:= content.Right-1;
+                        marqueeLeft:= marqueeRight-(rMarqueeWidth-1);
+                        marqueeBouncing:= True;
+                      end
+                 else marqueeOver:= marqueeRight-(content.Right-1);
+               end;
+             end
+        else begin
+               //check if the whole bar is out put it back to the end
+               if (marqueeLeft <= -rMarqueeWidth)
+               then marqueeLeft:= content.Right-rMarqueeWidth;
+
+               //Calculate the Right
+               marqueeRight:= marqueeLeft+(rMarqueeWidth-1);
+
+               //check if part of the bar is out then the visible piece on the left is equal to marqueeRight
+               marqueeOver:= 0;
+               marqueeWall:= (marqueeRight-1 <= rMarqueeWidth);
+               if marqueeWall then
+               begin
+                 if (FMarqueeBounce > 0)
+                 then begin
+                        //Put perfectly on the Left edge
+                        marqueeLeft:= content.Left;
+                        marqueeRight:= marqueeLeft+(rMarqueeWidth-1);
+                        marqueeBouncing:= True;
+                      end
+                 else marqueeOver:= marqueeRight;
+               end;
+             end;
+
+        if (marqueeOver = 0)
+        then begin
+               //Draw Normal Bar Left-Right
+               DrawBar(rect(marqueeLeft, content.top, marqueeRight, content.bottom), FBarColor);
+               ABitmap.SetPixel(marqueeLeft, content.top, BGRA(62, 62, 62));
+               ABitmap.SetVertLine(marqueeLeft, content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
+               ABitmap.SetPixel(marqueeRight, content.top, BGRA(62, 62, 62));
+               ABitmap.SetVertLine(marqueeRight, content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
+             end
+        else begin
+               //Draw visible piece on the Left
+               DrawBar(rect(content.Left, content.top, marqueeOver, content.bottom), FBarColor);
+               ABitmap.SetPixel(marqueeOver, content.top, BGRA(62, 62, 62));
+               ABitmap.SetVertLine(marqueeOver, content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
+               //Draw visible piece on the Right
+               DrawBar(rect(content.Right-(rMarqueeWidth+1-marqueeOver), content.top, tx-2, content.bottom), FBarColor);
+               ABitmap.SetPixel(content.Right-(rMarqueeWidth+1-marqueeOver), content.top, BGRA(62, 62, 62));
+               ABitmap.SetVertLine(content.Right-(rMarqueeWidth+1-marqueeOver), content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
+             end;
+
+        //Draw Value Text
+         pStr:= '';
+         if FCaptionShowPercent then
+         begin
+           pValue:= 100*(FValue - FMinValue)/FMaxValue;
+           if (pValue <> 0) then pStr:= FloatToStrF(pValue, ffFixed, 15, FCaptionPercentDigits)+'%'
+         end;
+         DrawText(Caption+pStr, FCaptionPercentAlign);
+      end;
+      pbstTimer: begin
+        if FMaxValue > FMinValue then
+        begin
+          //Draw Timer Bar
+          xpos := round((FValue - FMinValue) / (FMaxValue - FMinValue) *
+                        (content.right - content.left)) + content.left;
+          if xpos > content.left then
+          begin
+            DrawBar(rect(content.left, content.top, xpos, content.bottom), FBarColor);
+            if xpos < content.right then
+            begin
+              ABitmap.SetPixel(xpos, content.top, BGRA(62, 62, 62));
+              ABitmap.SetVertLine(xpos, content.top + 1, content.bottom - 1, BGRA(40, 40, 40));
+            end;
+
+            if FShowDividers then DrawDividers(False);
+
+            //Draw Timer Text
+            pStr:= '';
+            if FCaptionShowPercent then
+            begin
+              if (FValue <> 0) then pStr:= FormatDateTime(FCaptionPercentTimerFormat, FValue)
+            end;
+            DrawText(Caption+pStr, FCaptionPercentAlign);
+          end;
+        end
+        else if FShowDividers then DrawDividers(False);
+      end;
+      pbstGraph: DrawG;
+      end;
+  end;
+
+  except
+    //MaxM: Ignore Exception sometimes it happens when the timer is active and we are closing
+  end;
 end;
 
-procedure TBGRAFlashProgressBar.SetBackgroundColor(AValue: TColor);
+procedure TBGRAFlashProgressBar.SetValue(AValue: Double);
 begin
-  FDrawer.BackgroundColor := AValue;
+  SetValue(AValue, 0);
 end;
 
-procedure TBGRAFlashProgressBar.SetBackgroundRandomize(AValue: boolean);
+procedure TBGRAFlashProgressBar.SetValue(AValue, AYValue: Double);
+var
+   curIndex: Integer;
+
 begin
-  FDrawer.BackgroundRandomize := AValue;
+  if (FStyle = pbstGraph)
+  then begin
+         if (AValue >= FMinValue) and (AValue <= FMaxValue) then
+         begin
+           //Check if Y Value is on the Range
+           FValue := AValue;
+           if (AYValue < FMinYValue) then AYValue := FMinYValue;
+           if (AYValue > FMaxYValue) then AYValue := FMaxYValue;
+
+           if (AValue > FValue)
+           then begin
+                  //Add a new Value in the array
+                  curIndex:= Length(GraphValues);
+                  SetLength(GraphValues, curIndex+1);
+                  GraphValues[curIndex].XValue:= AValue;
+                  GraphValues[curIndex].YValue:= AYValue;
+
+                  //Calculate new Value x/y Position and add in the array
+                  curIndex:= Length(GraphPoints);
+                  SetLength(GraphPoints, curIndex+1);
+                  GraphPoints[curIndex].x:= 2+((AValue-FMinValue) / (FMaxValue-FMinValue))*(Width-4);
+                  GraphPoints[curIndex].y:= Height-3-((AYValue-FMinYValue) / (FMaxYValue-FMinYValue))*(Height-4);
+
+                  if (GraphPoints[curIndex].x > Width-4) then GraphPoints[curIndex].x:= Width-4;
+                  if (GraphPoints[curIndex].y < 2) then GraphPoints[curIndex].y:= 2;
+                end
+           else begin
+                  //Deletes all values from the array that are no longer visible
+                  curIndex:= Length(GraphValues)-1;
+                  while (curIndex>=0) and (GraphValues[curIndex].XValue > AValue) do
+                  begin
+                    SetLength(GraphValues, curIndex);
+                    SetLength(GraphPoints, curIndex+2); //there are 2 fixed points at the beginning
+                    dec(curIndex);
+                  end;
+
+                  //If the last XValue is the same then assign the YValue else add a new Value
+                  if (curIndex>=0) and (GraphValues[curIndex].XValue = AValue)
+                  then GraphValues[curIndex].YValue:= AYValue
+                  else begin
+                         curIndex:= Length(GraphValues);
+                         SetLength(GraphValues, curIndex+1);
+                         GraphValues[curIndex].XValue:= AValue;
+                         GraphValues[curIndex].YValue:= AYValue;
+                         SetLength(GraphPoints, Length(GraphPoints)+1);
+                       end;
+
+                  curIndex:= Length(GraphPoints)-1;
+                  GraphPoints[curIndex].x:= 2+((AValue-FMinValue) / (FMaxValue-FMinValue))*(Width-4);
+                  GraphPoints[curIndex].y:= Height-3-((AYValue-FMinYValue) / (FMaxYValue-FMinYValue))*(Height-4);
+
+                  if (GraphPoints[curIndex].x > Width-4) then GraphPoints[curIndex].x:= Width-4;
+                  if (GraphPoints[curIndex].y < 2) then GraphPoints[curIndex].y:= 2;
+                end;
+
+           FValue:= AValue;
+
+           if Assigned(FOnChange) then FOnChange(Self);
+           Invalidate;
+         end;
+       end
+  else if (FValue <> AValue) then
+       begin
+         FValue := AValue;
+         if (FValue < FMinValue) then FValue := FMinValue;
+         if (FValue > FMaxValue) then FValue := FMaxValue;
+
+         if Assigned(FOnChange) then FOnChange(Self);
+         Invalidate;
+       end;
 end;
 
-procedure TBGRAFlashProgressBar.SetBackgroundRandomizeMaxIntensity(AValue: word
-  );
+procedure TBGRAFlashProgressBar.StepIt(AIncrement: Double);
 begin
-  FDrawer.BackgroundRandomizeMaxIntensity := AValue;
+  Case FStyle of
+    pbstMarquee,
+    pbstTimer: begin
+      internalTimer.Enabled:= False;
+      TimerOnTimer(nil);
+    end
+  else Value:= Value+AIncrement;
+  end;
 end;
 
-procedure TBGRAFlashProgressBar.SetBackgroundRandomizeMinIntensity(AValue: word
-  );
+procedure TBGRAFlashProgressBar.TimerReStart;
 begin
-  FDrawer.BackgroundRandomizeMinIntensity := AValue;
+  if (FStyle = pbstTimer) then
+  begin
+    FValue:= FMaxValue;
+    internalTimer.Interval:= FTimerInterval;
+    internalTimer.Enabled:= True;
+    Invalidate;
+
+    if Assigned(FOnTimerStart) then FOnTimerStart(Self);
+  end;
 end;
 
-procedure TBGRAFlashProgressBar.SetBarColor(AValue: TColor);
+procedure TBGRAFlashProgressBar.TimerPlayPause;
 begin
-  FDrawer.BarColor := AValue;
+  if (FStyle in [pbstMarquee, pbstTimer]) then
+  begin
+    internalTimer.Enabled:= not(internalTimer.Enabled);
+    Invalidate;
+  end;
 end;
 
 end.

bgraimagelist.pas

@@ -4,11 +4,19 @@
 
   originally written in 2011 by Krzysztof Dibowski dibowski at interia.pl
 }
-{******************************* CONTRIBUTOR(S) ******************************
+(******************************** CONTRIBUTOR(S) ******************************
 - Edivando S. Santos Brasil | [email protected]
-  (Compatibility with delphi VCL 11/2018)
+  (Compatibility with delphi VCL 11/2018)   { #note -oMaxM : VCL Compatibility? }
 
-***************************** END CONTRIBUTOR(S) *****************************}
+- Massimo Magnano
+ 2024/12
+   Added Before/AfterDraw events (don't works with Widgetsets)
+   Added UseBGRADraw             ( " )
+   Added Proportionally add methods
+ 2025/01
+   Added Indexed image reading/writing and Load/SaveFile
+
+***************************** END CONTRIBUTOR(S) *****************************)
 unit BGRAImageList;
 
 {$I bgracontrols.inc}
@@ -16,110 +24,1017 @@ unit BGRAImageList;
 interface
 
 uses
-  Classes, SysUtils, {$IFDEF FPC}LResources,{$ENDIF} Forms, Controls, Graphics, Dialogs,
+  Classes, SysUtils,
+  {$ifdef FPC}
+  LResources, LCLVersion,
+  {$endif}
+  Controls, Graphics,
   GraphType, BGRABitmap, BGRABitmapTypes, {%H-}ImgList;
 
-{$IFDEF LCLgtk}
+{$ifdef LCLgtk or LCLgtk2}
   { $DEFINE BGRA_DRAW}
-{$ELSE}
-  {$IFDEF LCLgtk2}
-    { $DEFINE BGRA_DRAW}
-  {$ENDIF}
-{$ENDIF}
+{$endif}
+
+
+const
+  { #note -oMaxM : redeclared because are not public consts }
+  SIG_LAZ1 = #1#0;
+  SIG_LAZ2 = 'li';
+  SIG_LAZ3 = 'Li';
+  SIG_LAZ4 = 'Lz';
+  SIG_D3   = 'IL';
+
+  sInvalidIndex = 'Invalid ImageList Index';
+  sInvalidFormat ='Invalid Stream Format Signature';
 
 type
+  TImageListSignature = array[0..1] of char; { #note -oMaxM : redeclared because is not a public type }
+
+  { TBGRAImageListResolution }
+
+  TBGRAImageListResolution = class(TDragImageListResolution)
+  protected
+    {$if lcl_fullversion >= 4990000}
+    procedure ReadData(AStream: TStream; AIndex: Integer;
+                       StartStreamPos: Int64=0; CalcPos: Boolean=True); virtual; overload;
+    procedure WriteData(AStream: TStream; AIndex: Integer;
+                       StartStreamPos: Int64=0; CalcPos: Boolean=True); virtual; overload;
+    {$endif}
+
+  public
+    procedure BGRADraw(ACanvas: TCanvas; ARect: TRect; AIndex: Integer; AOverlay: TOverlay;
+      ADrawingStyle: TDrawingStyle; AImageType: TImageType;
+      ADrawEffect: TGraphicsDrawEffect; ABkColor, ABlendColor: TColor; AStretch: Boolean=False); virtual;
+
+    procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: integer; ADrawingStyle: TDrawingStyle; AImageType: TImageType;
+      ADrawEffect: TGraphicsDrawEffect); override;
+
+    procedure DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer; AOverlay: TOverlay; ADrawingStyle:
+      TDrawingStyle; AImageType: TImageType; ADrawEffect: TGraphicsDrawEffect); overload;
+
+    procedure StretchDrawOverlay(ACanvas: TCanvas; AIndex: Integer; ARect: TRect; AOverlay: TOverlay;
+      AEnabled: Boolean = True); virtual;
+  end;
 
   { TBGRAImageList }
+  TBGRAImageList = class;
+
+  //Return True whether the default draw should be called
+  TCustomImageListBeforeDraw= function (Sender: TBGRAImageList;
+    ACanvas: TCanvas; var ARect: TRect; var AIndex: Integer;
+    var ADrawingStyle: TDrawingStyle; var AImageType: TImageType;
+    var ADrawOverlay: Boolean; var AOverlay: TOverlay;
+    var ADrawEffect: TGraphicsDrawEffect): Boolean of object;
+
+  TCustomImageListAfterDraw= procedure (Sender: TBGRAImageList;
+    ACanvas: TCanvas; ARect: TRect; AIndex: Integer;
+    ADrawingStyle: TDrawingStyle; AImageType: TImageType;
+    ADrawOverlay: Boolean; AOverlay: TOverlay;
+    ADrawEffect: TGraphicsDrawEffect) of object;
+
+  {$if lcl_fullversion < 4990000}
+  TOverlaysArray = array[TOverlay] of Integer;
+  {$endif}
 
   TBGRAImageList = class(TImageList)
   private
-    { Private declarations }
-    {$IFDEF BGRA_DRAW}
+    rUseBGRADraw: Boolean;
     FBGRA: TBGRABitmap;
     FBmp:  TBitmap;
-    {$ENDIF}
+
+    procedure SetUseBGRADraw(AValue: Boolean);
+
   protected
-    { Protected declarations }
+    FOnBeforeDraw: TCustomImageListBeforeDraw;
+    FOnAfterDraw: TCustomImageListAfterDraw;
+
+    {$if lcl_fullversion < 4990000}
+    { #note -oMaxM : we keep our copy of the FOverlays array since it is declared private without any logic,
+                     so derived classes cannot use it in any way also because there is no property to read them
+                     see merged code freepascal.org/lazarus/lazarus!429
+                     }
+    rOverlays: TOverlaysArray;
+    {$endif}
+
+    function GetResolution(AImageWidth: Integer): TBGRAImageListResolution;
+
+    function CreateEmptyBitmap(AImageWidth, AImageHeight: Integer;
+                               AHorizAlign: TAlignment; AVertAlign: TTextLayout;
+                               var imgRect: TRect): TBitmap;
+
   public
-    { Public declarations }
-    {$IFDEF BGRA_DRAW}
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
 
-    procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: integer;
-      ADrawingStyle: TDrawingStyle; AImageType: TImageType;
-      ADrawEffect: TGraphicsDrawEffect); override;
-    {$ENDIF}
+    function GetResolutionClass: TCustomImageListResolutionClass; override;
+
+    procedure ReadData(AStream: TStream); override; overload;
+
+    {$if lcl_fullversion >= 4990000}
+    //Read/Write AIndex image from Stream without read/write all the images
+    procedure ReadData(AStream: TStream; AIndex: Integer;
+                       StartStreamPos: Int64=0; CalcPos: Boolean=True); virtual; overload;
+    procedure WriteData(AStream: TStream); override; overload;
+    procedure WriteData(AStream: TStream; AIndex: Integer;
+                       StartStreamPos: Int64=0; CalcPos: Boolean=True); virtual; overload;
+
+    //Read/Write from File
+    procedure LoadFromFile(const AFilename: string; AIndex: Integer;
+                       StartStreamPos: Int64=0; CalcPos: Boolean=True); overload;
+    procedure LoadFromFileUTF8(const AFilenameUTF8: string; AIndex: Integer;
+                       StartStreamPos: Int64=0; CalcPos: Boolean=True); overload;
+    procedure SaveToFile(const AFilename: string; AIndex: Integer;
+                       StartStreamPos: Int64=0; CalcPos: Boolean=True); overload;
+    procedure SaveToFileUTF8(const AFilenameUTF8: string; AIndex: Integer;
+                       StartStreamPos: Int64=0; CalcPos: Boolean=True); overload;
+    {$else}
+    procedure Overlay(AIndex: Integer; AOverlay: TOverlay);
+
+    property Overlays: TOverlaysArray read rOverlays;
+    {$endif}
+
+    procedure LoadFromFile(const AFilename: string); overload;
+    procedure LoadFromFileUTF8(const AFilenameUTF8: string); overload;
+    procedure SaveToFile(const AFilename: string); overload;
+    procedure SaveToFileUTF8(const AFilenameUTF8: string); overload;
+
+    function CreateProportionalImage(AImage: TCustomBitmap;
+                                     AHorizAlign: TAlignment; AVertAlign: TTextLayout): TBitmap; overload;
+    function CreateProportionalImage(AImageFileName: String;
+                                     AHorizAlign: TAlignment; AVertAlign: TTextLayout): TBitmap; overload;
+
+    function CreateMaskImage(AImage: TCustomBitmap; MaskColor: TColor): TBitmap; overload;
+    function CreateMaskImage(AImageFileName: String; MaskColor: TColor): TBitmap; overload;
+
+    function CreateProportionalMaskImage(AImage: TCustomBitmap; MaskColor: TColor;
+                                     AHorizAlign: TAlignment; AVertAlign: TTextLayout): TBitmap; overload;
+    function CreateProportionalMaskImage(AImageFileName: String; MaskColor: TColor;
+                                     AHorizAlign: TAlignment; AVertAlign: TTextLayout): TBitmap; overload;
+
+    procedure StretchDrawOverlay(ACanvas: TCanvas; AIndex: Integer; ARect: TRect; AOverlay: TOverlay; AEnabled: Boolean = True);
+
+    function AddProportionally(Image: TCustomBitmap; Mask: TCustomBitmap=nil;
+                               AHorizAlign: TAlignment=taCenter; AVertAlign: TTextLayout=tlCenter): Integer; overload;
+    function AddProportionally(AImageFileName: String; AMaskFileName: String='';
+                               AHorizAlign: TAlignment=taCenter; AVertAlign: TTextLayout=tlCenter): Integer; overload;
+
+    function AddMaskedProportionally(Image: TCustomBitmap; MaskColor: TColor;
+                               AHorizAlign: TAlignment=taCenter; AVertAlign: TTextLayout=tlCenter): Integer; overload;
+    function AddMaskedProportionally(AImageFileName: String; MaskColor: TColor;
+                               AHorizAlign: TAlignment=taCenter; AVertAlign: TTextLayout=tlCenter): Integer; overload;
+
+    procedure InsertProportionally(AIndex: Integer; AImage: TCustomBitmap; AMask: TCustomBitmap=nil;
+                               AHorizAlign: TAlignment=taCenter; AVertAlign: TTextLayout=tlCenter); overload;
+    procedure InsertProportionally(AIndex: Integer; AImageFileName: String; AMaskFileName: String='';
+                               AHorizAlign: TAlignment=taCenter; AVertAlign: TTextLayout=tlCenter); overload;
+
+    procedure InsertMaskedProportionally(AIndex: Integer; AImage: TCustomBitmap; MaskColor: TColor;
+                               AHorizAlign: TAlignment=taCenter; AVertAlign: TTextLayout=tlCenter); overload;
+    procedure InsertMaskedProportionally(AIndex: Integer; AImageFileName: String; MaskColor: TColor;
+                               AHorizAlign: TAlignment=taCenter; AVertAlign: TTextLayout=tlCenter); overload;
+
+    procedure ReplaceProportionally(AIndex: Integer; AImage: TCustomBitmap; AMask: TCustomBitmap=nil;
+                               const AllResolutions: Boolean = True;
+                               AHorizAlign: TAlignment=taCenter; AVertAlign: TTextLayout=tlCenter); overload;
+    procedure ReplaceProportionally(AIndex: Integer; AImageFileName: String; AMaskFileName: String='';
+                               const AllResolutions: Boolean = True;
+                               AHorizAlign: TAlignment=taCenter; AVertAlign: TTextLayout=tlCenter); overload;
+
+    procedure ReplaceMaskedProportionally(AIndex: Integer; AImage: TCustomBitmap; MaskColor: TColor;
+                               const AllResolutions: Boolean = True;
+                               AHorizAlign: TAlignment=taCenter; AVertAlign: TTextLayout=tlCenter); overload;
+    procedure ReplaceMaskedProportionally(AIndex: Integer; AImageFileName: String; MaskColor: TColor;
+                               const AllResolutions: Boolean = True;
+                               AHorizAlign: TAlignment=taCenter; AVertAlign: TTextLayout=tlCenter); overload;
+
+
   published
-    { Published declarations }
+    property UseBGRADraw: Boolean read rUseBGRADraw write SetUseBGRADraw;
+
+    { #note -oMaxM : This Events don't works inside Widgetsets that use the imagelist handle
+                     but only if you draw directly on the Canvas using ImageList Draw methods }
+    property OnBeforeDraw: TCustomImageListBeforeDraw read FOnBeforeDraw write FOnBeforeDraw;
+    property OnAfterDraw: TCustomImageListAfterDraw read FOnAfterDraw write FOnAfterDraw;
   end;
 
-{$IFDEF FPC}procedure Register;{$ENDIF}
+{$ifdef FPC}procedure Register;{$endif}
 
 implementation
 
-{$IFDEF FPC}
+uses BGRAUTF8 {$ifdef FPC}, WSImgList{$endif};
+
+const
+  EffectMap: array[Boolean] of TGraphicsDrawEffect = (
+    gdeDisabled,
+    gdeNormal
+  );
+
+{$ifdef FPC}
 procedure Register;
 begin
   RegisterComponents('BGRA Controls', [TBGRAImageList]);
 end;
-{$ENDIF}
+{$endif}
+
+{ TBGRAImageListResolution }
+
+{$if lcl_fullversion >= 4990000}
+procedure TBGRAImageListResolution.ReadData(AStream: TStream; AIndex: Integer;
+  StartStreamPos: Int64; CalcPos: Boolean);
+var
+   oStreamPos: Int64;
+   Signature: TImageListSignature;
+   datPos, sCount: Integer;
 
-{$IFDEF BGRA_DRAW}
-{ TBGRAImageList }
-constructor TBGRAImageList.Create(AOwner: TComponent);
 begin
-  inherited Create(AOwner);
-  FBGRA := TBGRABitmap.Create;
-  FBmp  := TBitmap.Create;
+  if (AIndex<0) or (AIndex>=Count) then raise EInvalidOperation.Create(SInvalidIndex);
+
+  oStreamPos:= AStream.Position;
+  try
+     AStream.Position:= StartStreamPos;
+     datPos:= AIndex * Width * Height;
+     if CalcPos
+     then begin
+            AStream.Read(Signature, SizeOf(Signature));
+            if Signature = SIG_LAZ3
+            then begin
+                   sCount:=ReadLRSInteger(AStream);
+                   if (AIndex>=sCount) then raise EInvalidOperation.Create(SInvalidIndex);
+
+                   AStream.Position:= oStreamPos+SizeOf(Signature)+(3*4)+(datPos*SizeOf(FData[0]));
+                   AStream.Read(FData[datPos], Width * Height * SizeOf(FData[0]));
+                 end
+            else raise Exception.Create(sInvalidFormat+' '+Signature);
+          end
+     else AStream.Read(FData[datPos], Width * Height * SizeOf(FData[0]));
+
+     if HandleAllocated
+     then TWSCustomImageListResolutionClass(WidgetSetClass).Replace(Self, AIndex, @FData[datPos]);
+
+   finally
+     AStream.Position:= oStreamPos;
+   end;
 end;
 
-destructor TBGRAImageList.Destroy;
+procedure TBGRAImageListResolution.WriteData(AStream: TStream; AIndex: Integer;
+  StartStreamPos: Int64; CalcPos: Boolean);
+var
+   oStreamPos: Int64;
+   Signature: TImageListSignature;
+   datPos: Integer;
+
 begin
-  FBGRA.Free;
-  FBmp.Free;
-  inherited Destroy;
+  if (AIndex<0) or (AIndex>=Count) then raise EInvalidOperation.Create(SInvalidIndex);
+
+  oStreamPos:= AStream.Position;
+  try
+     AStream.Position:= StartStreamPos;
+     datPos:= AIndex * Width * Height;
+     if CalcPos
+     then begin
+            AStream.Read(Signature, SizeOf(Signature));
+            if Signature = SIG_LAZ3
+            then begin
+                   WriteLRSInteger(AStream, Count);
+                   AStream.Position:= oStreamPos+SizeOf(Signature)+(3*4)+(datPos*SizeOf(FData[0]));
+                   AStream.Write(FData[datPos], Width * Height * SizeOf(FData[0]));
+                 end
+            else raise Exception.Create(sInvalidFormat+' '+Signature);
+          end
+     else AStream.Write(FData[datPos], Width * Height * SizeOf(FData[0]));
+
+   finally
+     AStream.Position:= oStreamPos;
+   end;
 end;
+{$endif}
 
-{ Problem with no alpha is only on GTK so on Windows we use default drawing }
-procedure TBGRAImageList.Draw(ACanvas: TCanvas; AX, AY, AIndex: integer;
-  ADrawingStyle: TDrawingStyle; AImageType: TImageType;
-  ADrawEffect: TGraphicsDrawEffect);
-begin
-  //inherited; - We use TBGRABitmap drawing only
+procedure TBGRAImageListResolution.BGRADraw(ACanvas: TCanvas; ARect: TRect; AIndex: Integer; AOverlay: TOverlay;
+                           ADrawingStyle: TDrawingStyle; AImageType: TImageType;
+                           ADrawEffect: TGraphicsDrawEffect; ABkColor, ABlendColor: TColor; AStretch: Boolean);
+var
+   bmpDrawEffect: TGraphicsDrawEffect;
+   OverlayI: Integer;
 
-  // This is required part from TImageList.Draw
-  if (AIndex < 0) or (AIndex >= Count) then
-    Exit;
+begin
+  if (AIndex < 0) or (AIndex >= Count) then Exit;
   ReferenceNeeded;
 
-  {*** BGRA Drawing *** }
-  case ADrawEffect of
-    gdeDisabled:
+  with TBGRAImageList(ImageList) do
+  begin
+    if (FBGRA = nil) then FBGRA:= TBGRABitmap.Create;
+    if (FBmp = nil) then FBmp:= TBitmap.Create;
+
+    {*** BGRA Drawing *** }
+    if (ADrawEffect = gdeDisabled)
+    then bmpDrawEffect:= gdeNormal
+    else bmpDrawEffect:= ADrawEffect;
+
+    {$ifdef FPC}
+      GetBitmap(AIndex, FBmp, bmpDrawEffect);
+    {$else}
+      GetBitmapRaw(AIndex, FBmp, bmpDrawEffect);
+    {$endif}
+    FBGRA.Assign(FBmp);
+
+    if (AOverlay > 0) then
     begin
-      {$IFDEF FPC}
-      GetBitmap(AIndex, FBmp, gdeNormal);
-      {$ELSE}
-      GetBitmapRaw(AIndex, FBmp, gdeNormal);
-      {$ENDIF}
-      FBGRA.Assign(FBmp);
-      BGRAReplace(FBGRA, FBGRA.FilterGrayscale);
+      OverlayI := Overlays[AOverlay];
+      if (OverlayI in [0..Count-1]) then
+      begin
+       {$ifdef FPC}
+         GetBitmap(OverlayI, FBmp, bmpDrawEffect);
+       {$else}
+         GetBitmapRaw(OverlayI, FBmp, bmpDrawEffect);
+       {$endif}
+       FBmp.Mask(ImageList.BkColor);
+
+       FBGRA.PutImage(0, 0, FBmp, dmLinearBlend);
+      end;
+    end;
+
+    if (ADrawEffect = gdeDisabled) then BGRAReplace(FBGRA, FBGRA.FilterGrayscale);
+
+    if (ADrawingStyle in [dsFocus, dsSelected]) then FBGRA.ApplyGlobalOpacity(128);
+
+    if AStretch
+    then FBGRA.Draw(ACanvas, ARect, (ABkColor <> clNone))
+    else FBGRA.Draw(ACanvas, ARect.Left, ARect.Top, (ABkColor <> clNone));
+  end;
+end;
+
+procedure TBGRAImageListResolution.Draw(ACanvas: TCanvas; AX, AY, AIndex: integer; ADrawingStyle: TDrawingStyle;
+  AImageType: TImageType; ADrawEffect: TGraphicsDrawEffect);
+var
+   vRect: TRect;
+   vIndex: Integer;
+   vDrawingStyle: TDrawingStyle;
+   vImageType: TImageType;
+   vDrawOverlay,
+   stdDraw: Boolean;
+   vOverlay: TOverlay;
+   vDrawEffect: TGraphicsDrawEffect;
+   rImageList: TBGRAImageList;
+
+begin
+  if (AIndex < 0) or (AIndex >= Count) then Exit;
+  ReferenceNeeded;
+
+  rImageList:= TBGRAImageList(ImageList);
+
+  //Copy Parameters to vars
+  vRect:= Rect(AX, AY, Width, Height);
+  vIndex:= AIndex;
+  vDrawingStyle:= ADrawingStyle;
+  vImageType:= AImageType;
+  vDrawOverlay:= False;
+  vOverlay:= 0;
+  vDrawEffect:= ADrawEffect;
+
+  stdDraw:= True;
+  if Assigned(rImageList.FOnBeforeDraw)
+  then stdDraw:= rImageList.FOnBeforeDraw(rImageList, ACanvas, vRect, vIndex, vDrawingStyle, vImageType,
+                                          vDrawOverlay, vOverlay, vDrawEffect);
+
+  if stdDraw then
+  begin
+    if not(vDrawOverlay) then vOverlay:= 0;
+
+    if rImageList.rUseBGRADraw
+    then BGRADraw(ACanvas, vRect, vIndex, vOverlay, vDrawingStyle, vImageType, vDrawEffect,
+                    rImageList.BkColor, rImageList.BlendColor)
+    else begin
+           if vDrawOverlay
+           then inherited DrawOverlay(ACanvas, vRect.Left, vRect.Top, vIndex, vOverlay, vDrawingStyle, vImageType, vDrawEffect)
+           else inherited Draw(ACanvas, vRect.Left, vRect.Top, vIndex, vDrawingStyle, vImageType, vDrawEffect);
+         end;
+  end;
+
+  if Assigned(rImageList.FOnAfterDraw)
+  then rImageList.FOnAfterDraw(rImageList, ACanvas, vRect, vIndex, vDrawingStyle, vImageType,
+                               vDrawOverlay, vOverlay, vDrawEffect);
+end;
+
+procedure TBGRAImageListResolution.DrawOverlay(ACanvas: TCanvas; AX, AY, AIndex: Integer; AOverlay: TOverlay;
+  ADrawingStyle: TDrawingStyle; AImageType: TImageType; ADrawEffect: TGraphicsDrawEffect);
+var
+   vRect: TRect;
+   vIndex: Integer;
+   vDrawingStyle: TDrawingStyle;
+   vImageType: TImageType;
+   vDrawOverlay,
+   stdDraw: Boolean;
+   vOverlay: TOverlay;
+   vDrawEffect: TGraphicsDrawEffect;
+   rImageList: TBGRAImageList;
+
+begin
+  if (AIndex < 0) or (AIndex >= Count) then Exit;
+  ReferenceNeeded;
+
+  rImageList:= TBGRAImageList(ImageList);
+
+  //Copy Parameters to vars
+  vRect:= Rect(AX, AY, Width, Height);
+  vIndex:= AIndex;
+  vDrawingStyle:= ADrawingStyle;
+  vImageType:= AImageType;
+  vDrawOverlay:= True;
+  vOverlay:= AOverlay;
+  vDrawEffect:= ADrawEffect;
+
+  stdDraw:= True;
+  if Assigned(rImageList.FOnBeforeDraw)
+  then stdDraw:= rImageList.FOnBeforeDraw(rImageList, ACanvas, vRect, vIndex, vDrawingStyle, vImageType,
+                                          vDrawOverlay, vOverlay, vDrawEffect);
+
+  if stdDraw then
+  begin
+    if not(vDrawOverlay) then vOverlay:= 0;
+
+    if rImageList.rUseBGRADraw
+    then BGRADraw(ACanvas, vRect, vIndex, vOverlay, vDrawingStyle, vImageType, vDrawEffect,
+                  rImageList.BkColor, rImageList.BlendColor)
+    else begin
+           if vDrawOverlay
+           then inherited DrawOverlay(ACanvas, vRect.Left, vRect.Top, vIndex, vOverlay, vDrawingStyle, vImageType, vDrawEffect)
+           else inherited Draw(ACanvas, vRect.Left, vRect.Top, vIndex, vDrawingStyle, vImageType, vDrawEffect);
+         end;
+  end;
+
+  if Assigned(TBGRAImageList(ImageList).FOnAfterDraw)
+  then TBGRAImageList(ImageList).FOnAfterDraw(TBGRAImageList(ImageList), ACanvas, vRect, vIndex, vDrawingStyle, vImageType,
+                               vDrawOverlay, vOverlay, vDrawEffect);
+end;
+
+procedure TBGRAImageListResolution.StretchDrawOverlay(ACanvas: TCanvas; AIndex: Integer; ARect: TRect;
+  AOverlay: TOverlay; AEnabled: Boolean);
+var
+   Bmp: TBitmap;
+   vRect: TRect;
+   OverlayI,
+   vIndex: Integer;
+   vDrawingStyle: TDrawingStyle;
+   vImageType: TImageType;
+   vDrawOverlay,
+   stdDraw: Boolean;
+   vOverlay: TOverlay;
+   vDrawEffect: TGraphicsDrawEffect;
+   rImageList: TBGRAImageList;
+
+begin
+  if ((ARect.Right-ARect.Left)=Width) and ((ARect.Bottom-ARect.Top)=Height) then
+    DrawOverlay(ACanvas, ARect.Left, ARect.Top, AIndex, AOverlay, AEnabled)
+  else
+  begin
+      rImageList:= TBGRAImageList(ImageList);
+
+      //Copy Parameters to vars
+      vRect:= ARect;
+      vIndex:= AIndex;
+      vDrawingStyle:= rImageList.DrawingStyle;
+      vImageType:= rImageList.ImageType;
+      vDrawOverlay:= True;
+      vOverlay:= AOverlay;
+      vDrawEffect:= EffectMap[AEnabled];
+
+      stdDraw:= True;
+      if Assigned(rImageList.FOnBeforeDraw)
+      then stdDraw:= rImageList.FOnBeforeDraw(rImageList, ACanvas, vRect, vIndex, vDrawingStyle, vImageType,
+                                              vDrawOverlay, vOverlay, vDrawEffect);
+
+      if stdDraw then
+      begin
+        if not(vDrawOverlay) then vOverlay:= 0;
+
+        if rImageList.rUseBGRADraw
+        then BGRADraw(ACanvas, vRect, vIndex, vOverlay, vDrawingStyle, vImageType, vDrawEffect,
+                      rImageList.BkColor, rImageList.BlendColor, True)
+        else begin
+               try
+                  Bmp := TBitmap.Create;
+                  {$ifdef FPC}
+                    GetBitmap(vIndex, Bmp, vDrawEffect);
+                  {$else}
+                    GetBitmapRaw(vIndex, Bmp, vDrawEffect);
+                  {$endif}
+                  ACanvas.StretchDraw(vRect, Bmp);
+
+                  if vDrawOverlay and (vOverlay > 0) then
+                  begin
+                    OverlayI := rImageList.Overlays[vOverlay];
+                    {$ifdef FPC}
+                      GetBitmap(OverlayI, Bmp, vDrawEffect);
+                    {$else}
+                      GetBitmapRaw(OverlayI, Bmp, vDrawEffect);
+                    {$endif}
+                    Bmp.Mask(rImageList.BkColor);
+                    ACanvas.StretchDraw(vRect, Bmp);
+                  end;
+
+               finally
+                 Bmp.Free;
+               end;
+             end;
+      end;
+
+      if Assigned(rImageList.FOnAfterDraw)
+      then rImageList.FOnAfterDraw(rImageList, ACanvas, vRect, vIndex, vDrawingStyle, vImageType,
+                                   vDrawOverlay, vOverlay, vDrawEffect);
+  end;
+end;
+
+procedure TBGRAImageList.SetUseBGRADraw(AValue: Boolean);
+begin
+  if (rUseBGRADraw<>AValue) then
+  begin
+    rUseBGRADraw:=AValue;
+    if Assigned(OnChange) then OnChange(Self);
+  end;
+end;
+
+function TBGRAImageList.GetResolution(AImageWidth: Integer): TBGRAImageListResolution;
+begin
+  Result := TBGRAImageListResolution(inherited GetResolution(AImageWidth));
+end;
+
+function TBGRAImageList.CreateEmptyBitmap(AImageWidth, AImageHeight: Integer; AHorizAlign: TAlignment;
+  AVertAlign: TTextLayout; var imgRect: TRect): TBitmap;
+var
+  rW, rH:Single;
+  newWidth,
+  newHeight:Integer;
+
+begin
+  if (AImageWidth > 0) and (AImageHeight > 0) then
+  begin
+    imgRect.Left:= 0;
+    imgRect.Top:= 0;
+
+    rW := AImageWidth / Width;
+    rH := AImageHeight / Height;
+
+    if (rW > rH)
+    then begin
+           newHeight:= round(AImageHeight / rW);
+           newWidth := Width;
+           end
+    else begin
+           newWidth := round(AImageWidth / rH);
+           newHeight := Height;
+         end;
+
+    case AHorizAlign of
+    taCenter: imgRect.Left:= (Width-newWidth) div 2;
+    taRightJustify: imgRect.Left:= Width-newWidth;
+    end;
+    case AVertAlign of
+    tlCenter: imgRect.Top:= (Height-newHeight) div 2;
+    tlBottom: imgRect.Top:= Height-newHeight;
     end;
-    else
+
+    imgRect.Right:= imgRect.Left+newWidth;
+    imgRect.Bottom:= imgRect.Top+newHeight;
+
+    Result := TBitmap.Create;
+    if (BkColor = clNone) then
     begin
-      {$IFDEF FPC}
-      GetBitmap(AIndex, FBmp, ADrawEffect);
-      {$ELSE}
-      GetBitmapRaw(AIndex, FBmp, ADrawEffect);
-      {$ENDIF}
-      FBGRA.Assign(FBmp);
+      Result.Transparent:= True;
+      Result.TransparentColor:= clNone;
     end;
+    Result.SetSize(Width, Height);
+    Result.Canvas.Brush.Color := BkColor;
+    Result.Canvas.FillRect(0, 0, Width, Height);
+  end;
+end;
+
+function TBGRAImageList.CreateProportionalImage(AImage: TCustomBitmap;
+  AHorizAlign: TAlignment; AVertAlign: TTextLayout): TBitmap;
+var
+   imgRect: TRect;
+   Bitmap, BitmapR :TBGRABitmap;
+
+begin
+  Result:= nil;
+
+  if (AImage <> nil) and (AImage.Width > 0) and (AImage.Height > 0) then
+  try
+     Result:= CreateEmptyBitmap(AImage.Width, AImage.Height, AHorizAlign, AVertAlign, imgRect);
+
+     //Use our Stretch since TBitmap's one sucks
+     Bitmap := TBGRABitmap.Create;
+     Bitmap.Assign(AImage);
+     BitmapR :=Bitmap.Resample(imgRect.Width, imgRect.Height);
+     BitmapR.Draw(Result.Canvas, imgRect, False);
+
+  finally
+    Bitmap.Free;
+    BitmapR.Free;
+  end;
+end;
+
+function TBGRAImageList.CreateProportionalImage(AImageFileName: String;
+  AHorizAlign: TAlignment; AVertAlign: TTextLayout): TBitmap;
+var
+   pict: TPicture;
+
+begin
+  Result:= nil;
+
+  if FileExists(AImageFileName) then
+  try
+     pict:= TPicture.Create;
+     pict.LoadFromFile(AImageFileName);
+     Result:= CreateProportionalImage(pict.Bitmap, AHorizAlign, AVertAlign);
+
+  finally
+    pict.Free;
+  end;
+end;
+
+function TBGRAImageList.CreateMaskImage(AImage: TCustomBitmap; MaskColor: TColor): TBitmap;
+begin
+  Result:= nil;
+  if (AImage <> nil) and (AImage.Width > 0) and (AImage.Height > 0) then
+  begin
+    Result := TBitmap.Create;
+    Result.Assign(AImage);
+    Result.TransparentColor := MaskColor;
+    Result.TransparentMode := tmFixed;
+    Result.Transparent := True;
+    Result.Masked:= True;
   end;
-  if ADrawingStyle in [dsFocus, dsSelected] then
-    FBGRA.ApplyGlobalOpacity(128);
-  FBGRA.Draw(ACanvas, AX, AY, False);
 end;
 
-{$ENDIF}
+function TBGRAImageList.CreateMaskImage(AImageFileName: String; MaskColor: TColor): TBitmap;
+var
+   //bmpBGRA: TBGRABitmap;
+   pict: TPicture;
+
+begin
+  Result:= nil;
+  if FileExists(AImageFileName) then
+  try
+    (*bmpBGRA:= TBGRABitmap.Create;
+    bmpBGRA.LoadFromFile(AImageFileName);
+    Result := bmpBGRA.MakeBitmapCopy(MaskColor, False);
+    *)
+    pict:= TPicture.Create;
+    pict.LoadFromFile(AImageFileName);
+    Result:=TBitmap.Create;
+    Result.Assign(pict.Bitmap);
+    Result.TransparentColor := MaskColor;
+    Result.TransparentMode := tmFixed;
+    Result.Transparent := True;
+    Result.Masked:= True;
+
+  finally
+    pict.Free;
+    //bmpBGRA.Free;
+  end;
+end;
+
+function TBGRAImageList.CreateProportionalMaskImage(AImage: TCustomBitmap; MaskColor: TColor;
+  AHorizAlign: TAlignment; AVertAlign: TTextLayout): TBitmap;
+var
+   MaskBmp: TBitmap;
+
+begin
+  try
+     MaskBmp:= CreateMaskImage(AImage, MaskColor);
+     Result:= CreateProportionalImage(MaskBmp, AHorizAlign, AVertAlign);
+     Result.TransparentColor:= MaskBmp.TransparentColor;
+
+  finally
+    MaskBmp.Free;
+  end;
+end;
+
+function TBGRAImageList.CreateProportionalMaskImage(AImageFileName: String; MaskColor: TColor;
+  AHorizAlign: TAlignment; AVertAlign: TTextLayout): TBitmap;
+var
+   MaskBmp: TBitmap;
+
+begin
+  try
+     MaskBmp:= CreateMaskImage(AImageFileName, MaskColor);
+     Result:= CreateProportionalImage(MaskBmp, AHorizAlign, AVertAlign);
+     Result.TransparentColor:= MaskBmp.TransparentColor;
+
+  finally
+    MaskBmp.Free;
+  end;
+end;
+
+function TBGRAImageList.GetResolutionClass: TCustomImageListResolutionClass;
+begin
+  Result := TBGRAImageListResolution;
+end;
+
+procedure TBGRAImageList.ReadData(AStream: TStream);
+begin
+ inherited ReadData(AStream);
+end;
+
+procedure TBGRAImageList.LoadFromFile(const AFilename: string);
+begin
+  LoadFromFileUTF8(SysToUtf8(AFilename));
+end;
+
+procedure TBGRAImageList.LoadFromFileUTF8(const AFilenameUTF8: string);
+var
+   stream: TFileStreamUTF8;
+
+begin
+  stream := TFileStreamUTF8.Create(AFilenameUTF8, fmOpenRead or fmShareDenyWrite);
+  try
+     ReadData(stream);
+  finally
+    stream.Free;
+  end;
+end;
+
+procedure TBGRAImageList.SaveToFile(const AFilename: string);
+begin
+  SaveToFileUTF8(SysToUtf8(AFilename));
+end;
+
+procedure TBGRAImageList.SaveToFileUTF8(const AFilenameUTF8: string);
+var
+  stream: TFileStreamUTF8;
+begin
+   stream := TFileStreamUTF8.Create(AFilenameUTF8, fmCreate);
+   try
+     WriteData(stream);
+   finally
+     stream.Free;
+   end;
+end;
+
+{$if lcl_fullversion>=4990000}
+procedure TBGRAImageList.ReadData(AStream: TStream; AIndex: Integer;
+  StartStreamPos: Int64; CalcPos: Boolean);
+begin
+  GetResolution(Width).ReadData(AStream, AIndex, StartStreamPos, CalcPos);
+end;
+
+procedure TBGRAImageList.WriteData(AStream: TStream);
+begin
+  if (csDesigning in ComponentState)
+  then inherited WriteData(AStream)
+  else GetResolution(Width).WriteData(AStream, False); // don't compress data so we can write the image n without rewriting everything.
+end;
+
+procedure TBGRAImageList.WriteData(AStream: TStream; AIndex: Integer;
+  StartStreamPos: Int64; CalcPos: Boolean);
+begin
+  GetResolution(Width).WriteData(AStream, AIndex, StartStreamPos, CalcPos);
+end;
+
+procedure TBGRAImageList.LoadFromFile(const AFilename: string; AIndex: Integer;
+  StartStreamPos: Int64; CalcPos: Boolean);
+begin
+  LoadFromFileUTF8(SysToUtf8(AFilename), AIndex, StartStreamPos, CalcPos);
+end;
+
+procedure TBGRAImageList.LoadFromFileUTF8(const AFilenameUTF8: string; AIndex: Integer;
+  StartStreamPos: Int64; CalcPos: Boolean);
+var
+   stream: TFileStreamUTF8;
+
+begin
+  stream := TFileStreamUTF8.Create(AFilenameUTF8, fmOpenRead or fmShareDenyWrite);
+  try
+     ReadData(stream, AIndex, StartStreamPos, CalcPos);
+  finally
+    stream.Free;
+  end;
+end;
+
+procedure TBGRAImageList.SaveToFile(const AFilename: string; AIndex: Integer;
+  StartStreamPos: Int64; CalcPos: Boolean);
+begin
+  SaveToFileUTF8(SysToUtf8(AFilename), AIndex, StartStreamPos, CalcPos);
+end;
+
+procedure TBGRAImageList.SaveToFileUTF8(const AFilenameUTF8: string; AIndex: Integer;
+  StartStreamPos: Int64; CalcPos: Boolean);
+var
+  stream: TFileStreamUTF8;
+begin
+   stream := TFileStreamUTF8.Create(AFilenameUTF8, fmOpenReadWrite);
+   try
+     WriteData(stream, AIndex, StartStreamPos, CalcPos);
+   finally
+     stream.Free;
+   end;
+end;
+
+{$else}
+procedure TBGRAImageList.Overlay(AIndex: Integer; AOverlay: TOverlay);
+begin
+  TImageList(Self).Overlay(AIndex, AOverlay);
+  rOverlays[AOverlay] := AIndex;
+end;
+{$endif}
+
+procedure TBGRAImageList.StretchDrawOverlay(ACanvas: TCanvas; AIndex: Integer; ARect: TRect; AOverlay: TOverlay;
+  AEnabled: Boolean);
+begin
+  GetResolution(Width).StretchDrawOverlay(ACanvas, AIndex, ARect, AOverlay, AEnabled);
+end;
+
+function TBGRAImageList.AddProportionally(Image: TCustomBitmap; Mask: TCustomBitmap; AHorizAlign: TAlignment;
+  AVertAlign: TTextLayout): Integer;
+begin
+  try
+     Result:= Count;
+     InsertProportionally(Result, Image, Mask, AHorizAlign, AVertAlign);
+  except
+     Result:= -1;
+  end;
+end;
+
+function TBGRAImageList.AddProportionally(AImageFileName: String; AMaskFileName: String; AHorizAlign: TAlignment;
+  AVertAlign: TTextLayout): Integer;
+begin
+  try
+     Result := Count;
+     InsertProportionally(Result, AImageFileName, AMaskFileName, AHorizAlign, AVertAlign);
+  except
+     Result:= -1;
+  end;
+end;
+
+function TBGRAImageList.AddMaskedProportionally(Image: TCustomBitmap; MaskColor: TColor; AHorizAlign: TAlignment;
+  AVertAlign: TTextLayout): Integer;
+begin
+  try
+     Result := Count;
+     InsertMaskedProportionally(Result, Image, MaskColor, AHorizAlign, AVertAlign);
+  except
+    Result:= -1;
+  end;
+end;
+
+function TBGRAImageList.AddMaskedProportionally(AImageFileName: String; MaskColor: TColor; AHorizAlign: TAlignment;
+  AVertAlign: TTextLayout): Integer;
+begin
+  try
+     Result := Count;
+     InsertMaskedProportionally(Result, AImageFileName, MaskColor, AHorizAlign, AVertAlign);
+  except
+    Result:= -1;
+  end;
+end;
+
+
+procedure TBGRAImageList.InsertProportionally(AIndex: Integer; AImage: TCustomBitmap; AMask: TCustomBitmap;
+  AHorizAlign: TAlignment; AVertAlign: TTextLayout);
+var
+   Bmp,
+   BmpMask: TBitmap;
+
+begin
+  try
+     BmpMask := CreateProportionalImage(AMask, AHorizAlign, AVertAlign);
+     Bmp := CreateProportionalImage(AImage, AHorizAlign, AVertAlign);
+     Insert(AIndex, Bmp, BmpMask);
+
+  finally
+    BmpMask.Free;
+    Bmp.Free;
+  end;
+end;
+
+procedure TBGRAImageList.InsertProportionally(AIndex: Integer; AImageFileName: String; AMaskFileName: String;
+  AHorizAlign: TAlignment; AVertAlign: TTextLayout);
+var
+   Bmp,
+   BmpMask: TBitmap;
+
+begin
+  try
+     BmpMask := CreateProportionalImage(AMaskFileName, AHorizAlign, AVertAlign);
+     Bmp := CreateProportionalImage(AImageFileName, AHorizAlign, AVertAlign);
+     Insert(AIndex, Bmp, BmpMask);
+
+  finally
+    BmpMask.Free;
+    Bmp.Free;
+  end;
+end;
+
+procedure TBGRAImageList.InsertMaskedProportionally(AIndex: Integer; AImage: TCustomBitmap; MaskColor: TColor;
+  AHorizAlign: TAlignment; AVertAlign: TTextLayout);
+var
+   BmpMask: TBitmap;
+
+begin
+  try
+     BmpMask := CreateProportionalMaskImage(AImage, MaskColor, AHorizAlign, AVertAlign);
+     InsertMasked(AIndex, BmpMask, MaskColor);
+
+  finally
+     BmpMask.Free;
+  end;
+end;
+
+procedure TBGRAImageList.InsertMaskedProportionally(AIndex: Integer; AImageFileName: String; MaskColor: TColor;
+  AHorizAlign: TAlignment; AVertAlign: TTextLayout);
+var
+   BmpMask: TBitmap;
+
+begin
+  try
+     BmpMask:= CreateProportionalMaskImage(AImageFileName, MaskColor, AHorizAlign, AVertAlign);
+     InsertMasked(AIndex, BmpMask, MaskColor);
+
+  finally
+    BmpMask.Free;
+  end;
+end;
+
+procedure TBGRAImageList.ReplaceProportionally(AIndex: Integer; AImage: TCustomBitmap; AMask: TCustomBitmap;
+  const AllResolutions: Boolean; AHorizAlign: TAlignment; AVertAlign: TTextLayout);
+var
+   Bmp,
+   BmpMask: TBitmap;
+
+begin
+  try
+     BmpMask := CreateProportionalImage(AMask, AHorizAlign, AVertAlign);
+     Bmp := CreateProportionalImage(AImage, AHorizAlign, AVertAlign);
+     Replace(AIndex, Bmp, BmpMask, AllResolutions);
+
+  finally
+    BmpMask.Free;
+    Bmp.Free;
+  end;
+end;
+
+procedure TBGRAImageList.ReplaceProportionally(AIndex: Integer; AImageFileName: String; AMaskFileName: String;
+  const AllResolutions: Boolean; AHorizAlign: TAlignment; AVertAlign: TTextLayout);
+var
+   Bmp,
+   BmpMask: TBitmap;
+
+begin
+  try
+     BmpMask := CreateProportionalImage(AMaskFileName, AHorizAlign, AVertAlign);
+     Bmp := CreateProportionalImage(AImageFileName, AHorizAlign, AVertAlign);
+     Replace(AIndex, Bmp, BmpMask, AllResolutions);
+
+  finally
+    BmpMask.Free;
+    Bmp.Free;
+  end;
+end;
+
+procedure TBGRAImageList.ReplaceMaskedProportionally(AIndex: Integer; AImage: TCustomBitmap; MaskColor: TColor;
+  const AllResolutions: Boolean; AHorizAlign: TAlignment; AVertAlign: TTextLayout);
+var
+   BmpMask: TBitmap;
+
+begin
+  try
+     BmpMask := CreateProportionalMaskImage(AImage, MaskColor, AHorizAlign, AVertAlign);
+     ReplaceMasked(AIndex, BmpMask, MaskColor, AllResolutions);
+
+  finally
+    BmpMask.Free;
+  end;
+end;
+
+procedure TBGRAImageList.ReplaceMaskedProportionally(AIndex: Integer; AImageFileName: String; MaskColor: TColor;
+  const AllResolutions: Boolean; AHorizAlign: TAlignment; AVertAlign: TTextLayout);
+var
+   BmpMask: TBitmap;
+
+begin
+  try
+     BmpMask := CreateProportionalMaskImage(AImageFileName, MaskColor, AHorizAlign, AVertAlign);
+     ReplaceMasked(AIndex, BmpMask, MaskColor, AllResolutions);
+
+  finally
+     BmpMask.Free;
+  end;
+end;
+
+constructor TBGRAImageList.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  {$ifdef BGRA_DRAW}
+    rUseBGRADraw:= True;
+  {$endif}
+end;
+
+destructor TBGRAImageList.Destroy;
+begin
+  if (FBGRA <> nil) then FBGRA.Free;
+  if (FBmp <> nil) then FBmp.Free;
+
+  inherited Destroy;
+end;
 
 end.

bgraknob.pas

@@ -6,7 +6,8 @@
 - Edivando S. Santos Brasil | [email protected]
   (Compatibility with delphi VCL 11/2018)
 - Sandy Ganz | [email protected]
-  (added range, sector, and other features)
+  Added range, sector, and other features
+  12/30/2024 - Added option for audio taper, and no position draw (kptNone)
 ***************************** END CONTRIBUTOR(S) *****************************}
 
 unit BGRAKnob;
@@ -22,8 +23,9 @@ uses
 
 type
   TBGRAKnobPositionType = (kptLineSquareCap, kptLineRoundCap, kptFilledCircle,
-    kptHollowCircle);
+    kptHollowCircle, kptNone);
   TKnobType = (ktRange, ktSector);
+  TKnobTaperType = (kttLinear, kttAudioSlow, kttAudioFast);
   TBGRAKnobValueChangedEvent = procedure(Sender: TObject; Value: single) of object;
 
   { TBGRAKnob }
@@ -42,6 +44,7 @@ type
     FPositionType: TBGRAKnobPositionType;
     FPositionWidth: single;
     FSettingAngularPos: boolean;
+    FTaperType: TKnobTaperType;
     FUsePhongLighting: boolean;
     FMinValue, FMaxValue: single;        // Knob Values
     FStartAngle, FEndAngle: single;      // Knob Angles
@@ -54,6 +57,8 @@ type
     FReverseScale: boolean;
     FSectorDivisions: integer;           // Computed internally from FMinValue/FMaxValue
 
+    function AudioTaperMapping(x, K : single): single;
+    function InverseAudioTaperMapping(y, K : single): single;
     procedure CreateKnobBmp;
     function GetLightIntensity: integer;
     function GetValue: single;
@@ -78,6 +83,7 @@ type
     procedure SetKnobColor(const AValue: TColor);
     procedure SetWheelSpeed(AValue: byte);
     procedure SetReverseScale(AValue: boolean);
+    procedure SetTaperType(AValue: TKnobTaperType);
 
   protected
     { Protected declarations }
@@ -126,6 +132,7 @@ type
     property StartAngle: single read FStartAngle write SetStartAngle default 30;
     property EndAngle: single read FEndAngle write SetEndAngle default 330;
     property KnobType: TKnobType read FKnobType write SetKnobType default ktRange;
+    property TaperType: TKnobTaperType read FTaperType write SetTaperType default kttLinear;
     property Value: single read GetValue write SetValue nodefault;
     property OnValueChanged: TBGRAKnobValueChangedEvent
       read FOnKnobValueChange write FOnKnobValueChange;
@@ -148,7 +155,7 @@ type
   {$ENDIF}
 
 const
-  VERSIONSTR = '2.11';      // knob version
+  VERSIONSTR = '2.2';      // knob version
 
 implementation
 
@@ -157,6 +164,8 @@ uses Math;
 const
   WHEELSPEEDFACTOR = 20.0;  // used to calculate mouse wheel speed
   WHEELSPEEDBASE = 300;
+  AUDIO_TAPER_SLOW_K = 8;
+  AUDIO_TAPER_FAST_K = 4;
 
 {$IFDEF FPC}
 procedure Register;
@@ -167,7 +176,75 @@ end;
 
 { TBGRAKnob }
 
+// AudioTaperMapping will estimate the curve of an Audio Taper
+// potentiometer. The value of 'x' typically from a linear set
+// and is mapped to a curve that will simulate the curve
+// of an Audio taper potentiometer. A few types of exists, but
+// for here we are looking at 10% of the Max Value as 'AudioSlow'
+// when knob at 50%. 'AudioFast' is the same but at 50% the
+// value is at 15% of Max.
+// Typically the Max should be at 100 and Min at 0 for this
+// to make sense. Other values may not do what you think.
+//
+// The value to be mapped is 'x', and the factor 'K' is
+// how 'curvey' the line is.
+//
+// For MinValue = 0 and MaxValue = 100 Below are the goal
+//
+// For values of K = 8, this gives a slow acting curve
+// where at mid position (50%) the value is around 10% of
+// the Max.
+//
+// For values of K = 4, this gives a faster acting curve
+// where at mid position (50%) the value is around 15% of
+// the Max.
+//
+// The Mapping/Inverse must both use the same 'K'
+//
+// While MinValue and MaxValue can be anything, typically
+// MinValue = 0, and MaxValue 100. Think in percent. Experiment
+// and see. MinValue = 0, and MaxValue = 1.0 also works well.
+
+// Linear to AudioTaper
+function TBGRAKnob.AudioTaperMapping(x, K : single): single;
+var
+  sign_change : single;
+begin
+  // simple version
+  sign_change := 1;
+  if x < 0 then
+  begin
+    x := abs(x);
+    sign_change := -1;
+  end;
+  x := x / FMaxValue; // scale
+
+  // Simulate the curve from a linear space
+  Result := x / (1 + (1 - x) * K) * FMaxValue * sign_change;
+end;
+
+// Same Idea here but the inverse so we can map back an Audio taper
+// value back to a linear one for the knob to be set.
+
+function TBGRAKnob.InverseAudioTaperMapping(y, K : single): single;
+var
+  sign_change : single;
+begin
+  sign_change := 1;
+  if y < 0 then
+  begin
+    y := abs(y);
+    sign_change := -1;
+  end;
+  y := y / FMaxValue; // scale
+
+  // reverse the curve to a linear space
+
+  Result :=  (y + y * K) / (1 + y * K) * FMaxValue * sign_change;
+end;
+
 // Override the base class which has a rectangular dimension, odd for a knob
+
 class function TBGRAKnob.GetControlClassDefaultSize: TSize;
 begin
   Result.CX := 50;
@@ -211,16 +288,20 @@ begin
       begin
 
         //compute vector between center and current pixel
+
         v := PointF(xb, yb) - center;
 
         //scale down to unit circle (with 1 pixel margin for soft border)
+
         v.x := v.x / (tx / 2 + 1);
         v.y := v.y / (ty / 2 + 1);
 
         //compute squared distance with scalar product
+
         d2 := v {$if FPC_FULLVERSION < 30203}*{$ELSE}**{$ENDIF} v;
 
         //interpolate as quadratic curve and apply power function
+
         if d2 > 1 then
           h := 0
         else
@@ -268,6 +349,13 @@ begin
   if FKnobType = ktSector then
     Result := Round(Result);
 
+  // After all the mess above, map it to AudioTaper curves if needed.
+
+  if FTaperType = kttAudioSlow THEN
+    Result := AudioTaperMapping(Result, AUDIO_TAPER_SLOW_K)
+  else
+      if FTaperType = kttAudioFast THEN
+        Result := AudioTaperMapping(Result, AUDIO_TAPER_FAST_K)
 end;
 
 function TBGRAKnob.AngularPosToDeg(RadPos: single): single;
@@ -426,7 +514,16 @@ procedure TBGRAKnob.SetValue(AValue: single);
 var
   NewAngularPos: single;
 begin
-  // AValue in the range of FStartAngle and FEndAngles after the mapping
+
+  // first things, if we are doing audio taper, then inverse map it
+
+  if FTaperType = kttAudioSlow THEN
+    AValue := InverseAudioTaperMapping(AValue, AUDIO_TAPER_SLOW_K)
+  else
+      if FTaperType = kttAudioFast THEN
+        AValue := InverseAudioTaperMapping(AValue, AUDIO_TAPER_FAST_K);
+
+  // carry on with range checks, AValue is in user space not degrees until later
 
   if AValue > FMaxValue then
     AValue := FMaxValue;
@@ -598,6 +695,14 @@ begin
 
   // No other changes for ktRange mode
 end;
+procedure TBGRAKnob.SetTaperType(AValue: TKnobTaperType);
+begin
+  if FTaperType = AValue then
+    Exit;
+
+  FTaperType := AValue;
+  Invalidate;
+end;
 
 procedure TBGRAKnob.SetPositionColor(const AValue: TColor);
 begin
@@ -725,12 +830,14 @@ var
 begin
   if (ClientWidth = 0) or (ClientHeight = 0) then
     exit;
+
   if FKnobBmp = nil then
   begin
     CreateKnobBmp;
     if FKnobBmp = nil then
       Exit;
   end;
+
   Bmp := TBGRABitmap.Create(ClientWidth, ClientHeight);
   Bmp.BlendImage(0, 0, FKnobBmp, boLinearBlend);
 
@@ -805,6 +912,7 @@ begin
   FPositionWidth := 4;
   FPositionMargin := 4;
   FPositionType := kptLineSquareCap;
+  FTaperType := kttLinear;  // Should be default for compatibility
   FUsePhongLighting := True;
   FOnKnobValueChange := nil;
   FStartFromBottom := True;
@@ -876,6 +984,11 @@ var
 begin
   // WheelSpeed is a Base Value and a factor to slow or speed up the wheel affect.
   // FWheelSpeed = 0 then no wheel, 1 slowest movement, 255 fastest movement
+  //
+  // Note if Mouse Wheel is used in AudioSlow or AudioFast mode, the wheel
+  // will not be compensated so will seem faster at 0 side, and slower as
+  // it gets to the MaxValue since it's values curved. (assumes 0min, 100max)
+  // Setting the wheel speed to a low value (like 1) will help these modes
 
   if FWheelSpeed > 0 then
   begin

bgrapascalscriptcomponent.lpk

@@ -11,7 +11,7 @@
         <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
       </SearchPaths>
     </CompilerOptions>
-    <Version Major="9" Release="1" Build="6"/>
+    <Version Major="9" Release="1" Build="7"/>
     <Files Count="3">
       <Item1>
         <Filename Value="bgrapascalscript.pas"/>

bgrascript.pas

@@ -11,7 +11,9 @@
 
 unit BGRAScript;
 
+{$DEFINE RO_FPC_MODE_SET}
 {$I bgracontrols.inc}
+
 { $define debug}
 
 interface

bgraspriteanimation.pas

@@ -21,8 +21,12 @@ unit BGRASpriteAnimation;
 interface
 
 uses
-  Classes, Controls, Dialogs, ExtCtrls, Forms, {$IFDEF FPC}LCLIntF, LResources,{$ENDIF} Graphics,
-  {$IFNDEF FPC}Types, BGRAGraphics, GraphType, FPImage, {$ENDIF}
+  Types, Classes, Controls, Dialogs, ExtCtrls, Forms, Graphics,
+  {$IFDEF FPC}
+  LCLIntF, LResources,
+  {$ELSE}
+  BGRAGraphics, GraphType, FPImage,
+  {$ENDIF}
   BCBaseCtrls, BGRABitmap, BGRABitmapTypes, BCTypes, BGRAAnimatedGif;
 
 type
@@ -455,7 +459,7 @@ begin
   Result := Rect(0, 0, PicWidth, PicHeight);
 
   if Center then
-    OffsetRect(Result, (ImgWidth - PicWidth) div 2, (ImgHeight - PicHeight) div 2);
+    Types.OffsetRect(Result, (ImgWidth - PicWidth) div 2, (ImgHeight - PicHeight) div 2);
 end;
 
 function TBGRASpriteAnimation.DoCalculatePosition(AValue: integer): integer;

icons/bcmaterialedit_icon.lrs

@@ -0,0 +1,34 @@
+LazarusResources.Add('tbcmaterialedit','PNG',[
+  #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
+  +#0#0#9'pHYs'#0#0#7'a'#0#0#7'a'#1#149#195#184#182#0#0#0#25'tEXtSoftware'#0'ww'
+  +'w.inkscape.org'#155#238'<'#26#0#0#2#172'IDATH'#137#237#149'OH'#147'a'#28#199
+  +'?'#207#243'n3c'#17#11#243' Z'#25'L3f'#193#24'3'#146#236'0'#186#152#176'C^'#4
+  +#237#16#226#193'K '#130#183#152#130#160'''A'#193#13'v'#237'`t'#200#131#196
+  +#148#14#5#217#31')$J'#146#130#23'J'#139#13'u'#27'&c'#239#182#247'};'#168'o'
+  +#193#140#237#208':'#245';>'#207#247#247'|~'#127#158#223#243#8#211'4'#169#164
+  +#201#138#158#254'/'#0'6'#160#162'5'#146#0#15#158#23#200#21#138'7'#239'?'#203
+  +#163'&'#140#162#245'l'#30'&'#31#229#202#2#216#0#22#222#20#184#233'Sp'#216#4
+  +#143#223#22'X^'#215#233#185'fGM'#152#172#127#203's'#166'Fr''`'''#28#203#129
+  +#16#220#190'ncm'#163#24#252'G'#192#239'v'#226#184#192'a'#19'<|'#145'G'#145
+  +#130#192'%'#27#145'X'#14#151'S'#240#234#147#129#162#192#197#250#242'[g)'#159
+  +#188#211#249#240#213' 4'#167'Q{R'#160#31#4#184#252'Qg/'#11#231'j'#5'Uv'#184
+  +'u'#197'FS]'#249#0'a'#154#166#249#250#179'N'#242#135'IC'#141#196'4A'#30#248
+  +#11'@7'#160#202#14'Mu'#146#181#13#131'x'#202#228#234#5#133#247'_t'#252'n'#165
+  +'<@'#217#225#148'0'#221#0#227' s'#251'A'#241'K'#230#26#137'Dp'#187#221'e'#1
+  +'^'#174#235#220#155#211'x'#186#166's'#24'vI@:'#157'FU'#213#178#0'u'#167#4'Mu'
+  +#146#27#151#127#149#206#2'$'#147'Iz{{'#241'x<ttt'#16#139#197','#145#195#225
+  +'`||'#28#191#223#207#232#232#168#181#30#14#135'ikk'#195#231#243#17#141'F'#143
+  +#132'Z'#0#151#203#133#215#235'ejj'#10#167#211'I__'#159'%'#202'f'#179'lmm'#209
+  +#222#222'N('#20'bii'#137#197#197'E'#6#7#7#241#251#253#244#247#247#211#220#220
+  +'|$'#192#154#131'T*E:'#157'fvv'#22'UU'#217#222#222'F'#211'4K811'#129#162'('
+  +#204#204#204#176#178#178#194#238#238'.'#213#213#213'LOO#'#132#0'@'#141#23#15
+  +#159#149#193#208#208#16#209'h'#148#225#225'a'#186#187#187#139#132';;;h'#154
+  +#134'a'#24'H)'#145'R'#162#235':'#133#194#17'o'#204'Q'#25#28#138'WWW'#153#159
+  +#159'/'#18#14#12#12#160'('#10#166'i'#18#8#4#200'd2LNN'#18#12#6'iii'#161#190
+  +#190#158'`'#207#221'"?%'#20#10#133#0'|>'#31#137'D'#130'x<'#206#216#216#24'RJ'
+  +#186#186#186#200'd2'#180#182#182#226#245'z'#217#220#220'ddd'#132#206#206'N'
+  +#26#27#27#241'x<'#168#170'J6'#155'%'#24#12#162'8'#27'X'#223'48{Z'#226'<&'#16
+  +#226'/'#15#218#247#164'I<'#189#223#7#239#249#253#171'*'#166#23#180#138#254#7
+  +#194'='#184'WY'#192#255'O'#191#148#253#4'y`'#10#133#195'"|'#158#0#0#0#0'IEND'
+  +#174'B`'#130
+]);

icons/bcmaterialfloatspinedit_icon.lrs

@@ -0,0 +1,35 @@
+LazarusResources.Add('tbcmaterialfloatspinedit','PNG',[
+  #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
+  +#0#0#9'pHYs'#0#0#7'a'#0#0#7'a'#1#149#195#184#182#0#0#0#25'tEXtSoftware'#0'ww'
+  +'w.inkscape.org'#155#238'<'#26#0#0#2#221'IDATH'#137#237#149']HSq'#24#198#159
+  +#255'v'#142#163'c)'#225':'#193#200'4t'#218#188'Hg'#17#169'X'#248#209#197#12
+  +#132#144'!'#221't'#17'v'#227#141#16#4'F ]'#22#162#23'F'#172#242'&('#176#8'jA'
+  +#31#219'P(LK'#168#139'0I'#12#148#26#129#11'i'#204#156#206#179's'#246't'#161
+  +#140#173')'#13#201#174'z'#224#220#188#207#251#158#223'{'#222#255#199#17'$'
+  +#177#157'2m'#235#219#255#5'@'#2#176#173'32'#1#192#131#215':4='#211#188#247'*'
+  +#142#217'P"#'#30#139#3#215#30'kY'#1'$'#0'x'#250'N'#199#169'#f'#228'H'#2#207
+  +#223#235#24#155'6p'#166'^'#198'l'#136#152#254#22#199'~'#171#9#231#154'dx|'#26
+  +' '#4#206#158#144'0'#21#204#4'o'#10'H'#213'.E G'#18'x8'#30#135#217'$'#208'tH'
+  +#194'M'#159#134#221';'#5#222#206'$`6'#3#21#251#178'_'#186'd'#230#240#7#3#31
+  +#191'&p'#229#254'*'#212'|'#1'c'#189#193#177'O'#6#150'b@'#177'*`'#145#129#182
+  +'c'#18#202'l'#217#3#4'IN|6'#240#227'''Qh5'#129#4'L'#235#245#2#128#145#0',2Pf'
+  +'3a*'#152#192'|'#152#168'=h'#198#228#23#3'G'#237#230#236#0'Y'#183#179#5'e'
+  +#172#193#194#194#2#188'^/VVV'#208#220#220#12#135#195#145'Q'#164#235':'#252'~'
+  +'?fffPYY'#137#198#198#198#164#231#157#208'Qh'#21'8\'#178#254'uLQ8'#28#166#213
+  +'j'#165#205'fcII'#9#21'E'#225#228#228'dj'#10#23#23#23#233't:'#169#170'*].'#23
+  +#7#6#6#146'^4'#150'`'#221#165'(O_]'#166#145'X'#139#165#1'Hr||'#156#154#166'1'
+  +#20#10#17#0'='#30'O'#154#223#211#211'C'#187#221#206'H$'#242'{)'#251#158#172
+  +#210#222#185'D{'#231#18#31#189#137#147'$3'#182'CMM'#13'dYF '#16#128'$I'#168
+  +#175#175'O'#243'GFFPTT'#132#186#186':TTT`hh'#8#0#176#26#7#230#195#132#171'Z'
+  +#130#171':'#229#156'd'#180'Artt'#148#138#162#176#175#175'/'#195'+//gqq1'#135
+  +#135#135#217#218#218'JUUI'#146'1'#141#188#29#208'x'#203#191#246#220'}'#169'm'
+  +'>'#162#188#188'<'#246#246#246'n'#196'fCC'#3#219#218#218'H'#146#30#143#135#0
+  +#24#141'FI'#146#23#239#196#146'#'#186#241'b'#3#192#220#220#28#243#243#243#169
+  +#170'*'#221'n7'#221'n7'#251#251#251#233#243#249'XUU'#197'`0'#200#193#193'A'
+  +#202#178#204#174#174'.'#150#150#150#178#182#182'6Y'#255'='#146#160#243'B'#148
+  +#199'/G'#185#188#186#22'K'#219#166#134'a'#160#189#189'=m'#230#185#185#185'(('
+  +'('#128#195#225#128#162'('#232#232#232#128#197'b'#129#207#231'CKK'#11#186#187
+  +#187#147#185'{'#242#4#206#159#148'q`'#175#192#142#156#181#216'_?hq'#29#144'S'
+  +#218#150#174'?'#203#238#218#221#170#132#189'si['#175#10#241#255#167#255''''
+  +#253#2'*B'#18'4'#147#29#1'K'#0#0#0#0'IEND'#174'B`'#130
+]);

icons/bcmaterialspinedit_icon.lrs

@@ -0,0 +1,35 @@
+LazarusResources.Add('tbcmaterialspinedit','PNG',[
+  #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
+  +#0#0#9'pHYs'#0#0#7'a'#0#0#7'a'#1#149#195#184#182#0#0#0#25'tEXtSoftware'#0'ww'
+  +'w.inkscape.org'#155#238'<'#26#0#0#2#198'IDATH'#137#237'UOH'#147'a'#28'~'#222
+  +'o'#223#220#154#173#8#157#225'l'#163#153#127'b'#202' '#219'"'#10#235' '#19'd'
+  +#7#137#220#161'KB'#224#197#131#135'A'#7#233#210#177'@A'#200#168'v'#10#234'P'
+  +#134'e'#208#159'-s6'#205'J'#168'CTLJ'#132#146'@'#3#147'h'#147#237#219#246'='
+  +#29#28#31#198'X'#14'i'#157'z'#224#189'<'#239#251#188#207#239#207#251'G'#144
+  +'D)!'#149't'#247#127'a '#3'(i'#141'$'#0#184#253'<'#3'%'#147'?y3'#154#198#194
+  +#178#154#199''''#211#192#197'{JQ'#6'2'#0'<x'#157#129#207#173'C'#153','#240
+  +#232'M'#6'3sY'#156'j'#213'ca'#153#152#251#154#134#189'R'#194#153'6='#174#132
+  +#20'@'#8#156'>.'#227#195'b'#190'qA'#131#141'0'#155#4#202'd'#129';/'#210#208
+  +'I'#2'm.'#25'WC'#10'vm'#23'x'#245'Q'#133'N'#7'8'#247#20#223':m'#229#211#183
+  +'Y'#188#255#162#226#252#173#20#170'v'#10'ds'#1#206#196#178#136''''#129#189'U'
+  +#2#6'=p'#242#176#140#6'k'#241#6#130'$g?e'#241#253'''a'#171#148'@'#2'RN/'#0'd'
+  +'U'#192#160#7#26#172#18'>,'#170'XZ%'#142#236#215#225#221#231','#14#213#235
+  +#138'3(:'#156'- '#175#7#27#17#139#197'0>>'#14#147#201#132#206#206'NX,'#22#0
+  +#128#162'('#8#133'B'#152#159#159#135#199#227'Akk'#171#166#25#155#205#192'V)p'
+  +'p_.;'#22'@4'#26#165'$It:'#157#172#168#168'`mm-'#21'E'#225#202#202#10#157'N'
+  +''''#171#171#171#233#243#249#24#12#6'5M"'#169#242'h'#127#130'''.'#172'1'#171
+  +#174's'#5#13'TU'#229#212#212#20'Irdd'#132#0#24#139#197#24#8#4#232'r'#185#24
+  +#143#199#243'4'#131#247'S'#172#239#141#179#190'7'#206#187'/'#211'$'#201#130
+  +#199'A'#8#161#165#30#14#135'a'#179#217'PWW'#135#137#137#9'X'#173'V'#184#221
+  +'n477cll'#12#0#144'J'#3'K'#171'DG'#139#140#142#150#13#247#164'P'#6'ZT'#131
+  +#131'4'#153'L'#156#158#158'&I'#214#212#212#176#177#177#145#145'H'#132'^'#175
+  +#151#14#135#131'$'#153'T'#200#224#19#133#215#194#235#227#198'3'#229#207'%"'
+  +#201#225#225'a'#154#205'fNNNj'#156#199#227'aww7Ir``'#128#178',SU'#215#11'~'
+  +#246'zR+'#209#229#199#155#24#140#142#142'R'#8#193#166#166'&'#250#253'~'#250
+  +#253'~'#134#195'a'#14#13#13#209'h42'#16#8#208'n'#183#179#189#189']'#211'|'
+  +#251#161#242'@ '#193'c'#231#18'\K'#173's'#5#143#169#209'hDOO'#207'o'#156#193
+  +'`@__'#31#202#203#203#17#137'D'#208#213#213#133#254#254'~m'#222#178'C'#160
+  +#199#171#135'c'#183#192#182#178'\/'#249#151'/Z:'#3#232'7'#132'-_zX'#220#179
+  +#187'U'#136#250#222'xI'#159#10#241#255#211#223#12#191#0#169#162#15#154#4#170
+  +#133#154#0#0#0#0'IEND'#174'B`'#130
+]);

icons/supergauge.lrs

@@ -0,0 +1,58 @@
+LazarusResources.Add('tsupergauge','PNG',[
+  #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#3#0#0#0#215#169#205
+  +#202#0#0#3#0'PLTE'#255#255#255#255#255#255#128#128#128#185'wGooo~~~'#247#247
+  +#247'((('#5#5#5#18#18#18#253#253#253#16#16#16#12#12#12#174#174#174'555222{{{'
+  +#207#207#207#203#203#203'&&&333'#177#177#177#236#236#236#127#127#127#220#220
+  +#127'hhh'#231#231#231#134#134#128#9#9#9'>>>WWW'#214'))nnnTTTpppUUU'#13#13#13
+  +#217#217#217'vvvbbb'#214#214#214#222#222#222'sss'#218#218#218'ddd}}}www'#204
+  +#204#204#173#173#173#19#19#19'[[[jjj'#206#206#206'YYY'#212#212#212#223#223
+  +#223#202#202#202#132#132#132#180#180#180#141#141#141#220#220#220#252#252#252
+  +#245#245#245#163#163#163#183#183#183#134#134#134'!!!'#208#208#208#158#158#158
+  +'ZZZ'#130#130#130'+++'#172#172#172#227#227#227#152#152#152#159#159#159#145
+  +#145#145'rrr'#187#187#187#137#137#137#196#196#196#178#178#178#143#143#143#219
+  +#219#219#139#139#139'```'#149#149#149#149'kk'#167'xi'#210#210#210#205#205#205
+  +#160#159'{'#158#158#128'lll'#168#168#168#180'LL'#195#135'b'#164#164#128#158
+  +#158'|'#177#177#128#136#136#136#182#129'['#169'uO'#209'..'#198#181'w'#147#147
+  +#128#130#130'r'#199#198#127#185#129'X'#175'vM'#134'zz'#175#175#175#217#217
+  +#127'|||///xxx'#219#219#127#129#129#128'   '#198'99'#180'zc'#191#191#127'444'
+  +#175#175#128#178#178#128#176'OO'#196'A>'#242#242#242'SSS'#226#226#226'yyx'
+  +#211#210#127#157#157#128#143'pp'#206'11'#194'EA'#216#216#127#153#153#128#29
+  +#29#29'yyy,,,'#131#131#128#209#208#127#189#189#128#213'Z*'#205'32'#184#143'l'
+  +#151#151#128#225#225#225#166#166#166#165#165#128#215#214#127#210#209#127#188
+  +#188#128#212#146'G'#221#140'?'#208#205'~'#216#215#127#181#181#128#132#132#128
+  +'AAA'#133#133#128#155#155#128#204#137'G'#201#134'G'#137#137#128'BBB999666'''
+  +'''''zzz888'#30#30#30#164#164#164#184#184#184'aaa'#152#152#128#209#209#209
+  +#174#174#128#239#239#127#237#237#237#153'gg'#200'77'#246#9#9#201'66'#163#148
+  +'y'#138#138#138#194#194#127#167#167#128#198#198#127#239'`'#17#245#10#10#236
+  +#19#19#194'=='#157#128'q'#165#165#128#214#213#127#144#144#128#225's!'#231'p'
+  +#28#170#145's'#188#188#128#224#223#127#189#189#128#137#137#128#204#203#127
+  +#229#229#127#253#142' '#251#141' '#223#222#127#199#199#127#164#164#128#132
+  +#132#128'vvv'#182#182#182't'#0'x;'#0'*.'#0'pp'#0't;'#0'*.'#0'po'#0'tx'#0';*'
+  +#0'.p'#0'ot'#0'|M'#0'ic'#0'ro'#0'so'#0'ft'#0' X'#0'PS'#0' ('#0'*.'#0'xp'#0's'
+  +')'#0' |'#0'*.'#0'xp'#0's|'#0#0#216'4'#29#134#2#0#0#0#0#0#0#0#232'4'#29#134#2
+  +#0#0#0#0#0#0#0#248'4'#29#134#2#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'Hw'#178#210#0
+  +#0#0#1'tRNS'#0'@'#230#216'f'#0#0#0#9'pHYs'#0#0#14#195#0#0#14#195#1#199'o'#168
+  +'d'#0#0#2'GIDAT('#145'b'#192#10#24#24#24#0#0#0#0#255#255#130'aF+'#29'vnnvW'#3
+  +'6'#16#143#129#129#1#0#0#0#255#255#130'b'#19'~v'#29#1#1#1#129#216#229'Nk'#25
+  +#24#24#24#24#24#0#0#0#0#255#255#130'`'#3'nWK('#136'eo`c```'#0#0#0#0#255#255#2
+  +'c+'#238'XKK'#203'E'#139#151','#181#180#180#20'X'#182#156#141#129#129#1#0#0#0
+  +#255#255#2#137'Kq'#235'XN'#155'>'#163#127#214#236'9'#211#231'YZZ.se``'#0#0#0
+  +#0#255#255#2'I4,'#179#156#211'oii'#201'<A'#190'm'#146'D'#166#165#0#251'Z'#6#6
+  +#0#0#0#0#255#255'b``'#208#148#17#152#190#8'd<3'#179'ek['#221#244'E'#150'ZNl'
+  +#12#0#0#0#0#255#255'b``'#208#226#175#6#25#0#150#176#180#172#173#147#176#180
+  +#228#183'b'#0#0#0#0#255#255'b``'#224'w'#149#128#184#8',aY^Qi'#25#235#202#0#0
+  +#0#0#255#255'b``'#224#206#202#134'H'#164#230#130#200'<'#249#233#150#2#236#12
+  +#0#0#0#0#255#255'b``'#144'I'#130#152#20#146#154'&'#0#162#219'22'#5'd'#24#0#0
+  +#0#0#255#255#2'K'#128#173#182#212#210#138#213#2#209#241#9#211#4'd'#24#0#0#0#0
+  +#255#255#2#25#5#242#29'X'#6#194#8#143#200#20'`g'#0#0#0#0#255#255#2'Y'#222#0
+  +'2G'#211'D'#211'*DSS'#195#4'$'#167#163#195#0#0#0#0#255#255'b``'#176'd'#183
+  +#180#180'4'#144#10's1'#208'0'#177#12#3'K'#176#251'1'#0#0#0#0#255#255'b``'#168
+  +#151#137#5#233'`d[[o`ib'#226'bi'#233#202#207#200#0#0#0#0#255#255#2#5#137#150
+  +#147#128#165#149#149#165#137#137#134#137#165#149#166#165'e,'#183#9#3#3#0#0#0
+  +#255#255#2'G'#18'?'#191#192'Z'#19#13#141#176#16#13'M'#147#0'K'#29'n'#3#6#6#6
+  +#0#0#0#0#255#255#2#7'{='#191#19#204'e'#150#2#203#184#13#24#24#24#24#0#0#0#0
+  +#255#255#130'F'#172#150#12'{C'#172#128'@'#172'+'#191'L'#131#20#3#3#3#3#3#0#0
+  +#0#255#255#130#225'z'#129#229#220'22'#220#252'Z'#154' '#30#3#3#3#0#0#0#255
+  +#255#194#142#25#24#24#0#0#0#0#255#255#194#142#25#24#24#0#0#0#0#255#255#3#0']'
+  +#22']'#217#225'\&c'#0#0#0#0'IEND'#174'B`'#130
+]);

images/bgracontrols_images_list.txt

@@ -7,6 +7,15 @@ tbcbutton_200.png
 tbclabel.png
 tbclabel_150.png
 tbclabel_200.png
+tbcmaterialedit.png
+tbcmaterialedit_150.png
+tbcmaterialedit_200.png
+tbcmaterialspinedit.png
+tbcmaterialspinedit_150.png
+tbcmaterialspinedit_200.png
+tbcmaterialfloatspinedit.png
+tbcmaterialfloatspinedit_150.png
+tbcmaterialfloatspinedit_200.png
 tbcmaterialdesignbutton.png
 tbcmaterialdesignbutton_150.png
 tbcmaterialdesignbutton_200.png
@@ -104,12 +113,12 @@ tbccombobox_200.png
 tbgrathemecheckbox.png
 tbgrathemecheckbox_150.png
 tbgrathemecheckbox_200.png
-tbcfluentprogressring.png
-tbcfluentprogressring_150.png
-tbcfluentprogressring_200.png
-tbcfluentslider.png
-tbcfluentslider_150.png
-tbcfluentslider_200.png
+TBCFluentProgressRing.png
+TBCFluentProgressRing_150.png
+TBCFluentProgressRing_200.png
+TBCFluentSlider.png
+TBCFluentSlider_150.png
+TBCFluentSlider_200.png
 TBCLeaLCDDisplay.png
 TBCLeaLCDDisplay_150.png
 TBCLeaLCDDisplay_200.png
@@ -133,4 +142,16 @@ TBCLeaBoard_150.png
 TBCLeaBoard_200.png
 TBCLeaEngrave.png
 TBCLeaEngrave_150.png
-TBCLeaEngrave_200.png
+TBCLeaEngrave_200.png
+tsupergauge.png
+tsupergauge_150.png
+tsupergauge_200.png
+tbcroundedimage.png
+tbcroundedimage_150.png
+tbcroundedimage_200.png
+tbgraopenpicturedialog.png
+tbgraopenpicturedialog_150.png
+tbgraopenpicturedialog_200.png
+tbgrasavepicturedialog.png
+tbgrasavepicturedialog_150.png
+tbgrasavepicturedialog_200.png

images/svg/tbcmaterialedit.svg

@@ -0,0 +1,126 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<!-- Created with Inkscape (http://www.inkscape.org/) -->
+
+<svg
+   width="48"
+   height="48"
+   viewBox="0 0 48 48"
+   version="1.1"
+   id="svg1"
+   sodipodi:docname="tbcmaterialedit.svg"
+   inkscape:version="1.4 (e7c3feb100, 2024-10-09)"
+   inkscape:export-filename="../tbcmaterialedit.png"
+   inkscape:export-xdpi="48"
+   inkscape:export-ydpi="48"
+   xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
+   xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
+   xmlns="http://www.w3.org/2000/svg"
+   xmlns:svg="http://www.w3.org/2000/svg">
+  <sodipodi:namedview
+     id="namedview1"
+     pagecolor="#505050"
+     bordercolor="#ffffff"
+     borderopacity="1"
+     inkscape:showpageshadow="0"
+     inkscape:pageopacity="0"
+     inkscape:pagecheckerboard="1"
+     inkscape:deskcolor="#505050"
+     inkscape:document-units="px"
+     inkscape:zoom="11.947158"
+     inkscape:cx="11.174206"
+     inkscape:cy="47.542688"
+     inkscape:window-width="2560"
+     inkscape:window-height="1371"
+     inkscape:window-x="0"
+     inkscape:window-y="0"
+     inkscape:window-maximized="1"
+     inkscape:current-layer="g2"
+     showgrid="false" />
+  <defs
+     id="defs1">
+    <rect
+       x="78.565514"
+       y="167.72414"
+       width="343.3931"
+       height="166.84138"
+       id="rect2" />
+  </defs>
+  <g
+     inkscape:label="Livello 1"
+     inkscape:groupmode="layer"
+     id="layer1">
+    <text
+       xml:space="preserve"
+       id="text1"
+       style="font-size:192px;text-align:start;writing-mode:lr-tb;direction:ltr;white-space:pre;shape-inside:url(#rect2);display:inline;fill:#ffffff;fill-opacity:1;stroke:#000000;stroke-width:5;stroke-dasharray:none;stroke-opacity:1;paint-order:markers fill stroke"><tspan
+         x="78.566406"
+         y="509.26244"
+         id="tspan6"><tspan
+           dx="0 15.253366 15.253366"
+           style="font-size:26.6667px"
+           id="tspan2">123</tspan></tspan></text>
+    <g
+       id="g2">
+      <g
+         id="g1">
+        <rect
+           style="fill:#ffffff;fill-opacity:1;stroke:none;stroke-width:3.24645;stroke-linejoin:round;stroke-miterlimit:10;stroke-dasharray:12.9858, 3.24645;stroke-dashoffset:3.24645;stroke-opacity:1;paint-order:markers fill stroke"
+           id="rect4"
+           width="47.989674"
+           height="36"
+           x="0"
+           y="6" />
+        <rect
+           style="fill:#256af4;fill-opacity:1;stroke:#256af4;stroke-width:0;stroke-linejoin:round;stroke-miterlimit:10;stroke-dasharray:none;stroke-dashoffset:0.880555;stroke-opacity:1;paint-order:markers fill stroke"
+           id="rect1"
+           width="48"
+           height="3"
+           x="0"
+           y="39" />
+        <text
+           xml:space="preserve"
+           style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:10.6667px;font-family:'Noto Sans';-inkscape-font-specification:'Noto Sans Bold';text-align:start;writing-mode:lr-tb;direction:ltr;text-anchor:start;fill:#256af4;fill-opacity:1;stroke:none;stroke-width:1.8;stroke-linejoin:round;stroke-miterlimit:10;stroke-dasharray:7.2, 1.8;stroke-dashoffset:1.8;stroke-opacity:1;paint-order:markers fill stroke"
+           x="1.539997"
+           y="16.606693"
+           id="text4"><tspan
+             sodipodi:role="line"
+             id="tspan4"
+             x="1.539997"
+             y="16.606693"
+             style="font-size:10.6667px;stroke-width:1.8">Label</tspan></text>
+        <text
+           xml:space="preserve"
+           style="font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:19.6246px;font-family:'Noto Sans';-inkscape-font-specification:'Noto Sans';text-align:start;writing-mode:lr-tb;direction:ltr;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;stroke-width:3.94244;stroke-linejoin:round;stroke-miterlimit:10;stroke-dasharray:15.7698, 3.94244;stroke-dashoffset:3.94244;stroke-opacity:1;paint-order:markers fill stroke"
+           x="3.6747451"
+           y="35.20821"
+           id="text3"><tspan
+             sodipodi:role="line"
+             id="tspan3"
+             x="3.6747451"
+             y="35.20821"
+             style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-family:'Noto Sans';-inkscape-font-specification:'Noto Sans Bold';fill:#000000;fill-opacity:1;stroke:none;stroke-width:3.94244;stroke-opacity:1">abc</tspan></text>
+        <rect
+           style="fill:#256af4;fill-opacity:1;stroke:none;stroke-width:2.95821;stroke-linejoin:round;stroke-miterlimit:10;stroke-dasharray:11.8312, 2.95821;stroke-dashoffset:2.95821;stroke-opacity:1;paint-order:markers fill stroke"
+           id="rect5"
+           width="5.0587049"
+           height="16.5"
+           x="38.946053"
+           y="19.952229" />
+        <rect
+           style="fill:#ffffff;fill-opacity:1;stroke-width:1.33566;stroke-linejoin:round;stroke-miterlimit:10;stroke-dasharray:5.34257, 1.33566;stroke-dashoffset:1.33566;paint-order:markers fill stroke"
+           id="rect3"
+           width="2.4367449"
+           height="15.121"
+           x="38.598064"
+           y="20.641727" />
+        <rect
+           style="fill:#ffffff;fill-opacity:1;stroke-width:1.43716;stroke-linejoin:round;stroke-miterlimit:10;stroke-dasharray:5.74885, 1.43716;stroke-dashoffset:1.43716;paint-order:markers fill stroke"
+           id="rect3-5"
+           width="2.8214552"
+           height="15.121"
+           x="41.840424"
+           y="20.641727" />
+      </g>
+    </g>
+  </g>
+</svg>

images/svg/tbcmaterialfloatspinedit.svg

@@ -0,0 +1,154 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<!-- Created with Inkscape (http://www.inkscape.org/) -->
+
+<svg
+   width="48"
+   height="48"
+   viewBox="0 0 48 48"
+   version="1.1"
+   id="svg1"
+   sodipodi:docname="tbcmaterialfloatspinedit.svg"
+   inkscape:version="1.4 (e7c3feb100, 2024-10-09)"
+   inkscape:export-filename="../tbcmaterialspinedit.png"
+   inkscape:export-xdpi="48"
+   inkscape:export-ydpi="48"
+   xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
+   xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
+   xmlns="http://www.w3.org/2000/svg"
+   xmlns:svg="http://www.w3.org/2000/svg">
+  <sodipodi:namedview
+     id="namedview1"
+     pagecolor="#505050"
+     bordercolor="#ffffff"
+     borderopacity="1"
+     inkscape:showpageshadow="0"
+     inkscape:pageopacity="0"
+     inkscape:pagecheckerboard="1"
+     inkscape:deskcolor="#505050"
+     inkscape:document-units="px"
+     inkscape:zoom="16.895833"
+     inkscape:cx="23.822442"
+     inkscape:cy="29.178792"
+     inkscape:window-width="2560"
+     inkscape:window-height="1371"
+     inkscape:window-x="0"
+     inkscape:window-y="0"
+     inkscape:window-maximized="1"
+     inkscape:current-layer="g1"
+     showgrid="false" />
+  <defs
+     id="defs1">
+    <rect
+       x="-6.3329224"
+       y="20.123305"
+       width="33.972874"
+       height="15.980272"
+       id="rect5" />
+    <rect
+       x="78.565514"
+       y="167.72414"
+       width="343.3931"
+       height="166.84138"
+       id="rect2" />
+  </defs>
+  <g
+     inkscape:label="Livello 1"
+     inkscape:groupmode="layer"
+     id="layer1">
+    <text
+       xml:space="preserve"
+       id="text1"
+       style="font-size:192px;text-align:start;writing-mode:lr-tb;direction:ltr;white-space:pre;shape-inside:url(#rect2);display:inline;fill:#ffffff;fill-opacity:1;stroke:#000000;stroke-width:5;stroke-dasharray:none;stroke-opacity:1;paint-order:markers fill stroke"><tspan
+         x="78.566406"
+         y="509.26244"
+         id="tspan5"><tspan
+           dx="0 15.253366 15.253366"
+           style="font-size:26.6667px"
+           id="tspan1">123</tspan></tspan></text>
+    <g
+       id="g2">
+      <g
+         id="g1">
+        <rect
+           style="fill:#ffffff;fill-opacity:1;stroke:none;stroke-width:3.24645;stroke-linejoin:round;stroke-miterlimit:10;stroke-dasharray:12.9858, 3.24645;stroke-dashoffset:3.24645;stroke-opacity:1;paint-order:markers fill stroke"
+           id="rect4"
+           width="47.989674"
+           height="36"
+           x="0"
+           y="6" />
+        <rect
+           style="fill:#256af4;fill-opacity:1;stroke:#256af4;stroke-width:0;stroke-linejoin:round;stroke-miterlimit:10;stroke-dasharray:none;stroke-dashoffset:0.880555;stroke-opacity:1;paint-order:markers fill stroke"
+           id="rect1"
+           width="48"
+           height="3"
+           x="0"
+           y="39" />
+        <text
+           xml:space="preserve"
+           style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:10.6667px;font-family:'Noto Sans';-inkscape-font-specification:'Noto Sans Bold';text-align:start;writing-mode:lr-tb;direction:ltr;text-anchor:start;fill:#256af4;fill-opacity:1;stroke:none;stroke-width:1.8;stroke-linejoin:round;stroke-miterlimit:10;stroke-dasharray:7.2, 1.8;stroke-dashoffset:1.8;stroke-opacity:1;paint-order:markers fill stroke"
+           x="1.539997"
+           y="16.606693"
+           id="text4"><tspan
+             sodipodi:role="line"
+             id="tspan4"
+             x="1.539997"
+             y="16.606693"
+             style="font-size:10.6667px;stroke-width:1.8">Label</tspan></text>
+        <text
+           xml:space="preserve"
+           style="font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:19.6246px;font-family:'Noto Sans';-inkscape-font-specification:'Noto Sans';text-align:start;writing-mode:lr-tb;direction:ltr;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;stroke-width:3.94244;stroke-linejoin:round;stroke-miterlimit:10;stroke-dasharray:15.7698, 3.94244;stroke-dashoffset:3.94244;stroke-opacity:1;paint-order:markers fill stroke"
+           x="6.7542653"
+           y="35.20821"
+           id="text3"><tspan
+             sodipodi:role="line"
+             id="tspan3"
+             x="6.7542653"
+             y="35.20821"
+             style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-family:'Noto Sans';-inkscape-font-specification:'Noto Sans Bold';fill:#000000;fill-opacity:1;stroke:none;stroke-width:3.94244;stroke-opacity:1">2.6</tspan></text>
+        <g
+           id="g3"
+           transform="translate(0,-0.00576427)">
+          <path
+             sodipodi:type="star"
+             style="fill:#256af4;stroke:#256af4;stroke-width:0;stroke-linejoin:round;stroke-miterlimit:10;stroke-dashoffset:21.5109;paint-order:markers fill stroke"
+             id="path3"
+             inkscape:flatsided="true"
+             sodipodi:sides="3"
+             sodipodi:cx="41.725407"
+             sodipodi:cy="19.32468"
+             sodipodi:r1="4.3998275"
+             sodipodi:r2="2.1999137"
+             sodipodi:arg1="0.52359878"
+             sodipodi:arg2="1.5707963"
+             inkscape:rounded="0"
+             inkscape:randomized="0"
+             d="m 45.535769,21.524594 -7.620725,0 3.810363,-6.599741 z"
+             inkscape:transform-center-y="-1.2268713"
+             transform="matrix(1.1153795,0,0,1.1153795,-4.6896631,3.3531251)"
+             inkscape:transform-center-x="3.1089262e-06" />
+          <path
+             sodipodi:type="star"
+             style="fill:#256af4;stroke:#256af4;stroke-width:0;stroke-linejoin:round;stroke-miterlimit:10;stroke-dashoffset:21.5109;paint-order:markers fill stroke"
+             id="path3-5"
+             inkscape:flatsided="true"
+             sodipodi:sides="3"
+             sodipodi:cx="41.725407"
+             sodipodi:cy="19.32468"
+             sodipodi:r1="4.3998275"
+             sodipodi:r2="2.1999137"
+             sodipodi:arg1="0.52359878"
+             sodipodi:arg2="1.5707963"
+             inkscape:rounded="0"
+             inkscape:randomized="0"
+             d="m 45.535769,21.524594 -7.620725,0 3.810363,-6.599741 z"
+             inkscape:transform-center-y="1.2268691"
+             transform="matrix(0.55768974,-0.96594696,0.96594696,0.55768974,-0.08644392,61.035861)" />
+        </g>
+        <text
+           xml:space="preserve"
+           id="text5"
+           style="font-weight:600;font-size:10.6667px;font-family:'Noto Sans';-inkscape-font-specification:'Noto Sans Semi-Bold';text-align:start;writing-mode:lr-tb;direction:ltr;white-space:pre;shape-inside:url(#rect5);display:inline;fill:#256af4;stroke:#256af4;stroke-width:0;stroke-linejoin:round;stroke-miterlimit:10;stroke-dashoffset:21.5109;paint-order:markers fill stroke" />
+      </g>
+    </g>
+  </g>
+</svg>

images/svg/tbcmaterialspinedit.svg

@@ -0,0 +1,154 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<!-- Created with Inkscape (http://www.inkscape.org/) -->
+
+<svg
+   width="48"
+   height="48"
+   viewBox="0 0 48 48"
+   version="1.1"
+   id="svg1"
+   sodipodi:docname="tbcmaterialspinedit.svg"
+   inkscape:version="1.4 (e7c3feb100, 2024-10-09)"
+   inkscape:export-filename="../tbcmaterialspinedit.png"
+   inkscape:export-xdpi="48"
+   inkscape:export-ydpi="48"
+   xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
+   xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
+   xmlns="http://www.w3.org/2000/svg"
+   xmlns:svg="http://www.w3.org/2000/svg">
+  <sodipodi:namedview
+     id="namedview1"
+     pagecolor="#505050"
+     bordercolor="#ffffff"
+     borderopacity="1"
+     inkscape:showpageshadow="0"
+     inkscape:pageopacity="0"
+     inkscape:pagecheckerboard="1"
+     inkscape:deskcolor="#505050"
+     inkscape:document-units="px"
+     inkscape:zoom="16.895833"
+     inkscape:cx="23.822442"
+     inkscape:cy="29.178792"
+     inkscape:window-width="2560"
+     inkscape:window-height="1371"
+     inkscape:window-x="0"
+     inkscape:window-y="0"
+     inkscape:window-maximized="1"
+     inkscape:current-layer="g1"
+     showgrid="false" />
+  <defs
+     id="defs1">
+    <rect
+       x="-6.3329224"
+       y="20.123305"
+       width="33.972874"
+       height="15.980272"
+       id="rect5" />
+    <rect
+       x="78.565514"
+       y="167.72414"
+       width="343.3931"
+       height="166.84138"
+       id="rect2" />
+  </defs>
+  <g
+     inkscape:label="Livello 1"
+     inkscape:groupmode="layer"
+     id="layer1">
+    <text
+       xml:space="preserve"
+       id="text1"
+       style="font-size:192px;text-align:start;writing-mode:lr-tb;direction:ltr;white-space:pre;shape-inside:url(#rect2);display:inline;fill:#ffffff;fill-opacity:1;stroke:#000000;stroke-width:5;stroke-dasharray:none;stroke-opacity:1;paint-order:markers fill stroke"><tspan
+         x="78.566406"
+         y="509.26244"
+         id="tspan6"><tspan
+           dx="0 15.253366 15.253366"
+           style="font-size:26.6667px"
+           id="tspan2">123</tspan></tspan></text>
+    <g
+       id="g2">
+      <g
+         id="g1">
+        <rect
+           style="fill:#ffffff;fill-opacity:1;stroke:none;stroke-width:3.24645;stroke-linejoin:round;stroke-miterlimit:10;stroke-dasharray:12.9858, 3.24645;stroke-dashoffset:3.24645;stroke-opacity:1;paint-order:markers fill stroke"
+           id="rect4"
+           width="47.989674"
+           height="36"
+           x="0"
+           y="6" />
+        <rect
+           style="fill:#256af4;fill-opacity:1;stroke:#256af4;stroke-width:0;stroke-linejoin:round;stroke-miterlimit:10;stroke-dasharray:none;stroke-dashoffset:0.880555;stroke-opacity:1;paint-order:markers fill stroke"
+           id="rect1"
+           width="48"
+           height="3"
+           x="0"
+           y="39" />
+        <text
+           xml:space="preserve"
+           style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:10.6667px;font-family:'Noto Sans';-inkscape-font-specification:'Noto Sans Bold';text-align:start;writing-mode:lr-tb;direction:ltr;text-anchor:start;fill:#256af4;fill-opacity:1;stroke:none;stroke-width:1.8;stroke-linejoin:round;stroke-miterlimit:10;stroke-dasharray:7.2, 1.8;stroke-dashoffset:1.8;stroke-opacity:1;paint-order:markers fill stroke"
+           x="1.539997"
+           y="16.606693"
+           id="text4"><tspan
+             sodipodi:role="line"
+             id="tspan4"
+             x="1.539997"
+             y="16.606693"
+             style="font-size:10.6667px;stroke-width:1.8">Label</tspan></text>
+        <text
+           xml:space="preserve"
+           style="font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:19.6246px;font-family:'Noto Sans';-inkscape-font-specification:'Noto Sans';text-align:start;writing-mode:lr-tb;direction:ltr;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;stroke-width:3.94244;stroke-linejoin:round;stroke-miterlimit:10;stroke-dasharray:15.7698, 3.94244;stroke-dashoffset:3.94244;stroke-opacity:1;paint-order:markers fill stroke"
+           x="12.254265"
+           y="35.20821"
+           id="text3"><tspan
+             sodipodi:role="line"
+             id="tspan3"
+             x="12.254265"
+             y="35.20821"
+             style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-family:'Noto Sans';-inkscape-font-specification:'Noto Sans Bold';fill:#000000;fill-opacity:1;stroke:none;stroke-width:3.94244;stroke-opacity:1">26</tspan></text>
+        <g
+           id="g3"
+           transform="translate(0,-0.00576427)">
+          <path
+             sodipodi:type="star"
+             style="fill:#256af4;stroke:#256af4;stroke-width:0;stroke-linejoin:round;stroke-miterlimit:10;stroke-dashoffset:21.5109;paint-order:markers fill stroke"
+             id="path3"
+             inkscape:flatsided="true"
+             sodipodi:sides="3"
+             sodipodi:cx="41.725407"
+             sodipodi:cy="19.32468"
+             sodipodi:r1="4.3998275"
+             sodipodi:r2="2.1999137"
+             sodipodi:arg1="0.52359878"
+             sodipodi:arg2="1.5707963"
+             inkscape:rounded="0"
+             inkscape:randomized="0"
+             d="m 45.535769,21.524594 -7.620725,0 3.810363,-6.599741 z"
+             inkscape:transform-center-y="-1.2268713"
+             transform="matrix(1.1153795,0,0,1.1153795,-4.6896631,3.3531251)"
+             inkscape:transform-center-x="3.1089262e-06" />
+          <path
+             sodipodi:type="star"
+             style="fill:#256af4;stroke:#256af4;stroke-width:0;stroke-linejoin:round;stroke-miterlimit:10;stroke-dashoffset:21.5109;paint-order:markers fill stroke"
+             id="path3-5"
+             inkscape:flatsided="true"
+             sodipodi:sides="3"
+             sodipodi:cx="41.725407"
+             sodipodi:cy="19.32468"
+             sodipodi:r1="4.3998275"
+             sodipodi:r2="2.1999137"
+             sodipodi:arg1="0.52359878"
+             sodipodi:arg2="1.5707963"
+             inkscape:rounded="0"
+             inkscape:randomized="0"
+             d="m 45.535769,21.524594 -7.620725,0 3.810363,-6.599741 z"
+             inkscape:transform-center-y="1.2268691"
+             transform="matrix(0.55768974,-0.96594696,0.96594696,0.55768974,-0.08644392,61.035861)" />
+        </g>
+        <text
+           xml:space="preserve"
+           id="text5"
+           style="font-weight:600;font-size:10.6667px;font-family:'Noto Sans';-inkscape-font-specification:'Noto Sans Semi-Bold';text-align:start;writing-mode:lr-tb;direction:ltr;white-space:pre;shape-inside:url(#rect5);display:inline;fill:#256af4;stroke:#256af4;stroke-width:0;stroke-linejoin:round;stroke-miterlimit:10;stroke-dashoffset:21.5109;paint-order:markers fill stroke" />
+      </g>
+    </g>
+  </g>
+</svg>

images/svg/tsupergauge.svg

@@ -0,0 +1,28 @@
+<?xml version="1.0" standalone="no"?>
+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
+<!--Generator: Xara Designer (www.xara.com), SVG filter version: 6.7.0.0-->
+<svg fill="none" fill-rule="evenodd" stroke="black" stroke-width="0.501" stroke-linejoin="bevel" stroke-miterlimit="10" font-family="Times New Roman" font-size="16" style="font-variant-ligatures:none" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns="http://www.w3.org/2000/svg" version="1.1" overflow="visible" width="18pt" height="18pt" viewBox="0 -18 18 18">
+ <defs>
+  <image id="Bitmap" preserveAspectRatio="none" width="1" height="1" xlink:href="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAMAAAADCAYAAABWKLW/AAAACXBIWXMAAA7DAAAOwwHHb6hkAAAARElEQVQImWLctWvXyu/fv2vs37//BgAAAP//Yjl06JDaq1ev9E6dOvUPAAAA//9i/v37t9OePXv+vnv37iYAAAD//wMADLcbvYBdmiYAAAAASUVORK5CYII=">
+   <title>1</title>
+  </image>
+ </defs>
+ <g id="Layer 1" transform="scale(1 -1)">
+  <ellipse cx="9" cy="8.999" rx="7.5" ry="7.5" fill-rule="nonzero" stroke-linejoin="miter" stroke-width="0.75" fill="#808080" stroke="#000000"/>
+  <rect x="-8.9995" y="-8.9995" width="17.999" height="17.999" rx="0" ry="0" transform="matrix(1 0 0 1 8.999 8.998)" fill-rule="nonzero" stroke-linejoin="miter" stroke-width="0.75" stroke="none"/>
+  <path d="M 2.976,8.586 C 2.86,16.311 14.911,16.05 15.025,8.037" fill="none" stroke="#fffe7f" stroke-width="0.5" stroke-linecap="round" stroke-linejoin="round"/>
+  <path d="M 9.374,13.389 C 12.432,12.811 14.043,10.924 14.264,8.048" fill="none" stroke-width="0.5" stroke-linecap="round" stroke-linejoin="round" stroke="#ff0000"/>
+  <rect x="8.626" y="9" width="0.749" height="5.999" fill="#ff6b00" fill-rule="nonzero" stroke-linejoin="miter" stroke-width="0.75" stroke="none"/>
+  <text xml:space="preserve" transform="translate(5.475 3.941) scale(1 -1)" kerning="auto" fill="#ffffff" font-size="5.189" stroke="none" stroke-width="0.162" stroke-linecap="round" stroke-linejoin="round" font-family="Clarendon"><tspan x="0" y="0">SG</tspan></text>
+  <g id="Group_1" stroke="none">
+   <path d="M 8.413,9.764 C 8.834,10.088 9.44,10.008 9.764,9.587 C 10.088,9.166 10.008,8.56 9.587,8.236 C 9.166,7.912 8.56,7.992 8.236,8.413 C 7.912,8.834 7.992,9.44 8.413,9.764 Z" stroke-linejoin="miter" stroke-width="0.75" fill="#666666" marker-start="none" marker-end="none"/>
+   <clipPath id="clip-path">
+    <use xlink:href="#Shape"/>
+   </clipPath>
+   <g clip-path="url(#clip-path)">
+    <use xlink:href="#Bitmap" transform="translate(8.037 9.963) scale(1.926 -1.926)"/>
+   </g>
+   <path d="M 8.236,8.413 C 7.912,8.834 7.992,9.44 8.413,9.764 C 8.834,10.088 9.44,10.008 9.764,9.587 C 10.088,9.166 10.008,8.56 9.587,8.236 C 9.166,7.912 8.56,7.992 8.236,8.413 Z M 9.465,8.394 C 9.798,8.651 9.861,9.131 9.605,9.465 C 9.348,9.798 8.868,9.861 8.534,9.605 C 8.201,9.348 8.138,8.868 8.394,8.534 C 8.651,8.201 9.131,8.138 9.465,8.394 Z" stroke-width="0.05" marker-start="none" marker-end="none" fill="none" id="Shape"/>
+  </g>
+ </g>
+</svg>

lcl/KeyInputIntf.pas

@@ -1,91 +0,0 @@
-{ KeyInputIntf
-
-  Copyright (C) 2008 Tom Gregorovic
-
-  This source is free software; you can redistribute it and/or modify it under the terms of the
-  GNU General Public License as published by the Free Software Foundation; either version 2 of the
-  License, or (at your option) any later version.
-
-  This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
-  even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-  General Public License for more details.
-
-  A copy of the GNU General Public License is available on the World Wide Web at
-  <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
-  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-}
-unit KeyInputIntf;
-
-
-interface
-
-uses
-  Classes, SysUtils, Types, windows, messages, Forms;
-
-type
-  { TKeyInput }
-
-  TKeyInput = class
-  protected
-    procedure DoDown(Key: Word); dynamic; abstract;
-    procedure DoUp(Key: Word); dynamic; abstract;
-  public
-    procedure Down(Key: Word);
-    procedure Up(Key: Word);
-
-    procedure Press(Key: Word);  overload;
-    procedure Press(StringValue : String);  overload;
-
-    procedure Apply(Shift: TShiftState);
-    procedure Unapply(Shift: TShiftState);
-  end;
-
-implementation
-
-{ TKeyInput }
-
-procedure TKeyInput.Down(Key: Word);
-begin  DoDown(Key);
-  Application.ProcessMessages;
-end;
-
-procedure TKeyInput.Up(Key: Word);
-begin
-  DoUp(Key);
-  Application.ProcessMessages;
-end;
-
-procedure TKeyInput.Press(Key: Word);
-begin
-  Down(Key);
-  Up(Key);
-end;
-
-procedure TKeyInput.Press(StringValue: String);
-var
-  i : Integer;
-begin
-  i :=1;
-  while (i <= Length(StringValue)) do
-    begin
-      Press(Ord(StringValue[i]));
-      Inc(i);
-    end;
-end;
-
-procedure TKeyInput.Apply(Shift: TShiftState);
-begin
-  if ssCtrl in Shift then Down(VK_CONTROL);
-  if ssAlt in Shift then Down(VK_MENU);
-  if ssShift in Shift then Down(VK_SHIFT);
-end;
-
-procedure TKeyInput.Unapply(Shift: TShiftState);
-begin
-  if ssShift in Shift then Up(VK_SHIFT);
-  if ssCtrl in Shift then Up(VK_CONTROL);
-  if ssAlt in Shift then Up(VK_MENU);
-end;
-
-end.
-

lcl/MouseAndKeyInput.pas

@@ -1,50 +0,0 @@
-{ MouseAndKeyInput
-
-  Copyright (C) 2008 Tom Gregorovic
-
-  This source is free software; you can redistribute it and/or modify it under the terms of the
-  GNU General Public License as published by the Free Software Foundation; either version 2 of the
-  License, or (at your option) any later version.
-
-  This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
-  even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-  General Public License for more details.
-
-  A copy of the GNU General Public License is available on the World Wide Web at
-  <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
-  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-}
-unit MouseAndKeyInput;
-
-interface
-
-uses
-  MouseInputIntf,
-  KeyInputIntf,
-  WinMouseInput,
-  WinKeyInput,
-  Classes, SysUtils;
-
-var
-  MouseInput: TMouseInput;
-  KeyInput: TKeyInput;
-
-implementation
-
-
-
-initialization
-
-  // Create platform specific object for mouse input
-  MouseInput := InitializeMouseInput;
-
-  // Create platform specific object for key input
-  KeyInput := InitializeKeyInput;
-
-finalization
-
-  FreeAndNil(MouseInput);
-  FreeAndNil(KeyInput);
-
-
-end.

lcl/MouseInputIntf.pas

@@ -1,283 +0,0 @@
-{ MouseInputIntf
-
-  Copyright (C) 2008 Tom Gregorovic
-
-  This source is free software; you can redistribute it and/or modify it under the terms of the
-  GNU General Public License as published by the Free Software Foundation; either version 2 of the
-  License, or (at your option) any later version.
-
-  This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
-  even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-  General Public License for more details.
-
-  A copy of the GNU General Public License is available on the World Wide Web at
-  <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
-  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-}
-unit MouseInputIntf;
-
-interface
-
-uses
-  Classes, SysUtils, Types, windows, Controls, Forms;
-
-type
-  { TMouseInput }
-
-  TMouseInput = class
-  protected
-    procedure DoDown(Button: TMouseButton); dynamic; abstract;
-    procedure DoMove(ScreenX, ScreenY: Integer); dynamic; abstract;
-    procedure DoUp(Button: TMouseButton); dynamic; abstract;
-    procedure DoScrollUp; dynamic; abstract;
-    procedure DoScrollDown; dynamic; abstract;
-  public
-    procedure Down(Button: TMouseButton; Shift: TShiftState); overload;
-    procedure Down(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
-    procedure Down(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
-
-    procedure Move(Shift: TShiftState; Control: TControl; X, Y: Integer; Duration: Integer = 0); overload;
-    procedure MoveBy(Shift: TShiftState; DX, DY: Integer; Duration: Integer = 0); overload;
-    procedure Move(Shift: TShiftState; ScreenX, ScreenY: Integer; Duration: Integer); overload;
-    procedure Move(Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
-
-    procedure ScrollUp(Shift: TShiftState); overload;
-    procedure ScrollUp(Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
-    procedure ScrollUp(Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
-    procedure ScrollDown(Shift: TShiftState); overload;
-    procedure ScrollDown(Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
-    procedure ScrollDown(Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
-
-    procedure Up(Button: TMouseButton; Shift: TShiftState); overload;
-    procedure Up(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
-    procedure Up(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
-
-    procedure Click(Button: TMouseButton; Shift: TShiftState); overload;
-    procedure Click(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
-    procedure Click(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
-
-    procedure DblClick(Button: TMouseButton; Shift: TShiftState); overload;
-    procedure DblClick(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
-    procedure DblClick(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
-  end;
-
-implementation
-
-uses
-  Math, MouseAndKeyInput;
-
-{ TMouseInput }
-
-procedure TMouseInput.Down(Button: TMouseButton; Shift: TShiftState);
-begin
-  KeyInput.Apply(Shift);
-  try
-    DoDown(Button);
-  finally
-    KeyInput.Unapply(Shift);
-  end;
-  Application.ProcessMessages;
-end;
-
-procedure TMouseInput.Down(Button: TMouseButton; Shift: TShiftState;
-  Control: TControl; X, Y: Integer);
-var
-  P: TPoint;
-begin
-  P := Control.ClientToScreen(Point(X, Y));
-  Down(Button, Shift, P.X, P.Y);
-end;
-
-procedure TMouseInput.Down(Button: TMouseButton; Shift: TShiftState;
-  ScreenX, ScreenY: Integer);
-begin
-  KeyInput.Apply(Shift);
-  try
-    DoMove(ScreenX, ScreenY);
-    DoDown(Button);
-  finally
-    KeyInput.Unapply(Shift);
-  end;
-end;
-
-procedure TMouseInput.Move(Shift: TShiftState; Control: TControl; X, Y: Integer; Duration: Integer = 0);
-var
-  P: TPoint;
-begin
-  P := Control.ClientToScreen(Point(X, Y));
-  Move(Shift, P.X, P.Y, Duration);
-end;
-
-procedure TMouseInput.MoveBy(Shift: TShiftState; DX, DY: Integer; Duration: Integer = 0);
-var
-  P: TPoint;
-begin
-  P := Mouse.CursorPos;
-  Move(Shift, P.X + DX, P.Y + DY, Duration);
-end;
-
-procedure TMouseInput.Move(Shift: TShiftState; ScreenX, ScreenY: Integer; Duration: Integer);
-const
-  Interval = 20; //ms
-var
-  TimeStep: Integer;
-  X, Y: Integer;
-  Start: TPoint;
-  S: LongWord;
-begin
-  Start := Mouse.CursorPos;
-
-  while Duration > 0 do
-  begin
-    TimeStep := Min(Interval, Duration);
-
-    S := {%H-}Windows.GetTickCount;
-    while {%H-}Windows.GetTickCount - S < TimeStep do Application.ProcessMessages;
-
-    X := Start.X + ((ScreenX - Start.X) * TimeStep) div Duration;
-    Y := Start.Y + ((ScreenY - Start.Y) * TimeStep) div Duration;
-    Move(Shift, X, Y);
-
-    Duration := Duration - TimeStep;
-    Start := Point(X, Y);
-  end;
-
-  Move(Shift, ScreenX, ScreenY);
-end;
-
-procedure TMouseInput.Move(Shift: TShiftState; ScreenX, ScreenY: Integer);
-begin
-  KeyInput.Apply(Shift);
-  try
-    DoMove(ScreenX, ScreenY);
-  finally
-    KeyInput.Unapply(Shift);
-  end;
-  Application.ProcessMessages;
-end;
-
-procedure TMouseInput.ScrollUp(Shift: TShiftState);
-begin
-  KeyInput.Apply(Shift);
-  try
-    DoScrollUp;
-  finally
-    KeyInput.Unapply(Shift);
-  end;
-  Application.ProcessMessages;
-end;
-
-procedure TMouseInput.ScrollUp(Shift: TShiftState; Control: TControl;
-  X, Y: Integer);
-var
-  P: TPoint;
-begin
-  P := Control.ClientToScreen(Point(X, Y));
-  ScrollUp(Shift, P.X, P.Y);
-end;
-
-procedure TMouseInput.ScrollUp(Shift: TShiftState; ScreenX, ScreenY: Integer);
-begin
-  Move(Shift, ScreenX, ScreenY);
-  ScrollUp(Shift);
-end;
-
-procedure TMouseInput.ScrollDown(Shift: TShiftState);
-begin
-  KeyInput.Apply(Shift);
-  try
-    DoScrollDown;
-  finally
-    KeyInput.Unapply(Shift);
-  end;
-  Application.ProcessMessages;
-end;
-
-procedure TMouseInput.ScrollDown(Shift: TShiftState; Control: TControl;
-  X, Y: Integer);
-var
-  P: TPoint;
-begin
-  P := Control.ClientToScreen(Point(X, Y));
-  ScrollDown(Shift, P.X, P.Y);
-end;
-
-procedure TMouseInput.ScrollDown(Shift: TShiftState; ScreenX, ScreenY: Integer);
-begin
-  Move(Shift, ScreenX, ScreenY);
-  ScrollDown(Shift);
-end;
-
-procedure TMouseInput.Up(Button: TMouseButton; Shift: TShiftState);
-begin
-  KeyInput.Apply(Shift);
-  try
-    DoUp(Button);
-  finally
-    KeyInput.Unapply(Shift);
-  end;
-  Application.ProcessMessages;
-end;
-
-procedure TMouseInput.Up(Button: TMouseButton; Shift: TShiftState;
-  Control: TControl; X, Y: Integer);
-var
-  P: TPoint;
-begin
-  P := Control.ClientToScreen(Point(X, Y));
-  Up(Button, Shift, P.X, P.Y);
-end;
-
-procedure TMouseInput.Up(Button: TMouseButton; Shift: TShiftState;
-  ScreenX, ScreenY: Integer);
-begin
-  Move(Shift, ScreenX, ScreenY);
-  Up(Button, Shift);
-end;
-
-procedure TMouseInput.Click(Button: TMouseButton; Shift: TShiftState);
-begin
-  Down(Button, Shift);
-  Up(Button, Shift);
-end;
-
-procedure TMouseInput.Click(Button: TMouseButton; Shift: TShiftState;
-  Control: TControl; X, Y: Integer);
-var
-  P: TPoint;
-begin
-  P := Control.ClientToScreen(Point(X, Y));
-  Click(Button, Shift, P.X, P.Y);
-end;
-
-procedure TMouseInput.Click(Button: TMouseButton; Shift: TShiftState;
-  ScreenX, ScreenY: Integer);
-begin
-  Move(Shift, ScreenX, ScreenY);
-  Click(Button, Shift);
-end;
-
-procedure TMouseInput.DblClick(Button: TMouseButton; Shift: TShiftState);
-begin
-  Click(Button, Shift);
-  Click(Button, Shift);
-end;
-
-procedure TMouseInput.DblClick(Button: TMouseButton; Shift: TShiftState;
-  Control: TControl; X, Y: Integer);
-var
-  P: TPoint;
-begin
-  P := Control.ClientToScreen(Point(X, Y));
-  DblClick(Button, Shift, P.X, P.Y);
-end;
-
-procedure TMouseInput.DblClick(Button: TMouseButton; Shift: TShiftState;
-  ScreenX, ScreenY: Integer);
-begin
-  Move(Shift, ScreenX, ScreenY);
-  DblClick(Button, Shift);
-end;
-
-end.
-

lcl/WinKeyInput.pas

@@ -1,71 +0,0 @@
-{ WinKeyInput
-
-  Copyright (C) 2008 Tom Gregorovic
-
-  This source is free software; you can redistribute it and/or modify it under the terms of the
-  GNU General Public License as published by the Free Software Foundation; either version 2 of the
-  License, or (at your option) any later version.
-
-  This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
-  even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-  General Public License for more details.
-
-  A copy of the GNU General Public License is available on the World Wide Web at
-  <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
-  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-}
-unit WinKeyInput;
-
-interface
-
-uses
-  Classes, SysUtils, Controls, Forms,
-  Windows, //JwaWinUser,
-  KeyInputIntf;
-
-type
-
-  { TWinKeyInput }
-
-  TWinKeyInput = class(TKeyInput)
-  protected
-    procedure DoDown(Key: Word); override;
-    procedure DoUp(Key: Word); override;
-  end;
-
-function InitializeKeyInput: TKeyInput;
-
-implementation
-
-function InitializeKeyInput: TKeyInput;
-begin
-  Result := TWinKeyInput.Create;
-end;
-
-procedure SendKeyInput(Flag: DWORD; Key: Word);
-var
-  Input: TInput;
-begin
-  FillChar({%H-}Input, SizeOf(Input), 0);
-  Input.Itype := INPUT_KEYBOARD;
-  Input.ki.dwFlags := Flag;
-  Input.ki.wVk := Key;
-
-  SendInput(1, Input, SizeOf(Input));
-end;
-
-
-{ TWinKeyInput }
-
-procedure TWinKeyInput.DoDown(Key: Word);
-begin
-  SendKeyInput(0, Key);
-end;
-
-procedure TWinKeyInput.DoUp(Key: Word);
-begin
-  SendKeyInput(KEYEVENTF_KEYUP, Key);
-end;
-
-end.
-

lcl/WinMouseInput.pas

@@ -1,126 +0,0 @@
-{ WinMouseInput
-
-  Copyright (C) 2008 Tom Gregorovic
-
-  This source is free software; you can redistribute it and/or modify it under the terms of the
-  GNU General Public License as published by the Free Software Foundation; either version 2 of the
-  License, or (at your option) any later version.
-
-  This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
-  even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-  General Public License for more details.
-
-  A copy of the GNU General Public License is available on the World Wide Web at
-  <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
-  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-}
-unit WinMouseInput;
-
-
-interface
-
-uses
-  Classes, SysUtils, Controls, Forms,
-  Windows, //JwaWinUser,
-  MouseInputIntf;
-
-type
-
-  { TWinMouseInput }
-
-  TWinMouseInput = class(TMouseInput)
-  protected
-    procedure DoDown(Button: TMouseButton); override;
-    procedure DoMove(ScreenX, ScreenY: Integer); override;
-    procedure DoUp(Button: TMouseButton); override;
-    procedure DoScrollUp; override;
-    procedure DoScrollDown; override;
-  end;
-
-function InitializeMouseInput: TMouseInput;
-
-implementation
-
-function InitializeMouseInput: TMouseInput;
-begin
-  Result := TWinMouseInput.Create;
-end;
-
-procedure SendMouseInput(Flag: DWORD; MouseData: DWORD = 0); overload;
-var
-  Input: TInput;
-begin
-{$IFDEF VER2_6}
-  FillChar(Input, SizeOf(Input), 0);
-{$ELSE}
-  Input := Default(TInput);
-{$ENDIF}
-  Input.mi.mouseData := MouseData;
-  Input.Itype := INPUT_MOUSE;
-  Input.mi.dwFlags := Flag;
-
-  SendInput(1, Input, SizeOf(Input));
-end;
-
-procedure SendMouseInput(Flag: DWORD; X, Y: Integer); overload;
-var
-  Input: TInput;
-begin
-{$IFDEF VER2_6}
-  FillChar(Input, SizeOf(Input), 0);
-{$ELSE}
-  Input := Default(TInput);
-{$ENDIF}
-  Input.Itype := INPUT_MOUSE;
-  Input.mi.dx := MulDiv(X, 65535, Screen.Width - 1); // screen horizontal coordinates: 0 - 65535
-  Input.mi.dy := MulDiv(Y, 65535, Screen.Height - 1); // screen vertical coordinates: 0 - 65535
-  Input.mi.dwFlags := Flag or MOUSEEVENTF_ABSOLUTE;
-
-  SendInput(1, Input, SizeOf(Input));
-end;
-
-{ TWinMouseInput }
-
-procedure TWinMouseInput.DoDown(Button: TMouseButton);
-var
-  Flag: DWORD;
-begin
-  case Button of
-    mbRight: Flag := MOUSEEVENTF_RIGHTDOWN;
-    mbMiddle: Flag := MOUSEEVENTF_MIDDLEDOWN;
-  else
-    Flag := MOUSEEVENTF_LEFTDOWN;
-  end;
-  SendMouseInput(Flag);
-end;
-
-procedure TWinMouseInput.DoMove(ScreenX, ScreenY: Integer);
-begin
-  SendMouseInput(MOUSEEVENTF_MOVE, ScreenX, ScreenY);
-end;
-
-procedure TWinMouseInput.DoUp(Button: TMouseButton);
-var
-  Flag: DWORD;
-begin
-  case Button of
-    mbRight: Flag := MOUSEEVENTF_RIGHTUP;
-    mbMiddle: Flag := MOUSEEVENTF_MIDDLEUP;
-  else
-    Flag := MOUSEEVENTF_LEFTUP;
-  end;
-  SendMouseInput(Flag);
-end;
-
-procedure TWinMouseInput.DoScrollUp;
-begin
-  SendMouseInput(MOUSEEVENTF_WHEEL, WHEEL_DELTA);
-end;
-
-procedure TWinMouseInput.DoScrollDown;
-begin
-  SendMouseInput(MOUSEEVENTF_WHEEL, DWORD(-WHEEL_DELTA));
-end;
-
-end.
-

mouseandkeyinput/keyinputintf.pas

@@ -16,13 +16,13 @@
 }
 unit KeyInputIntf;
 
-{$mode objfpc}{$H+}
+{$IFDEF FPC}{$mode objfpc}{$H+}{$ENDIF}
 
 interface
 
 uses
-  Classes, SysUtils, Forms;
-  
+  Classes, SysUtils, {$IFDEF FPC}LCLType,{$ELSE}Types, windows, messages,{$ENDIF} Forms;
+
 type
   { TKeyInput }
 
@@ -33,18 +33,16 @@ type
   public
     procedure Down(Key: Word);
     procedure Up(Key: Word);
-    
-    procedure Press(Key: Word);
-    procedure Press(StringValue : String);
-    
+
+    procedure Press(Key: Word);  overload;
+    procedure Press(StringValue : String);  overload;
+
     procedure Apply(Shift: TShiftState);
     procedure Unapply(Shift: TShiftState);
   end;
 
 implementation
 
-uses LCLType;
-
 { TKeyInput }
 
 procedure TKeyInput.Down(Key: Word);

mouseandkeyinput/mouseandkeyinput.pas

@@ -21,18 +21,23 @@ interface
 uses
   MouseInputIntf,
   KeyInputIntf,
-  {$IFDEF WINDOWS}
-  WinMouseInput,
-  WinKeyInput,
-  {$ENDIF}
-  {$IFDEF UNIX}
-    {$IFDEF LCLcarbon}
-    CarbonMouseInput,
-    CarbonKeyInput,
-    {$ELSE}
-    XMouseInput,
-    XKeyInput,
-    {$ENDIF}
+  {$IFDEF FPC}
+	  {$IFDEF WINDOWS}
+	  WinMouseInput,
+	  WinKeyInput,
+	  {$ENDIF}
+	  {$IFDEF UNIX}
+	    {$IFDEF LCLcarbon}
+	    CarbonMouseInput,
+	    CarbonKeyInput,
+	    {$ELSE}
+	    XMouseInput,
+	    XKeyInput,
+	    {$ENDIF}
+	  {$ENDIF}
+  {$ELSE}
+	  WinMouseInput,
+	  WinKeyInput,  
   {$ENDIF}
   Classes, SysUtils;
 

mouseandkeyinput/mouseinputintf.pas

@@ -16,13 +16,12 @@
 }
 unit MouseInputIntf;
 
-{$mode objfpc}{$H+}
-
+{$IFDEF FPC}{$mode objfpc}{$H+}{$ENDIF}
 interface
 
 uses
-  Classes, SysUtils, Controls, Forms;
-  
+  Classes, SysUtils, {$IFNDEF FPC}Types, windows,{$ENDIF} Controls, Forms;
+
 type
   { TMouseInput }
 
@@ -34,33 +33,33 @@ type
     procedure DoScrollUp; dynamic; abstract;
     procedure DoScrollDown; dynamic; abstract;
   public
-    procedure Down(Button: TMouseButton; Shift: TShiftState);
-    procedure Down(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
-    procedure Down(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
-    
-    procedure Move(Shift: TShiftState; Control: TControl; X, Y: Integer; Duration: Integer = 0);
-    procedure MoveBy(Shift: TShiftState; DX, DY: Integer; Duration: Integer = 0);
-    procedure Move(Shift: TShiftState; ScreenX, ScreenY: Integer; Duration: Integer);
-    procedure Move(Shift: TShiftState; ScreenX, ScreenY: Integer);
-
-    procedure ScrollUp(Shift: TShiftState);
-    procedure ScrollUp(Shift: TShiftState; Control: TControl; X, Y: Integer);
-    procedure ScrollUp(Shift: TShiftState; ScreenX, ScreenY: Integer);
-    procedure ScrollDown(Shift: TShiftState);
-    procedure ScrollDown(Shift: TShiftState; Control: TControl; X, Y: Integer);
-    procedure ScrollDown(Shift: TShiftState; ScreenX, ScreenY: Integer);
-
-    procedure Up(Button: TMouseButton; Shift: TShiftState);
-    procedure Up(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
-    procedure Up(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
-    
-    procedure Click(Button: TMouseButton; Shift: TShiftState);
-    procedure Click(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
-    procedure Click(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
-    
-    procedure DblClick(Button: TMouseButton; Shift: TShiftState);
-    procedure DblClick(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
-    procedure DblClick(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
+    procedure Down(Button: TMouseButton; Shift: TShiftState); overload;
+    procedure Down(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
+    procedure Down(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
+
+    procedure Move(Shift: TShiftState; Control: TControl; X, Y: Integer; Duration: Integer = 0); overload;
+    procedure MoveBy(Shift: TShiftState; DX, DY: Integer; Duration: Integer = 0); overload;
+    procedure Move(Shift: TShiftState; ScreenX, ScreenY: Integer; Duration: Integer); overload;
+    procedure Move(Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
+
+    procedure ScrollUp(Shift: TShiftState); overload;
+    procedure ScrollUp(Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
+    procedure ScrollUp(Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
+    procedure ScrollDown(Shift: TShiftState); overload;
+    procedure ScrollDown(Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
+    procedure ScrollDown(Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
+
+    procedure Up(Button: TMouseButton; Shift: TShiftState); overload;
+    procedure Up(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
+    procedure Up(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
+
+    procedure Click(Button: TMouseButton; Shift: TShiftState); overload;
+    procedure Click(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
+    procedure Click(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
+
+    procedure DblClick(Button: TMouseButton; Shift: TShiftState); overload;
+    procedure DblClick(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
+    procedure DblClick(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
   end;
 
 implementation
@@ -128,14 +127,14 @@ var
   S: LongWord;
 begin
   Start := Mouse.CursorPos;
-  
+
   while Duration > 0 do
   begin
     TimeStep := Min(Interval, Duration);
 
-    S := {%H-}GetTickCount;
-    while {%H-}GetTickCount - S < TimeStep do Application.ProcessMessages;
-    
+    S := {%H-}{$IFNDEF FPC}Windows.{$ENDIF}GetTickCount;
+    while {%H-}{$IFNDEF FPC}Windows.{$ENDIF}GetTickCount - S < TimeStep do Application.ProcessMessages;
+
     X := Start.X + ((ScreenX - Start.X) * TimeStep) div Duration;
     Y := Start.Y + ((ScreenY - Start.Y) * TimeStep) div Duration;
     Move(Shift, X, Y);
@@ -143,7 +142,7 @@ begin
     Duration := Duration - TimeStep;
     Start := Point(X, Y);
   end;
-  
+
   Move(Shift, ScreenX, ScreenY);
 end;
 

mouseandkeyinput/winkeyinput.pas

@@ -16,15 +16,14 @@
 }
 unit WinKeyInput;
 
-{$mode objfpc}{$H+}
-
+{$IFDEF FPC}{$mode objfpc}{$H+}{$ENDIF}
 interface
 
 uses
   Classes, SysUtils, Controls, Forms,
-  Windows, JwaWinUser,
+  Windows, {$IFDEF FPC}JwaWinUser,{$ENDIF}
   KeyInputIntf;
-  
+
 type
 
   { TWinKeyInput }
@@ -34,7 +33,7 @@ type
     procedure DoDown(Key: Word); override;
     procedure DoUp(Key: Word); override;
   end;
-  
+
 function InitializeKeyInput: TKeyInput;
 
 implementation
@@ -49,11 +48,11 @@ var
   Input: TInput;
 begin
   FillChar({%H-}Input, SizeOf(Input), 0);
-  Input.type_ := INPUT_KEYBOARD;
+  Input.{$IFDEF FPC}type_{$ELSE}Itype{$ENDIF} := INPUT_KEYBOARD;
   Input.ki.dwFlags := Flag;
   Input.ki.wVk := Key;
 
-  SendInput(1, @Input, SizeOf(Input));
+  SendInput(1, {$IFDEF FPC}@{$ENDIF}Input, SizeOf(Input));
 end;
 
 

mouseandkeyinput/winmouseinput.pas

@@ -16,15 +16,15 @@
 }
 unit WinMouseInput;
 
-{$mode objfpc}{$H+}
+{$IFDEF FPC}{$mode objfpc}{$H+}{$ENDIF}
 
 interface
 
 uses
   Classes, SysUtils, Controls, Forms,
-  Windows, JwaWinUser,
+  Windows, {$IFDEF FPC}JwaWinUser,{$ENDIF}
   MouseInputIntf;
-  
+
 type
 
   { TWinMouseInput }
@@ -37,7 +37,7 @@ type
     procedure DoScrollUp; override;
     procedure DoScrollDown; override;
   end;
-  
+
 function InitializeMouseInput: TMouseInput;
 
 implementation
@@ -47,7 +47,7 @@ begin
   Result := TWinMouseInput.Create;
 end;
 
-procedure SendMouseInput(Flag: DWORD; MouseData: DWORD = 0);
+procedure SendMouseInput(Flag: DWORD; MouseData: DWORD = 0); overload;
 var
   Input: TInput;
 begin
@@ -57,13 +57,13 @@ begin
   Input := Default(TInput);
 {$ENDIF}
   Input.mi.mouseData := MouseData;
-  Input.type_ := INPUT_MOUSE;
+  Input.{$IFDEF FPC}type_{$ELSE}Itype{$ENDIF} := INPUT_MOUSE;
   Input.mi.dwFlags := Flag;
 
-  SendInput(1, @Input, SizeOf(Input));
+  SendInput(1, {$IFDEF FPC}@{$ENDIF}Input, SizeOf(Input));
 end;
 
-procedure SendMouseInput(Flag: DWORD; X, Y: Integer);
+procedure SendMouseInput(Flag: DWORD; X, Y: Integer); overload;
 var
   Input: TInput;
 begin
@@ -72,12 +72,12 @@ begin
 {$ELSE}
   Input := Default(TInput);
 {$ENDIF}
-  Input.type_ := INPUT_MOUSE;
+  Input.{$IFDEF FPC}type_{$ELSE}Itype{$ENDIF} := INPUT_MOUSE;
   Input.mi.dx := MulDiv(X, 65535, Screen.Width - 1); // screen horizontal coordinates: 0 - 65535
   Input.mi.dy := MulDiv(Y, 65535, Screen.Height - 1); // screen vertical coordinates: 0 - 65535
   Input.mi.dwFlags := Flag or MOUSEEVENTF_ABSOLUTE;
 
-  SendInput(1, @Input, SizeOf(Input));
+  SendInput(1, {$IFDEF FPC}@{$ENDIF}Input, SizeOf(Input));
 end;
 
 { TWinMouseInput }

supergauge.pas

@@ -0,0 +1,2264 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+{
+  Part of BGRA Controls. Made by third party.
+  For detailed information see readme.txt
+
+  Site: https://sourceforge.net/p/bgra-controls/
+  Wiki: http://wiki.lazarus.freepascal.org/BGRAControls
+  Forum: http://forum.lazarus.freepascal.org/index.php/board,46.0.html
+
+}
+{******************************* CONTRIBUTOR(S) ******************************
+- Edivando S. Santos Brasil | [email protected]
+  (Compatibility with delphi VCL 11/2018)
+- Sandy Ganz | [email protected]
+  Evolved from DTAnalogCommon, specific for New Gauge Work
+  Massive overhaul, fixes and features, begat Super Gauge
+  Needed to split off as changes broke compatibility badly
+
+***************************** END CONTRIBUTOR(S) *****************************}
+unit supergauge;
+
+{$I bgracontrols.inc}
+
+interface
+
+uses
+  Classes, SysUtils, Graphics, {$IFDEF FPC}LResources,{$ELSE} BGRAGraphics, {$ENDIF} Forms, Controls, Dialogs, SuperGaugeCommon,
+  BGRABitmap, BGRABitmapTypes, BGRAVectorize, BGRAPath, math, bctypes, bctools;
+
+const
+  INTERNAL_GAUGE_MIN_VALUE = 0;   // internal lowest value
+  INTERNAL_GAUGE_MAX_VALUE = 270; // internal highest value
+  VERSIONSTR = '1.02';            // SG version, Should ALWAYS show as a delta when merging!
+
+type
+
+  { TSGCustomSuperGauge }
+
+  TBandsArray = array[0..3] of TSGBandSettings;
+  TTextsArray = array[0..2] of TSGTextSettings;
+  TMarkersArray = array[0..2] of TSGMarkerSettings;
+
+  TTextsBitmapArray = array[0..2] of TBGRABitmap;
+
+  TSGRangeStateErrorEvent = procedure(Sender: TObject; OutOfRangeValue: single) of object;  // called anytime out of range
+  TSGRangeStateOKEvent = procedure(Sender: TObject; RangeValue: single) of object;          // called only when back to in range
+  TSGRangeStateChangeEvent = procedure(Sender: TObject; Value: single) of object;           // called when state RangeLed Active changes to True
+
+  TSGCustomSuperGauge = class(TGraphicControl)
+  private
+    { Private declarations }
+    FDirty: boolean;
+
+    FFaceSettings: TSGFaceSettings;
+    FFrameSettings: TSGFrameSettings;
+    FPointerCapSettings: TSGPointerCapSettings;
+    FScaleSettings: TSGScaleSettings;
+    FBandsSettings: TBandsArray;
+    FTextsSettings: TTextsArray;
+    FPointerSettings: TSGPointerSettings;
+    FRangeLEDSettings: TSGRangeCheckLEDSettings;
+    FMarkersSettings: TMarkersArray;
+    FGaugeBitmap: TBGRABitmap;
+    FFrameBitmap: TBGRABitmap;
+    FFaceBitmap: TBGRABitmap;
+    FTextBitmap: TBGRABitmap;
+    FScaleBitmap: TBGRABitmap;
+    FBandBitmap: TBGRABitmap;
+    FTextsBitmaps: TTextsBitmapArray;
+
+    FMultiBitmap: TBGRABitmap;
+    FPointerBitmap: TBGRABitmap;
+    FMarkerBitmap: TBGRABitmap;
+    FPointerCapBitmap: TBGRABitmap;
+    FLEDActiveBitmap: TBGRABitmap;
+    FLEDInActiveBitmap: TBGRABitmap;
+
+    FMinValue: single;  // the min value mapped to lowest/leftmost angle on the gauge
+    FMaxValue: single;  // the max value mapped to highest/rightmost angle on the gauge
+    FValue: single;     // this is the VALUE not a position
+    FOutOfRange: TSGRangeStateErrorEvent;         // change of state ONLY
+    FBackInRange: TSGRangeStateOKEvent;           // change of state ONLY
+    FRangeLEDActive: TSGRangeStateChangeEvent;    // change of state ONLY
+    FRangeLEDInactive: TSGRangeStateChangeEvent;  // change of state ONLY
+    FOutOfRangeState: boolean;
+    FRangeLEDStateChanged: boolean;
+    FAutoScale: boolean;
+
+    procedure SetBandSettings1(AValue: TSGBandSettings);
+    procedure SetBandSettings2(AValue: TSGBandSettings);
+    procedure SetBandSettings3(AValue: TSGBandSettings);
+    procedure SetBandSettings4(AValue: TSGBandSettings);
+
+    procedure SetTextSettings1(AValue: TSGTextSettings);
+    procedure SetTextSettings2(AValue: TSGTextSettings);
+    procedure SetTextSettings3(AValue: TSGTextSettings);
+
+    procedure SetMarkerSettings1(AValue: TSGMarkerSettings);
+    procedure SetMarkerSettings2(AValue: TSGMarkerSettings);
+    procedure SetMarkerSettings3(AValue: TSGMarkerSettings);
+
+    procedure SetFaceSettings(AValue: TSGFaceSettings);
+    procedure SetScaleSettings(AValue: TSGScaleSettings);
+    procedure SetFrameSettings(AValue: TSGFrameSettings);
+    procedure SetPointerSettings(AValue: TSGPointerSettings);
+    procedure SetRangeLedSettings(AValue: TSGRangeCheckLEDSettings);
+    procedure SetPointerCapSettings(AValue: TSGPointerCapSettings);
+    procedure SetMaxValue(AValue: single);
+    procedure SetMinValue(AValue: single);
+    function GetMaxValue: single;
+    function GetMinValue: single;
+
+    procedure SetValue(AValue: single);
+    function GetValue: single;
+    procedure SetAutoScale(AValue: boolean);
+    function CheckOutOfRange(AValue: single): single;
+
+  protected
+    { Protected declarations }
+    procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
+    procedure DoChange({%H-}Sender: TObject);
+    procedure DoRangeLEDChange({%H-}Sender: TObject);
+    procedure DoPictureChange({%H-}Sender: TObject);
+    procedure DoChangeFont1({%H-}ASender: TObject; {%H-}AData: PtrInt); // Wrapper for FontEx DoChange
+    procedure DoChangeFont2({%H-}ASender: TObject; {%H-}AData: PtrInt); // Wrapper for FontEx DoChange
+    procedure DoChangeFont3({%H-}ASender: TObject; {%H-}AData: PtrInt); // Wrapper for FontEx DoChange
+    procedure SetAllBandsDirtyState(AValue: boolean);
+    procedure SetAllTextsDirtyState(AValue: boolean);
+    procedure SetAllMarkersDirtyState(AValue: boolean);
+    function IsAnyBandDirty: boolean;
+    function IsAnyMarkerDirty: boolean;
+    property Dirty: boolean read FDirty write FDirty;
+
+  public
+    { Public declarations }
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
+    property PointerSettings: TSGPointerSettings read FPointerSettings write SetPointerSettings; // sjg added
+    property PointerCapSettings: TSGPointerCapSettings read FPointerCapSettings write SetPointerCapSettings;
+    property FaceSettings: TSGFaceSettings read FFaceSettings write SetFaceSettings;
+    property FrameSettings: TSGFrameSettings read FFrameSettings write SetFrameSettings;
+    property ScaleSettings: TSGScaleSettings read FScaleSettings write SetScaleSettings;
+    property BandSettings1: TSGBandSettings read FBandsSettings[0] write SetBandSettings1; // will need an array thing here
+    property BandSettings2: TSGBandSettings read FBandsSettings[1] write SetBandSettings2; // will need an array thing here
+    property BandSettings3: TSGBandSettings read FBandsSettings[2] write SetBandSettings3; // will need an array thing here
+    property BandSettings4: TSGBandSettings read FBandsSettings[3] write SetBandSettings4; // will need an array thing here
+    property TextSettings1: TSGTextSettings read FTextsSettings[0] write SetTextSettings1;
+    property TextSettings2: TSGTextSettings read FTextsSettings[1] write SetTextSettings2;
+    property TextSettings3: TSGTextSettings read FTextsSettings[2] write SetTextSettings3;
+    property RangeLedSettings: TSGRangeCheckLEDSettings read FRangeLEDSettings write SetRangeLedSettings;
+    property MarkerSettings1: TSGMarkerSettings read FMarkersSettings[0] write SetMarkerSettings1;
+    property MarkerSettings2: TSGMarkerSettings read FMarkersSettings[1] write SetMarkerSettings2;
+    property MarkerSettings3: TSGMarkerSettings read FMarkersSettings[2] write SetMarkerSettings3;
+    property MinValue: single read GetMinValue write SetMinValue default 0.0;
+    property MaxValue: single read GetMaxValue write SetMaxValue default 100.0;
+    property AutoScale: boolean read FAutoScale write SetAutoScale default False;
+    property Value: single read GetValue write SetValue default 0.0;
+    property OutOfRange: TSGRangeStateErrorEvent read FOutOfRange write FOutOfRange;
+    property BackInRange: TSGRangeStateOKEvent read FBackInRange write FBackInRange;
+    property RangeLEDActive: TSGRangeStateChangeEvent read FRangeLEDActive write FRangeLEDActive;
+    property RangeLEDInActive: TSGRangeStateChangeEvent read FRangeLEDInactive write FRangeLEDInactive;
+    function RemapRange(OldValue: single; OldMin, OldMax, NewMin, NewMax: single): single;
+    function GaugeToUser(GaugeValue: single): single;
+    function UserToGauge(UserValue: single): single;
+
+    procedure Paint; override;
+    procedure DrawFrame;
+    procedure DrawFace;
+    procedure DrawScale;
+    procedure DrawBand(const BandSettings: TSGBandSettings);
+    procedure DrawBands;
+    procedure DrawMulti;
+    procedure DrawText(TextBitmap: TBGRABitmap; const TextSettings: TSGTextSettings);
+    procedure DrawLed;
+    procedure DrawMarker(MarkerBitmap: TBGRABitmap; const MarkerSettings: TSGMarkerSettings);
+    procedure DrawMarkers;
+    procedure DrawPointer;
+    procedure DrawPointerCap;
+    function CheckRangeLED(AValue: single): boolean;
+  end;
+
+  { TSuperGauge }
+
+  TSuperGauge = class(TSGCustomSuperGauge)
+  private
+    { Private declarations }
+  protected
+    { Protected declarations }
+  public
+    { Public declarations }
+  published
+    { Published declarations }
+    property MinValue;
+    property MaxValue;
+    property FaceSettings;
+    property BandSettings1;
+    property BandSettings2;
+    property BandSettings3;
+    property BandSettings4;
+    property TextSettings1;
+    property TextSettings2;
+    property TextSettings3;
+    property FrameSettings;
+    property ScaleSettings;
+    property RangeLedSettings;
+
+    property MarkerSettings1;
+    property MarkerSettings2;
+    property MarkerSettings3;
+
+    property PointerSettings;
+    property PointerCapSettings;
+    property AutoScale;
+    property Value;
+    property OutOfRange;
+    property BackInRange;
+    property RangeLEDActive;
+    property RangeLEDInactive;
+    property Color default clNone;
+
+    // Added missing events
+
+    property Anchors;
+    property OnClick;
+    property OnDblClick;
+    property OnMouseDown;
+    property OnMouseUp;
+    property OnMouseMove;
+    property OnMouseEnter;
+    property OnMouseLeave;
+  end;
+
+  {$IFDEF FPC}procedure Register;{$ENDIF}
+
+implementation
+{$IFDEF FPC}
+procedure Register;
+begin
+  RegisterComponents('BGRA Controls', [TSuperGauge]);
+end;
+{$ENDIF}
+
+{ TSGCustomSuperGauge }
+
+constructor TSGCustomSuperGauge.Create(AOwner: TComponent);
+var
+    i: integer;
+begin
+  inherited Create(AOwner);
+
+  Width := 240;
+  Height := 240;
+
+  FFaceSettings := TSGFaceSettings.Create;
+  FaceSettings.OnChange := DoChange;
+  FaceSettings.Picture.OnChange := DoPictureChange; // need to set this so we can catch changes to the picture!
+
+  FFrameSettings := TSGFrameSettings.Create;
+  FrameSettings.OnChange := DoChange;
+
+  FScaleSettings := TSGScaleSettings.Create;
+  ScaleSettings.OnChange := DoChange;
+
+  for i := low(FBandsSettings) to high(FBandsSettings) do
+  begin
+    FBandsSettings[i] := TSGBandSettings.Create;
+    FBandsSettings[i].OnChange := DoChange;
+    FBandsSettings[i].Text := 'Band ' + IntToStr(i + 1);
+  end;
+
+  for i := low(FTextsSettings) to high(FTextsSettings) do
+  begin
+    FTextsSettings[i] := TSGTextSettings.Create;
+    FTextsSettings[i].OnChange := DoChange;
+    FTextsBitmaps[i] := TBGRABitmap.Create;
+  end;
+
+  // Set Text font change events and defaults
+
+  FTextsSettings[0].FontEx.OnChange := DoChangeFont1;
+  FTextsSettings[1].FontEx.OnChange := DoChangeFont2;
+  FTextsSettings[2].FontEx.OnChange := DoChangeFont3;
+  FTextsSettings[0].Text := 'Text1';
+  FTextsSettings[1].Text := 'Text2';
+  FTextsSettings[2].Text := 'Text3';
+
+  // Pointer Cap
+
+  FPointerCapSettings := TSGPointerCapSettings.Create;
+  FPointerCapSettings.OnChange := DoChange;
+
+  // Pointer
+
+  FPointerSettings := TSGPointerSettings.Create;
+  FPointerSettings.OnChange := DoChange;
+  FPointerSettings.Color := BGRA(255, 127, 63); // orange
+
+  // RangeLED
+
+  FRangeLEDSettings := TSGRangeCheckLEDSettings.Create;
+  FRangeLEDSettings.OnChange := DoRangeLEDChange;
+
+  // Markers
+
+  for i := low(FMarkersSettings) to high(FMarkersSettings) do
+  begin
+    FMarkersSettings[i] := TSGMarkerSettings.Create;
+    FMarkersSettings[i].OnChange := DoChange;
+  end;
+
+  // make marker each different to save confusion
+
+  FMarkersSettings[0].Color := clLime;
+  FMarkersSettings[1].Color := clRed;
+  FMarkersSettings[2].Color := clYellow;
+
+  // create needed bitmaps, Don't Forget to FREE!!!
+
+  FFaceBitmap := TBGRABitmap.Create;
+  FFrameBitmap := TBGRABitmap.Create;
+  FGaugeBitmap := TBGRABitmap.Create;
+  FTextBitmap := TBGRABitmap.Create;
+  FPointerBitmap := TBGRABitmap.Create;
+  FPointerCapBitmap := TBGRABitmap.Create;
+  FScaleBitmap := TBGRABitmap.Create;
+  FBandBitmap := TBGRABitmap.Create;
+  FMultiBitmap := TBGRABitmap.Create;
+  FLEDActiveBitmap := TBGRABitmap.Create;
+  FLEDInActiveBitmap := TBGRABitmap.Create;
+  FMarkerBitmap := TBGRABitmap.Create;
+
+  // initialized (some above)
+
+  FOutOfRangeState := False;
+  FRangeLEDStateChanged := False;
+  FValue := 0;
+  FAutoScale := false;
+  FMinValue := 0;
+  FMaxValue := 100;
+  Color := clNone;
+  FDirty := True;   // Always force initial paint/draw on everything!
+end;
+
+destructor TSGCustomSuperGauge.Destroy;
+var
+    i: integer;
+begin
+
+  FPointerCapSettings.OnChange := nil;
+  FPointerCapSettings.Free;
+
+  FPointerSettings.OnChange := nil;
+  FPointerSettings.Free;
+
+  FRangeLEDSettings.OnChange := nil;
+  FRangeLEDSettings.Free;
+
+  ScaleSettings.OnChange := nil;
+  FScaleSettings.Free;
+
+  for i := low(FTextsSettings) to high(FTextsSettings) do
+  begin
+   FBandsSettings[i].OnChange := nil;
+   FBandsSettings[i].Free;
+  end;
+
+  for i := low(FTextsSettings) to high(FTextsSettings) do
+  begin
+   FTextsSettings[i].OnChange := nil;
+   FTextsSettings[i].FontEx.OnChange := nil;
+   FTextsSettings[i].Free;
+   FTextsBitmaps[i].Free;
+  end;
+
+  for i := low(FMarkersSettings) to high(FMarkersSettings) do
+  begin
+   FMarkersSettings[i].OnChange := nil;
+   FMarkersSettings[i].Free;
+  end;
+
+  FFaceSettings.OnChange := nil;
+  FFaceSettings.Free;
+
+  FFrameSettings.OnChange := nil;
+  FFrameSettings.Free;
+
+  // now clean bitmaps, should match what's in creat method
+
+  FLEDActiveBitmap.Free;
+  FLEDInactiveBitmap.Free;
+  FMarkerBitmap.Free;
+  FBandBitmap.Free;
+  FScaleBitmap.Free;
+  FPointerBitmap.Free;
+  FPointerCapBitmap.Free;
+  FTextBitmap.Free;
+  FFaceBitmap.Free;
+  FMultiBitmap.Free;
+  FFrameBitmap.Free;
+  FGaugeBitmap.Free;
+
+  inherited Destroy;
+end;
+
+function TSGCustomSuperGauge.RemapRange(OldValue: single; OldMin, OldMax, NewMin, NewMax: single): single;
+begin
+  // Generic mapping of ranges. Value is the number to remap, returns number
+  // in the new range. Looks for odd div by 0 condition and fixes
+
+  if OldMin = OldMax then
+  begin
+    // need to return something reasonable
+
+    if OldValue <= OldMin then
+      Exit(NewMin)
+    else
+      Exit(NewMax);
+  end;
+
+  Result := (((OldValue - OldMin) * (NewMax - NewMin)) / (OldMax - OldMin)) + NewMin;
+end;
+
+function TSGCustomSuperGauge.GaugeToUser(GaugeValue: single): single;
+begin
+  // Helper to translates internal gauge value to external user value
+
+  Result := RemapRange(GaugeValue, INTERNAL_GAUGE_MIN_VALUE, INTERNAL_GAUGE_MAX_VALUE, FMinValue, FMaxValue);
+end;
+
+function TSGCustomSuperGauge.UserToGauge(UserValue: single): single;
+begin
+  // Helper to translates external user value to internal gauge value
+
+  Result := RemapRange(UserValue, FMinValue, FMaxValue, INTERNAL_GAUGE_MIN_VALUE, INTERNAL_GAUGE_MAX_VALUE);
+end;
+
+function TSGCustomSuperGauge.GetValue: single;
+begin
+  // Scale from internal back to user range
+
+  Result := GaugeToUser(FValue);
+end;
+
+procedure TSGCustomSuperGauge.SetValue(AValue: single);
+var
+    gaugeValue: single;
+begin
+
+  // Tricky case here, since we are calling the RangeLED range check
+  // here too, if that is in any way dirty we should process the value
+  // and not skip. Triggering any change on RangeLEDSettings should call this.
+
+  // Get the user value into gauge value space
+
+  gaugeValue := UserToGauge(AValue);
+
+  // skip if a few conditions exit. This is a bit tricky as the gauge value will reset
+  // to min or max values on overload so need to always update if that's the case. Should
+  // not affect performance. Similar for LED, if dirty no skip.
+
+  if (FValue = gaugeValue) and (not FRangeLEDSettings.Dirty) and (not FOutOfRangeState) then
+    Exit;
+
+  // If out of range conditions are at play the gauge Value (FValue) will never
+  // be out of range. This value is passed to the out of range handler for the
+  // user to deal with and DO SOMETHING to indicate it.
+
+  FValue := CheckOutOfRange(gaugeValue);
+
+  // If we have a change in the of the LED's Active property we need
+  // to call the event handlers too. Also we will check it's values and set
+  // if needed. NOTE : that if the range type is set to rtNone, it will always
+  // return the state of the RangeLEDSettings.Active, otherwise it will calculate
+  // the needed value for a range check as set. FRangeLEDStateChanged is set in
+  // IsRangeLEDActive function so should be called before this!
+
+  // MUST NOT CALL .Active as this will cause a recursive call, use the
+  // hacked ActiveNoDoChange which will just set the property value with
+  // no side effects
+
+  // True if LED Should be On, False if not, AValue is in User space for LED's
+
+  FRangeLEDSettings.ActiveNoDoChange := CheckRangeLED(AValue);
+
+  // We must dirty the Pointer here or no redraw
+
+  PointerSettings.Dirty := True;
+  DoChange(self);
+end;
+
+function TSGCustomSuperGauge.CheckOutOfRange(AValue: single): Single;
+begin
+  // These values are in gauge space, so typically never less than 0, or > 270
+
+  Result := AValue; // SAFE so always will return a value
+
+  if AValue < INTERNAL_GAUGE_MIN_VALUE then
+  begin
+    // Under Range event
+
+    FOutOfRangeState := True;
+    if Assigned(FOutOfRange) then
+      FOutOfRange(Self, GaugeToUser(AValue));
+    Result := INTERNAL_GAUGE_MIN_VALUE;
+  end
+    else
+      if AValue > INTERNAL_GAUGE_MAX_VALUE then
+      begin
+        // Over Range event
+
+        FOutOfRangeState := True;
+        if Assigned(FOutOfRange) then
+          FOutOfRange(Self, GaugeToUser(AValue)); // must translate back to user space
+        Result := INTERNAL_GAUGE_MAX_VALUE;
+      end
+      else
+        begin
+          // If NOT over/under flow then will need to clear
+          // that state/flag and reset any indicators if was in a overange state
+
+          if FOutOfRangeState then
+          begin
+            if Assigned(FBackInRange) then
+              FBackInRange(self, GaugeToUser(AValue)); // here to, get into user space
+
+            FOutOfRangeState := False;  // reset so no more calls
+          end;
+      end;
+end;
+
+procedure TSGCustomSuperGauge.SetAutoScale(AValue: boolean);
+begin
+  if FAutoScale = AValue then
+    exit;
+
+  FAutoScale := AValue;
+  FScaleSettings.Dirty := True;  // set it, as it will need a repaint
+
+  DoChange(self);
+end;
+
+function TSGCustomSuperGauge.GetMaxValue: single;
+begin
+  Result := FMaxValue;
+end;
+
+procedure TSGCustomSuperGauge.SetMaxValue(AValue: single);
+var
+    currUser: single;
+begin
+  // Note : MinValue and MaxValue can span negative ranges and be increasing
+  //        or decreasing
+
+  // Min and Max out of order, bounce
+
+  if (FMinValue >= AValue) then
+    exit;
+
+  // If changing min/max must refresh the value to adjust
+
+  currUser := GaugeToUser(FValue);
+  FMaxValue := AValue;  // setting this will change UserToGauge() in SetValue!
+
+  // Recompute
+
+  SetValue(currUser);
+end;
+
+function TSGCustomSuperGauge.GetMinValue: single;
+begin
+  Result := FMinValue;
+end;
+
+procedure TSGCustomSuperGauge.SetMinValue(AValue: single);
+var
+    currUser: single;
+begin
+  // Note : MinValue and MaxValue can span negative ranges and be increasing
+  //        or decreasing
+
+  // Min and Max out of order, bounce
+
+  if (FMaxValue <= AValue) then
+    exit;
+
+  // If changing min/max must refresh the value to adjust
+
+  currUser := GaugeToUser(FValue);
+  FMinValue := AValue;  // setting this will change UserToGauge() in SetValue!
+
+  // Recompute
+
+  SetValue(currUser);
+end;
+
+procedure TSGCustomSuperGauge.SetFaceSettings(AValue: TSGFaceSettings);
+begin
+  if FFaceSettings = AValue then
+    Exit;
+
+  FFaceSettings := AValue;
+  FFaceSettings.Dirty := True;  // set it, as it will need a repaint
+
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.SetFrameSettings(AValue: TSGFrameSettings);
+begin
+  if FFrameSettings = AValue then
+    Exit;
+
+  FFrameSettings := AValue;
+  FFrameSettings.Dirty := True;  // set it, as it will need a repaint
+
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.SetScaleSettings(AValue: TSGScaleSettings);
+begin
+  if FScaleSettings = AValue then
+    Exit;
+
+  FScaleSettings := AValue;
+  FScaleSettings.Dirty := True;
+
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.SetAllBandsDirtyState(AValue: boolean);
+var
+  i: integer;
+begin
+  // helper to just set all bands to a specific state!
+
+  for i := low(FBandsSettings) to high(FBandsSettings) do
+    FBandsSettings[i].Dirty := AValue;
+end;
+
+function TSGCustomSuperGauge.IsAnyBandDirty : boolean;
+var
+  i: integer;
+begin
+  // helper to just see if any band has a dirty flag
+
+  for i := low(FBandsSettings) to high(FBandsSettings) do
+  begin
+    if FBandsSettings[i].Dirty then
+      exit(True);
+  end;
+
+  result := False;
+end;
+
+procedure TSGCustomSuperGauge.SetBandSettings1(AValue: TSGBandSettings);
+begin
+  if FBandsSettings[0] = AValue then
+    Exit;
+
+  FBandsSettings[0] := AValue;
+  FBandsSettings[0].Dirty := True;
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.SetBandSettings2(AValue: TSGBandSettings);
+begin
+  if FBandsSettings[1] = AValue then
+    Exit;
+
+  FBandsSettings[1] := AValue;
+  FBandsSettings[1].Dirty := True;
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.SetBandSettings3(AValue: TSGBandSettings);
+begin
+  if FBandsSettings[2] = AValue then
+    Exit;
+
+  FBandsSettings[2] := AValue;
+  FBandsSettings[2].Dirty := True;
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.SetBandSettings4(AValue: TSGBandSettings);
+begin
+  if FBandsSettings[3] = AValue then
+    Exit;
+
+  FBandsSettings[3] := AValue;
+  FBandsSettings[3].Dirty := True;
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.SetAllTextsDirtyState(AValue: boolean);
+var
+  i: integer;
+begin
+  // helper to just set all texts to a specific state!
+
+  for i := low(FTextsSettings) to high(FTextsSettings) do
+    FTextsSettings[i].Dirty := AValue;
+end;
+
+procedure TSGCustomSuperGauge.SetTextSettings1(AValue: TSGTextSettings);
+begin
+  if FTextsSettings[0] = AValue then
+    Exit;
+
+  FTextsSettings[0] := AValue;
+  FTextsSettings[0].Dirty := True;  // set it, as it will need a repaint
+
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.SetTextSettings2(AValue: TSGTextSettings);
+begin
+  if FTextsSettings[1] = AValue then
+    Exit;
+
+  FTextsSettings[1] := AValue;
+  FTextsSettings[1].Dirty := True;
+
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.SetTextSettings3(AValue: TSGTextSettings);
+begin
+  if FTextsSettings[2] = AValue then
+    Exit;
+
+  FTextsSettings[2] := AValue;
+  FTextsSettings[2].Dirty := True;
+
+  DoChange(self);
+end;
+
+function TSGCustomSuperGauge.IsAnyMarkerDirty: boolean;
+var
+  i: integer;
+begin
+  // helper to just see if any band has a dirty flag
+
+  for i := low(FMarkersSettings) to high(FMarkersSettings) do
+  begin
+    if FMarkersSettings[i].Dirty then
+      exit(True);
+  end;
+
+  result := False;
+end;
+
+procedure TSGCustomSuperGauge.SetAllMarkersDirtyState(AValue: boolean);
+var
+  i: integer;
+begin
+  // helper to just set all markers to a specific state!
+
+  for i := low(FMarkersSettings) to high(FMarkersSettings) do
+    FMarkersSettings[i].Dirty := AValue;
+end;
+
+procedure TSGCustomSuperGauge.SetMarkerSettings1(AValue: TSGMarkerSettings);
+begin
+  if FMarkersSettings[0] = AValue then
+    Exit;
+
+  FMarkersSettings[0] := AValue;
+  FMarkersSettings[0].Dirty := True;
+
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.SetMarkerSettings2(AValue: TSGMarkerSettings);
+begin
+  if FMarkersSettings[1] = AValue then
+    Exit;
+
+  FMarkersSettings[1] := AValue;
+  FMarkersSettings[1].Dirty := True;
+
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.SetMarkerSettings3(AValue: TSGMarkerSettings);
+begin
+  if FMarkersSettings[2] = AValue then
+    Exit;
+
+  FMarkersSettings[2] := AValue;
+  FMarkersSettings[2].Dirty := True;
+
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.SetPointerSettings(AValue: TSGPointerSettings);
+begin
+  if FPointerSettings = AValue then
+    Exit;
+
+  FPointerSettings := AValue;
+  FPointerSettings.Dirty := True;
+
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.SetRangeLedSettings(AValue: TSGRangeCheckLEDSettings);
+begin
+  if FRangeLEDSettings = AValue then
+    Exit;
+
+  FRangeLEDSettings := AValue;
+  FRangeLEDSettings.Dirty := True;
+
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.SetPointerCapSettings(AValue: TSGPointerCapSettings);
+begin
+  if FPointerCapSettings = AValue then
+    Exit;
+
+  FPointerCapSettings := AValue;
+  FPointerCapSettings.Dirty := True;
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.DoSetBounds(ALeft, ATop, AWidth, AHeight: Integer);
+begin
+  inherited;
+  FDirty := true; // Called on Resize of component
+end;
+
+procedure TSGCustomSuperGauge.DoChange(Sender: TObject);
+begin
+  Invalidate;
+end;
+
+procedure TSGCustomSuperGauge.DoRangeLEDChange(Sender: TObject);
+begin
+  // This is needed as anytime a RangeLED settings is updated we
+  // MAY need to update and call event handlers. update as the RangeLEDSettings.Dirty
+
+  CheckRangeLED(Value); // Tricky may not work!
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.DoPictureChange(Sender: TObject);
+begin
+  // This is similar to DoRangeLEDChange, if we have a picture change this
+  // is how we can propagate it up to the gauge to tell if a repaint is needed.
+
+  FaceSettings.Dirty := True;  // trigger a redraw since the image has changed
+  DoChange(Sender);
+end;
+
+
+procedure TSGCustomSuperGauge.DoChangeFont1(ASender: TObject; AData: PtrInt);
+begin
+  // Simlar to the regular dochange but needed a different procedure signature
+  // so just a wrapper, TObject is not a gauge so use Self here for DoChange()
+
+  FTextsSettings[0].Dirty := True;
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.DoChangeFont2(ASender: TObject; AData: PtrInt);
+begin
+  // Simlar to the regular dochange but needed a different procedure signature
+  // so just a wrapper, TObject is not a gauge so use Self here for DoChange()
+
+  FTextsSettings[1].Dirty := True;
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.DoChangeFont3(ASender: TObject; AData: PtrInt);
+begin
+  // Simlar to the regular dochange but needed a different procedure signature
+  // so just a wrapper, TObject is not a gauge so use Self here for DoChange()
+
+  FTextsSettings[2].Dirty := True;
+  DoChange(self);
+end;
+
+procedure TSGCustomSuperGauge.Paint;
+var
+  i: integer;
+  offsetX, offsetY: integer;
+  gaugeCenX, gaugeCenY: integer;
+begin
+  inherited Paint;
+
+  // IF the component is resized OR moved (this is safer) we
+  // need to make sure EVERYTHING redraws. The base class will
+  // also do it's own thing to invalidate and redraw it all.
+
+  if FDirty then
+  begin
+    FFrameSettings.Dirty := True;
+    FFaceSettings.Dirty := True;
+    FScaleSettings.Dirty := True;
+    SetAllBandsDirtyState(True);
+    SetAllTextsDirtyState(True);
+    FRangeLEDSettings.Dirty := True;
+    FPointerCapSettings.Dirty := True;
+    FPointerSettings.Dirty := True;
+    SetAllMarkersDirtyState(True);
+    FDirty := False;  // everything here marked, so can reset
+  end;
+
+  // Now start Drawing into the offscreen bitmaps. IF the particular
+  // subcomponent is not changed, the DrawXXXX will just leave it as is
+  // and not waste cycles to redraw it.
+
+  FGaugeBitmap.SetSize(Width, Height);
+
+  // If the gauge color is clNone then we start with a transparent background,
+  // Otherwise we start with the users color.
+
+  if Color = clNone then
+    FGaugeBitmap.Fill(BGRA(0, 0, 0, 0))  // fill transparent
+  else
+    FGaugeBitmap.Fill(ColorToBGRA(Color, 255));  // fill solid color
+
+  gaugeCenX := FGaugeBitmap.Width div 2;
+  gaugeCenY := FGaugeBitmap.Height div 2;
+
+  // Face, Frame, Scale and Bands are usually static, so do yet another
+  // bitmap for these that will require less Blend Images.
+
+  DrawMulti;
+  FGaugeBitmap.BlendImage(0, 0, FMultiBitmap, boLinearBlend);
+
+  // now draw any texts if enabled and dirty
+
+  for i := low(FTextsSettings) to high(FTextsSettings) do
+  begin
+    if FTextsSettings[i].Enabled then
+    begin
+      DrawText(FTextsBitmaps[i], FTextsSettings[i]);
+      offsetX := FTextsSettings[i].OffsetX + gaugeCenX - FTextsBitmaps[i].Width div 2;
+      offsetY := FTextsSettings[i].OffsetY + gaugeCenY - FTextsBitmaps[i].Height div 2;
+      FGaugeBitmap.BlendImage(offsetX, offsetY, FTextsBitmaps[i], boLinearBlend);
+    end;
+  end;
+
+  FGaugeBitmap.BlendImage(offsetX, offsetY, FTextBitmap, boLinearBlend);
+
+  // Draw range LED, small bitmap so center and move
+
+  DrawLed;
+  offsetX := FRangeLEDSettings.OffsetX + gaugeCenX - FLEDActiveBitmap.Width div 2;
+  offsetY := FRangeLEDSettings.OffsetY + gaugeCenY - FLEDActiveBitmap.height div 2;
+
+  // set up the led, if user sets Active state will keep led on even if
+  // the out of range state is set.
+
+  if FRangeLEDSettings.Active then
+    FGaugeBitmap.BlendImage(offsetX, offsetY, FLEDActiveBitmap, boLinearBlend)
+  else
+    FGaugeBitmap.BlendImage(offsetX, offsetY, FLEDInActiveBitmap, boLinearBlend);
+
+  // Draw Markers BEFORE the pointer(s)
+
+  DrawMarkers;
+  FGaugeBitmap.BlendImage(0, 0, FMarkerBitmap,boLinearBlend);
+
+  // draw cap over or under the pointer. Note that the pointer is a special
+  // case when drawing since it's almost always dirty.
+
+  if PointerCapSettings.CapStyle <> csNone then
+    begin
+      DrawPointerCap;
+      offsetX := gaugeCenX  - FPointerCapBitmap.Width div 2;
+      offsetY := gaugeCenY - FPointerCapBitmap.Height div 2;
+
+      if PointerCapSettings.CapPosition = cpOver then
+        begin
+          DrawPointer;
+          FGaugeBitmap.BlendImage(offsetX, offsetY, FPointerCapBitmap, boLinearBlend); // Cap on top
+        end
+      else
+        begin
+          FGaugeBitmap.BlendImage(offsetX, offsetY, FPointerCapBitmap, boLinearBlend); // Cap on Bottom
+          DrawPointer;
+        end;
+    end
+      else
+        DrawPointer;
+
+  // make it all visable to the user!
+
+  FGaugeBitmap.Draw(Canvas, 0, 0, False);
+end;
+
+procedure TSGCustomSuperGauge.DrawMulti;
+begin
+  // The strategy here is that these typically only change infrequently
+  // so if so, just draw as a bundle and saves some blendimages calls. Each of the
+  // drawXXX still handles it's own dirty flag. The bitmap will be set up
+  // as on instantiation so all of the others have their dirty flag set True, so no
+  // need to do any initialization. Makes painting much faster even
+  // with the individual dirty flags!
+
+  if FFrameSettings.Dirty or FFaceSettings.Dirty or FScaleSettings.Dirty or IsAnyBandDirty then
+    begin
+      Initializebitmap(FMultiBitmap, Width, Height);
+
+      DrawFrame;
+      FMultiBitmap.BlendImage(0, 0, FFrameBitmap, boLinearBlend);
+
+      DrawFace;
+      FMultiBitmap.BlendImage(0, 0, FFaceBitmap, boLinearBlend);
+
+      DrawBands; // will handle the enable/disable and draw of each band
+      FMultiBitmap.BlendImage(0, 0, FBandBitmap, boLinearBlend);
+
+      DrawScale;
+      FMultiBitmap.BlendImage(0, 0, FScaleBitmap, boLinearBlend);
+    end;
+end;
+
+procedure TSGCustomSuperGauge.DrawFrame;
+var
+  Origin: TSGOrigin;
+  r: integer;
+begin
+  if not FrameSettings.Dirty then
+    Exit;
+
+  FrameSettings.Dirty := False;
+
+  Origin := Initializebitmap(FFrameBitmap, Width, Height);
+
+  // Always fills the space so AutoScale is sorta' always on
+
+  r := round(Origin.Radius * 0.95);
+
+  // Draw Bitmap frame
+
+  FFrameBitmap.FillEllipseAntialias(Origin.CenterPoint.x,
+    Origin.CenterPoint.y,
+    r, r, FFrameSettings.FrameColor);
+
+  // Draw thin antialiased border to smooth against background
+
+  FFrameBitmap.EllipseAntialias(Origin.CenterPoint.x,
+    Origin.CenterPoint.y,
+    r, r, FFrameSettings.BorderColor, FFrameSettings.BorderRadius);
+end;
+
+procedure TSGCustomSuperGauge.DrawFace;
+var
+  OriginFace: TSGOrigin;
+  r, d: integer;
+  xb, yb: integer;
+  d2, h: single;
+  Center: TPointF;
+  v: TPointF;
+  p: PBGRAPixel;
+  Image: TBGRABitmap;
+  Mask: TBGRABitmap;
+  Map: TBGRABitmap;
+
+begin
+  if not FaceSettings.Dirty then
+    Exit;
+
+  FaceSettings.Dirty := False;
+
+  OriginFace := Initializebitmap(FFaceBitmap, Width, Height);
+
+  // Always fills the space so AutoScale is sorta' always on for the face
+
+  r := round(OriginFace.Radius * 0.95) - 5;
+
+  // Fill types : fsNone, fsGradient, fsFlat, fsPhong
+
+  case FFaceSettings.FillStyle of
+    fsGradient:
+      begin
+        FFaceBitmap.FillEllipseLinearColorAntialias(OriginFace.CenterPoint.x,
+          OriginFace.CenterPoint.y, r, r, FFaceSettings.OuterColor,
+          FFaceSettings.InnerColor);
+      end;
+
+    fsFlat:
+      begin
+        FFaceBitmap.FillEllipseAntialias(OriginFace.CenterPoint.x, OriginFace.CenterPoint.y,
+          r, r, FFaceSettings.InnerColor);
+      end;
+
+    fsPhong:
+      begin
+        d := r * 2;
+        Center := PointF((d - 1) / 2, (d - 1) / 2);
+        Map := TBGRABitmap.Create(d, d);
+
+        for yb := 0 to d - 1 do
+        begin
+          p := Map.ScanLine[yb];
+
+          for xb := 0 to d - 1 do
+          begin
+            // compute vector between center and current pixel
+
+            v := PointF(xb, yb) - Center;
+
+            // scale down to unit circle (with 1 pixel margin for soft border)
+
+            v.x := v.x / (r + 1);
+            v.y := v.y / (r + 1);
+
+            // compute squared distance with scalar product
+
+            d2 := v {$if FPC_FULLVERSION < 30203}*{$ELSE}**{$ENDIF} v;
+
+            // interpolate as quadratic curve and apply power function
+
+            if d2 > 1 then
+              h := 0
+            else
+              h := power(1 - d2, FFaceSettings.CurveExponent);
+            p^ := MapHeightToBGRA(h, 255);
+            Inc(p);
+          end;
+        end;
+
+        // mask image round with and antialiased border
+
+        Mask := TBGRABitmap.Create(d, d, BGRABlack);
+        Mask.FillEllipseAntialias(Center.x, Center.y, r, r, BGRAWhite);
+        Map.ApplyMask(Mask);
+        Mask.Free;
+
+        // now draw
+
+        FFaceSettings.FPhong.Draw(FFaceBitmap, Map, 30,
+                OriginFace.CenterPoint.x - r, OriginFace.CenterPoint.y - r,
+                FFaceSettings.InnerColor);
+        Map.Free;
+      end;
+  end;
+
+  // see if valid size and enabled, draw if so!
+
+  if ((FaceSettings.Picture.Width > 0) or (FaceSettings.Picture.Height > 0)) and (FFaceSettings.PictureEnabled) then
+  begin
+
+    Image := TBGRABitmap.Create(FaceSettings.Picture.Bitmap);
+    FFaceBitmap.BlendImage(
+                OriginFace.CenterPoint.X + FaceSettings.PictureOffsetX,
+                OriginFace.CenterPoint.y + FaceSettings.PictureOffsetY,
+                image,
+                boLinearBlend);
+    Image.Free; // needed!
+  end;
+end;
+
+procedure TSGCustomSuperGauge.DrawBands;
+var
+  i: integer;
+begin
+  // Draw mult bands on the same bitmap. we can do this since
+  // we are drawing over the entire fullsized bitmap. Since
+  // this is the case, you can draw all of the bands here in one shot
+  // and on one bitmap. Init bitmap here!
+
+  // Only change if something dirty
+  // nothing dirty, no init, no draw, just bounce!
+
+  if not IsAnyBandDirty then
+    exit;
+
+  Initializebitmap(FBandBitmap, Width, Height); // clear it before we draw anything
+
+  for i := low(FBandsSettings) to high(FBandsSettings) do
+  begin
+    FBandsSettings[i].Dirty := True;  // force draw, if any band is dirty they are are dirty
+    DrawBand(FBandsSettings[i]);      // will clear any dirty for specific band
+  end;
+end;
+
+procedure TSGCustomSuperGauge.DrawBand(const BandSettings : TSGBandSettings);
+var
+  BandRadius, TextRadius: single;
+  TextSize: integer;
+  baseAngle, startAngle, endAngle: single;
+  cenX, cenY: integer;
+  fontRenderer: TBGRAVectorizedFontRenderer;
+  TextPath: TBGRAPath;
+begin
+
+  // TODO : Maybe be removed since calling here always paints them all
+  if not BandSettings.Dirty then
+    Exit;
+
+  BandSettings.Dirty := False;
+
+  // Now, if not enabled we can leave if flag reset!
+
+  if not BandSettings.Enabled then
+    exit;
+
+  TextSize := BandSettings.TextSize * 15;
+
+  // Origin := Initializebitmap(FBandBitmap, Width, Height); drawbands needs to set this up
+
+  cenX := Width div 2;
+  cenY := Height div 2;
+
+  BandRadius := BandSettings.BandRadius - BandSettings.Thickness div 2;    // may need to adjust for band thickness
+  TextRadius := BandSettings.TextRadius - BandSettings.TextSize div 2 - BandSettings.Thickness div 2; // offset to center
+
+  // Start = 225 degree is 0 on gague scale (Not the angle), and -45 degree is 100 on scale
+
+  // 270, down (gauge angle 0)180 flat, increase moves towards 0 decrease towards 100
+  // 0 is flat line, right most end. Increase goes backwards towards 0, -45 is 100 percent on scale
+
+  baseAngle := 225 * PI / 180;
+  startAngle := baseAngle - ((BandSettings.StartValue * 270 / 100) * PI / 180);
+  endAngle := baseAngle - ((BandSettings.EndValue * 270 / 100) * PI / 180);
+
+  FBandBitmap.LineCap := pecFlat; // caps should be flat
+  FBandBitmap.Arc(
+                   cenX, cenY,
+                   BandRadius + 0.5, BandRadius + 0.5, // push down a bit
+                   // (360-135) 225, -45
+                   // 3.92699,-0.785398, // must use start and end angle, internally Point calcs won't work due to arcsin2() limits
+                   startAngle, endAngle,
+                   BandSettings.BandColor,
+                   BandSettings.Thickness,
+                   false,
+                   BGRA(0,0,0,0) // last param is alpha, so no interior color, inner routings ONLY draw the arc, no fill
+  );
+
+  if BandSettings.EnableText then
+  begin
+    FontRenderer := TBGRAVectorizedFontRenderer.Create;
+    FBandBitmap.FontRenderer := fontRenderer;     // assign text vectorial font renderer
+    FBandBitmap.FontHeight := round(TextSize * 0.09);
+    FBandBitmap.FontQuality := fqFineAntialiasing;
+    FBandBitmap.FontName := BandSettings.TextFont;
+    FBandBitmap.FontStyle := BandSettings.TextStyle;
+    FontRenderer.OutlineColor := BGRABlack;
+    FontRenderer.OutlineWidth := TextSize / 600;
+    FontRenderer.OutlineVisible := true;
+    FBandBitmap.FontVerticalAnchor := fvaBaseline;
+    TextPath := TBGRAPath.Create;
+
+    // drawing is backwards on textpath
+
+    TextPath.Arc(cenX, cenY, TextRadius, -startAngle, -endAngle, False);
+    FBandBitmap.TextOutCurved(TextPath, BandSettings.Text, BandSettings.TextColor, taCenter, 0);
+  end;
+end;
+
+procedure TSGCustomSuperGauge.DrawText(TextBitmap: TBGRABitmap; const TextSettings: TSGTextSettings);
+var
+  TextBoxWidth, TextBoxHeight: integer;
+  TextRect: TRect;
+begin
+
+  if not TextSettings.Dirty then
+    Exit;
+
+  TextSettings.Dirty := False;
+
+  // get the bounding box so we can create a SMALLER bitmap. This will be referenced
+  // to the Center of the text and gauge
+
+  CalculateTextSize(TextSettings.Text, TextSettings.FontEx, TextBoxWidth, TextBoxHeight, TextSettings.FontEx.Shadow);
+  Initializebitmap(TextBitmap, TextBoxWidth, TextBoxHeight);
+
+  // Set up text bounding box,
+
+  TextRect.Left := 0;
+  TextRect.Top := 0;
+  TextRect.Height := TextBoxHeight;
+  TextRect.Width := TextBoxWidth;
+
+  // Draw into the TextBitmap for later use
+
+  RenderText(TextRect, TextSettings.FontEx, TextSettings.Text, TextBitmap, Enabled);
+end;
+
+procedure TSGCustomSuperGauge.DrawScale;
+var
+  Origin: TSGOrigin;
+  i, n, x, y, xt, yt: integer;
+  scaleStartValue, scaleBump: integer;
+  ScaleRadius, TextRadius: single;
+  TextSize: integer;
+  pStart, pEnd: TPointF;
+  startAngle, endAngle: single;
+  innerTicRadius: single;
+begin
+  // if nothing dirty then skip it, we have a bitmap with
+  // the scale already drawn. This is slow so saves a lot of time
+  // as scales are slow to draw
+
+  if not ScaleSettings.Dirty then
+    Exit;
+
+  ScaleSettings.Dirty := False;  // mark as clean, so next run will not need a rebuild!
+
+  Origin := Initializebitmap(FScaleBitmap, Width, Height);
+
+  // Calc radius for scale and text or set it from the user
+
+  if FAutoScale then
+  begin
+    ScaleRadius := Round(Origin.Radius * 0.90);
+    TextRadius := Round(Origin.Radius * 0.65);
+    TextSize := Round(Origin.Radius * 0.15);
+
+    // fix up scaling for small or large gauges
+
+    if (Width < 250) or (Height < 250) then
+    begin
+      TextSize := 15;
+      TextRadius := TextRadius - 10;
+    end
+    else
+      begin
+        if (Width > 500) or (Height > 500) then
+        begin
+          TextSize := TextSize + 5;
+          TextRadius := TextRadius + 10;
+        end;
+      end;
+    end
+  else
+    begin
+      ScaleRadius := ScaleSettings.ScaleRadius;
+      TextRadius := ScaleSettings.TextRadius;
+      TextSize := ScaleSettings.TextSize;
+    end;
+
+  // Draw SubTicks
+
+  if ScaleSettings.EnableSubTicks then
+  begin
+    n := ScaleSettings.MainTickCount * ScaleSettings.SubTickCount;
+
+    for i := 0 to n do
+    begin
+      // Calculate draw from point
+
+      X := Origin.CenterPoint.x - Round(ScaleRadius * cos((-45 + i * 270 / n) * Pi / 180));
+      Y := Origin.CenterPoint.y - Round(ScaleRadius * sin((-45 + i * 270 / n) * Pi / 180));
+
+      // Calculate draw to point
+
+      Xt := Origin.CenterPoint.x - Round((ScaleRadius - ScaleSettings.LengthSubTick) *
+        cos((-45 + i * 270 / n) * Pi / 180));
+      Yt := Origin.CenterPoint.y - Round((ScaleRadius - ScaleSettings.LengthSubTick) *
+        sin((-45 + i * 270 / n) * Pi / 180));
+
+      FScaleBitmap.DrawLineAntialias(x, y, xt, yt, ScaleSettings.TickColor, ScaleSettings.ThicknessSubTick);
+
+      if (ScaleSettings.TickArcStyle = taboth) and (not ScaleSettings.EnableMainTicks) then
+        begin
+          // need caps on the ends so the gauge doesn't look stupid if both inner and outer
+          // tic arcs are visiable
+
+          if (i = 0) or (i = n) then
+            begin
+              if not ScaleSettings.EnableMainTicks then
+                innerTicRadius := ScaleSettings.LengthSubTick
+              else
+                innerTicRadius := ScaleSettings.LengthMainTick;
+
+              // draw end pieces in the MainTick thickness to match
+
+              Xt := Origin.CenterPoint.x - Round((ScaleRadius - innerTicRadius) *
+                cos((-45 + i * 270 / n) * Pi / 180));
+              Yt := Origin.CenterPoint.y - Round((ScaleRadius - innerTicRadius) *
+                sin((-45 + i * 270 / n) * Pi / 180));
+
+              FScaleBitmap.DrawLineAntialias(x, y, xt, yt, ScaleSettings.TickColor,
+                ScaleSettings.ThicknessMainTick);
+            end;
+        end;
+    end;
+  end;
+
+  // Draw after the sub-tics
+
+  if ScaleSettings.EnableMainTicks then
+  begin
+    n := ScaleSettings.MainTickCount;
+
+    for i := 0 to n do
+    begin
+
+      // Draw main ticks
+      // Calculate draw from point bottom
+
+      x := Origin.CenterPoint.x - Round(ScaleRadius * cos((-45 + i * 270 / n) * Pi / 180));
+      y := Origin.CenterPoint.y - Round(ScaleRadius * sin((-45 + i * 270 / n) * Pi / 180));
+
+      // Calculate draw to point top
+
+      xt := Origin.CenterPoint.x - Round((ScaleRadius - ScaleSettings.LengthMainTick) *
+        cos((-45 + i * 270 / n) * Pi / 180));
+      yt := Origin.CenterPoint.y - Round((ScaleRadius - ScaleSettings.LengthMainTick) *
+        sin((-45 + i * 270 / n) * Pi / 180));
+
+      FScaleBitmap.DrawLineAntialias(x, y, xt, yt, ScaleSettings.TickColor, ScaleSettings.ThicknessMainTick);
+    end;
+  end;
+
+  // Draw text, these are only for the Main Ticks
+
+  if ScaleSettings.EnableScaleText then
+    begin
+
+      FScaleBitmap.FontName := ScaleSettings.TextFont;
+      FScaleBitmap.FontHeight := TextSize;
+      FScaleBitmap.FontQuality := fqFineAntialiasing;
+      FScaleBitmap.FontStyle := FScaleSettings.TextStyle;
+
+      n := ScaleSettings.MainTickCount;
+
+      // if draw the scale reversed, do some tricky stuff so we can
+      // count up or down. Start is swapped with the actual end value here
+
+      if ScaleSettings.ReverseScale then
+      begin
+        scaleBump := -1;
+        scaleStartValue := n * ScaleSettings.Step + ScaleSettings.Start;
+      end
+      else
+      begin
+        scaleBump := 1;
+        scaleStartValue := ScaleSettings.Start;
+      end;
+
+      // Draw text for main ticks
+
+      for i := 0 to n do
+      begin
+        xt := Origin.CenterPoint.x - Round(TextRadius * cos((-45 + i * 270 / n) * Pi / 180));
+        yt := Origin.CenterPoint.y - Round(TextRadius * sin((-45 + i * 270 / n) * Pi / 180));
+
+        FScaleBitmap.TextOut(xt, yt - (FScaleBitmap.FontHeight / 1.7),
+          IntToStr(scaleStartValue + i * ScaleSettings.Step * scaleBump),
+          ScaleSettings.TextColor, taCenter);
+      end;
+    end;
+
+    // draw outer rings/bands
+
+    if (ScaleSettings.TickArcStyle = taOuter) or (ScaleSettings.TickArcStyle = taboth) then
+    begin
+      // draw arc OUSIDE on the tics, doesn't matter main or sub, all at the top
+      // inner of tic
+
+      pStart.x := Origin.CenterPoint.x - Round(ScaleRadius * cos(-45 * Pi / 180));
+      pStart.y := Origin.CenterPoint.y - Round(ScaleRadius * sin(-45 * Pi / 180));
+
+      startAngle := arctan2((Origin.CenterPoint.y - pStart.y),(Origin.CenterPoint.x - pStart.x)) + 4.71239; // add 270
+
+      // Calculate draw to point outer
+
+      pEnd.x := Origin.CenterPoint.x - Round((ScaleRadius - ScaleSettings.LengthMainTick) * cos(225 * Pi / 180));
+      pEnd.y := Origin.CenterPoint.y - Round((ScaleRadius - ScaleSettings.LengthMainTick) * sin(225 * Pi / 180));
+
+      endAngle :=  -arctan2((pEnd.y - Origin.CenterPoint.y),(pEnd.x - Origin.CenterPoint.x));
+      FScaleBitmap.Arc(
+                     Origin.CenterPoint.x, Origin.CenterPoint.y,
+                     ScaleRadius + 0.5, ScaleRadius + 0.5, // push down a bit
+                     startAngle, endAngle,
+                     ScaleSettings.TickColor,
+                     ScaleSettings.ThicknessMainTick,
+                     false,
+                     BGRA(0,0,0,0) // last param is alpha, so no interior color, inner routings ONLY draw the arc, no fill
+                     );
+    end;
+
+    if (ScaleSettings.TickArcStyle = taInner) or (ScaleSettings.TickArcStyle = taBoth) then
+    begin
+      // Inner will chose main tics (for now) if both main and sub tics on)
+      // will need to find out the radius for what selected... or do something
+      // like use what ever tic is LONGER (logic here will need a change)
+
+      // draw arc OUSIDE on the tics, doesn't matter main or sub, all at the top
+
+      // inner of tick
+
+      pStart.x := Origin.CenterPoint.x - Round(ScaleRadius * cos(-45 * Pi / 180));
+      pStart.y := Origin.CenterPoint.y - Round(ScaleRadius * sin(-45 * Pi / 180));
+
+      startAngle := arctan2((Origin.CenterPoint.y - pStart.y),(Origin.CenterPoint.x - pStart.x)) + 4.71239; // add 270
+
+      // Calculate draw to point outer
+
+      pEnd.x := Origin.CenterPoint.x - Round((ScaleRadius - ScaleSettings.LengthMainTick) * cos(225 * Pi / 180));
+      pEnd.y := Origin.CenterPoint.y - Round((ScaleRadius - ScaleSettings.LengthMainTick) * sin(225 * Pi / 180));
+
+      endAngle := -arctan2((pEnd.y - Origin.CenterPoint.y),(pEnd.x - Origin.CenterPoint.x));
+
+      // be nice and if not displaying main tics, use the sub tic length to bottom
+      // up against them
+
+      if not ScaleSettings.EnableMainTicks then
+        innerTicRadius := ScaleSettings.LengthSubTick
+     else
+        innerTicRadius := ScaleSettings.LengthMainTick;
+
+      FScaleBitmap.Arc(
+                     Origin.CenterPoint.x, Origin.CenterPoint.y,
+                     ScaleRadius - 0.5 - innerTicRadius, ScaleRadius - 0.5 - innerTicRadius,
+                     startAngle, endAngle,
+                     ScaleSettings.TickColor,
+                     ScaleSettings.ThicknessMainTick,
+                     false,
+                     BGRA(0,0,0,0) // last param is alpha, so no interior color, inner routings ONLY draw the arc, no fill
+                     );
+    end;
+end;
+
+procedure TSGCustomSuperGauge.DrawPointer;
+var
+  Origin: TSGOrigin;
+  x, y, x1, y1, extLen: integer;
+  commonSubEx: single;
+  PointerLength: single;
+  startAngle, endAngle: single;
+  bandRadius: single;
+  vecLen: single;
+  A, B, U, V: TPointF;
+begin
+  // Note : Min and max values are the GAUGE Settings, not the Scales,
+  //        the scale display is independant of the value of the gauge to
+  //        allow for multiple pointers if later needed
+
+  if not PointerSettings.Dirty then
+    Exit;
+
+  Origin.CenterPoint.X:= FGaugeBitmap.Width div 2;
+  Origin.CenterPoint.Y:= FGaugeBitmap.Height div 2;
+
+  // radius is smaller of the 2 dimensions
+
+  if Origin.CenterPoint.x < Origin.CenterPoint.y then
+    Origin.Radius := Origin.CenterPoint.x
+  else
+    Origin.Radius := Origin.CenterPoint.Y;
+
+  // Set the pointer length, does not apply to arc
+
+  if FAutoScale then
+    begin
+      PointerLength := Round(Origin.Radius * 0.85);
+    end
+    else
+      begin
+        PointerLength := PointerSettings.Length;
+      end;
+
+  // draw the arc style of pointer
+
+  if (PointerSettings.Style = psLine) or  (PointerSettings.Style = psLineExt) then
+    begin
+      // if we are need to draw the extension behind the cap, we can
+      // recalc the ending point to just do one line draw instead of
+      // 2 discrete lines from the center. That is easier, but slower
+      // If extension len is 0, skip as will show a partial pixel
+
+      FGaugeBitMap.LineCap := pecRound; // caps should be round for line type pointers
+
+      if (PointerSettings.Style = psLineExt) and (PointerSettings.ExtensionLength > 0) then
+        begin
+          // The extension is always pixels visable from the center or edge of the
+          // cap, fix as needed. Makes nice for the user.
+
+          if PointerCapSettings.CapStyle = csNone then
+            extLen := PointerSettings.ExtensionLength
+          else
+            extLen := PointerSettings.ExtensionLength + PointerCapSettings.Radius;
+
+          // compute end point of pointer if an extension
+
+          commonSubEx := (-225 + FValue) * Pi / 180;
+          x1 := Origin.CenterPoint.x - Round(extLen * cos(commonSubEx));
+          y1 := Origin.CenterPoint.y - Round(extLen * sin(commonSubEx));
+
+        end
+          else
+            begin
+              // no extension or extension length is 0, just draw to center
+
+              x1 := Origin.CenterPoint.x;
+              y1 := Origin.CenterPoint.y;
+            end;
+
+      // computer start point of pointer
+
+      commonSubEx := (-45 + FValue) * Pi / 180;
+      x := Origin.CenterPoint.x - Round(PointerLength * cos(commonSubEx));
+      y := Origin.CenterPoint.y - Round(PointerLength * sin(commonSubEx));
+
+      // finally draw it
+
+      FGaugeBitMap.DrawLineAntialias(x, y, x1, y1, PointerSettings.Color, PointerSettings.Thickness)
+    end
+      else
+        if PointerSettings.Style = psTriangle then
+          begin
+              // Draw a Triangle style pointer
+
+              // Draw from center point out
+
+              commonSubEx := (-45 + FValue) * Pi / 180;
+              x := Origin.CenterPoint.x;
+              y := Origin.CenterPoint.y;
+              A := PointF(x, y);
+
+              // Calculate draw to point top
+
+              x1 := Origin.CenterPoint.x - Round(PointerSettings.Length * cos(commonSubEx));
+              y1 := Origin.CenterPoint.y - Round(PointerSettings.Length * sin(commonSubEx));
+              B := PointF(x1, y1);
+
+              // set line cap just in case
+
+              FMarkerBitmap.LineCap := pecRound; // Ensure Round Cap
+
+              // This is the vector that runs from outer to inner
+
+              U := B - A;
+
+              // build the perpendicular vector
+              // (clockwise in screen coordinates while the opposite would be counter clockwise)
+
+              V := PointF(-U.y, U.x);
+
+              // scale it to set the new segment length
+
+              vecLen := VectLen(V);
+
+              // catch odd case of zero len vector, do nothing
+
+              if vecLen = 0.0 then
+                Exit;
+
+              V := V * (PointerSettings.Thickness / vecLen);
+
+              // draw a full triangle pointer
+
+              FGaugeBitMap.FillPolyAntialias([B, A + V, A - V], PointerSettings.Color);
+          end
+            else
+              if PointerSettings.Style = psArc then
+                begin
+                  // drawn arc pointer, ensure not negative or crash, zero no need to draw
+
+                  if FValue <= 0.0 then
+                    Exit;
+
+                   BandRadius := PointerLength - PointerSettings.Thickness div 2;    // adjust for band thickness so end of pointer is top
+
+                   // Start = 225 degree is 0 on gague scale (Not the angle), and -45 degree is 100 on scale
+                   // 270, down (gauge angle 0)180 flat, increase moves towards 0 decrease towards 100
+                   // 0 is flat line, right most end. Increase goes backwards towards 0, -45 is 100 percent on scale
+
+                   startAngle := 225 * PI / 180;  // start at 0 on the gauge
+                   endAngle := startAngle - FValue * PI / 180;
+
+                   FGaugeBitMap.LineCap := pecFlat; // caps should be flat, rounded does not align to scales well
+                   FGaugeBitMap.Arc(
+                                    Origin.CenterPoint.x, Origin.CenterPoint.y,
+                                    BandRadius + 0.5, BandRadius + 0.5, // push down a bit
+                                    startAngle, endAngle,
+                                    PointerSettings.Color,
+                                    PointerSettings.Thickness,
+                                    false,
+                                    BGRA(0,0,0,0) // last param is alpha, so no interior color, inner routings ONLY draw the arc, no fill
+                               );
+                end;
+end;
+
+procedure TSGCustomSuperGauge.DrawPointerCap;
+var
+  Origin: TSGOrigin;
+  sizeWH : integer;
+  pCapEdge : integer;
+  tx, ty: integer;
+  h: single;
+  d2: single;
+  v: TPointF;
+  p: PBGRAPixel;
+  Center: TPointF;
+  yb: integer;
+  xb: integer;
+  mask: TBGRABitmap;
+  Map: TBGRABitmap;
+
+begin
+
+  // skip drawing if nothing changed
+
+  if not PointerCapSettings.Dirty then
+    Exit;
+
+  PointerCapSettings.Dirty := False;
+
+  // drawing is the size of the cap, not of the entire gauge!
+
+  sizeWH := (PointerCapSettings.Radius + PointerCapSettings.EdgeThickness) * 2 + 2;
+  Origin := Initializebitmap(FPointerCapBitmap, SizeWH, SizeWH);
+  pCapEdge := PointerCapSettings.Radius + PointerCapSettings.EdgeThickness div 2;
+
+  if PointerCapSettings.CapStyle = csFlat then
+    begin
+      // Draw the flat cap, but make sure size is similar to the shaded below or will be odd
+
+      FPointerCapBitmap.EllipseAntialias(Origin.CenterPoint.x, Origin.CenterPoint.y,
+        pCapEdge,
+        pCapEdge,
+        PointerCapSettings.EdgeColor,
+        PointerCapSettings.EdgeThickness,
+        PointerCapSettings.FillColor);
+    end
+    else
+      begin
+
+        tx := PointerCapSettings.Radius * 2; // keeps size consistent with flat cap
+        ty := tx;
+
+        if (tx = 0) or (ty = 0) then
+          Exit;
+
+        if PointerCapSettings.CapStyle = csPhong then
+          begin
+            //compute knob height map
+
+            Center := PointF((tx - 1) / 2, (ty - 1) / 2);
+            Map := TBGRABitmap.Create(tx, ty);
+
+            for yb := 0 to ty - 1 do
+            begin
+              p := map.ScanLine[yb];
+              for xb := 0 to tx - 1 do
+              begin
+                //compute vector between center and current pixel
+
+                v := PointF(xb, yb) - Center;
+
+                //scale down to unit circle (with 1 pixel margin for soft border)
+
+                v.x := v.x / (tx / 2 + 1);
+                v.y := v.y / (ty / 2 + 1);
+
+                //compute squared distance with scalar product
+
+                d2 := v {$if FPC_FULLVERSION < 30203}*{$ELSE}**{$ENDIF} v;
+
+                //interpolate as quadratic curve and apply power function
+
+                if d2 > 1 then
+                  h := 0
+                else
+                  h := power(1 - d2, PointerCapSettings.CurveExponent);
+                p^ := MapHeightToBGRA(h, 255);
+                Inc(p);
+              end;
+            end;
+
+            // mask image round with and antialiased border
+
+            mask := TBGRABitmap.Create(tx, ty, BGRABlack);
+            Mask.FillEllipseAntialias(Center.x, Center.y, tx / 2, ty / 2, BGRAWhite);
+            map.ApplyMask(mask);
+            Mask.Free;
+
+            // now draw
+
+            PointerCapSettings.FPhong.Draw(FPointerCapBitmap, Map, 30,
+                    origin.CenterPoint.x - tx div 2, origin.CenterPoint.y - ty div 2,
+                    PointerCapSettings.FillColor);
+            Map.Free;
+
+            // Draw a flat radius around the cap if set, must be alpha 0 or will not
+            // be an outline
+
+            if PointerCapSettings.EdgeThickness > 0 then
+              FPointerCapBitmap.EllipseAntialias(origin.CenterPoint.x, origin.CenterPoint.y,
+                pCapEdge,
+                pCapEdge,
+                PointerCapSettings.EdgeColor,
+                PointerCapSettings.EdgeThickness, BGRA(0,0,0,0));
+          end
+        else
+          begin
+            // Regular shading
+
+            FPointerCapBitmap.FillEllipseLinearColorAntialias(origin.CenterPoint.x, origin.CenterPoint.y,
+              pCapEdge,
+              pCapEdge,
+              PointerCapSettings.FillColor,
+              PointerCapSettings.EdgeColor
+              );
+
+            // draw edge since the shading is backwards ending on fill color not Edge
+
+            FPointerCapBitmap.EllipseAntialias(origin.CenterPoint.x, origin.CenterPoint.y,
+              pCapEdge,
+              pCapEdge,
+              PointerCapSettings.EdgeColor,
+              PointerCapSettings.EdgeThickness, BGRA(0,0,0,0)
+              );
+
+          end;
+      end;
+end;
+
+procedure TSGCustomSuperGauge.DrawLed;
+var
+  Origin: TSGOrigin;
+  sizeWH : integer;
+  mask: TBGRABitmap;
+begin
+
+  // skip drawing if nothing changed or not drawn
+
+  if not FRangeLEDSettings.Dirty then
+    Exit;
+
+  FRangeLEDSettings.Dirty := False;
+
+  // compute the size needed NOT a full gauge bitmap
+
+  sizeWH := FRangeLEDSettings.Size * 2 + 2; // square size at lease LED radius and a bit more
+  Origin := Initializebitmap(FLEDActiveBitmap, sizeWH, sizeWH);
+  Initializebitmap(FLEDInActiveBitmap, sizeWH, sizeWH);
+
+  // offset must be done later in the Paint proc to
+  // keep bitmap small so the center point is the centerpoint of the bitmap
+  // The caller MUST move to the correct offset
+
+  // draw both active and inactive so we never need to do either unless props changed
+  // need to find/get x, y to place the LED
+
+  if RangeLEDSettings.Shape = lshRound then
+    begin
+    if FRangeLEDSettings.Style = lsFlat then
+      begin
+        FLEDActiveBitmap.EllipseAntialias(Origin.CenterPoint.x, Origin.CenterPoint.y,
+          FRangeLEDSettings.Size,
+          FRangeLEDSettings.Size,
+          FRangeLEDSettings.BorderColor,
+          1,
+          FRangeLEDSettings.ActiveColor);
+      end
+    else
+      if FRangeLEDSettings.Style = lsShaded then
+        begin
+          // draw shaded, could do better here but good for starts
+
+          FLEDActiveBitmap.FillEllipseLinearColorAntialias(
+            Origin.CenterPoint.x,
+            Origin.CenterPoint.y,
+            FRangeLEDSettings.Size,
+            FRangeLEDSettings.Size,
+            FRangeLEDSettings.InactiveColor,
+            FRangeLEDSettings.ActiveColor);
+
+          // draw border
+
+          FLEDActiveBitmap.EllipseAntialias(
+            Origin.CenterPoint.x, Origin.CenterPoint.y,
+            FRangeLEDSettings.Size,
+            FRangeLEDSettings.Size,
+            FRangeLEDSettings.BorderColor,
+            1,
+            BGRA(0,0,0,0));  // fill transparent
+        end;
+
+    // Simple flat round for inactive always
+
+    if RangeLedSettings.Style <> lsNone then
+      begin
+        FLEDInactiveBitmap.EllipseAntialias(Origin.CenterPoint.x, Origin.CenterPoint.y,
+          FRangeLEDSettings.Size,
+          FRangeLEDSettings.Size,
+          FRangeLEDSettings.BorderColor,
+          1,
+          FRangeLEDSettings.InActiveColor);
+      end;
+    end // Round
+      else
+        if RangeLEDSettings.Shape = lshSquare then
+          begin
+            // draw a Square LED
+
+            if FRangeLEDSettings.Style = lsFlat then
+              begin
+                // Flat
+
+                FLEDActiveBitmap.FillRoundRectAntialias(
+                    0, 0,
+                    FLEDActiveBitmap.Width,
+                    FLEDActiveBitmap.Height,
+                    Origin.Radius / 2,
+                    Origin.Radius / 2,
+                    FRangeLEDSettings.ActiveColor);
+
+                // draw border for Flat
+
+                FLEDActiveBitmap.RoundRectAntialias(
+                    0,0,
+                    FLEDActiveBitmap.Width - 1,
+                    FLEDActiveBitmap.Height - 1,
+                    Origin.Radius / 2,
+                    Origin.Radius / 2,
+                    FRangeLEDSettings.BorderColor,
+                    1);
+              end
+            else
+              if FRangeLEDSettings.Style = lsShaded then
+                begin
+                  // draw shaded
+
+                  FLEDActiveBitmap.GradientFill(
+                      0, 0,
+                      FLEDActiveBitmap.Width,
+                      FLEDActiveBitmap.Height,
+                      FRangeLEDSettings.ActiveColor,
+                      BGRA(0,0,0),
+                      gtRadial,
+                      PointF(FLEDActiveBitmap.Width / 2, FLEDActiveBitmap.Height / 2),
+                      PointF(FLEDActiveBitmap.Width * 1.5,FLEDActiveBitmap.Height * 1.5),
+                      dmSet);
+
+                  mask := TBGRABitmap.Create(FLEDActiveBitmap.Width, FLEDActiveBitmap.Height, BGRABlack);
+                  mask.FillRoundRectAntialias(
+                      0, 0,
+                      FLEDActiveBitmap.Width,
+                      FLEDActiveBitmap.Height,
+                      Origin.Radius / 2,
+                      Origin.Radius / 2,
+                      BGRAWhite);
+
+                  FLEDActiveBitmap.ApplyMask(mask);
+                  mask.Free;
+
+                  // draw border for shaded
+
+                  FLEDActiveBitmap.RoundRectAntialias(
+                            0, 0,
+                            FLEDActiveBitmap.Width - 1,
+                            FLEDActiveBitmap.Height - 1,
+                            Origin.Radius / 2,
+                            Origin.Radius / 2,
+                            FRangeLEDSettings.BorderColor,
+                            1);
+                end;
+
+            // Simple flat square for inactive always
+
+            if RangeLEDSettings.Style <> lsNone then
+              begin
+                // Need to draw the filled
+                FLEDInactiveBitmap.FillRoundRectAntialias(
+                    0, 0,
+                    FLEDActiveBitmap.Width,
+                    FLEDActiveBitmap.Height,
+                    Origin.Radius / 2,
+                    Origin.Radius / 2,
+                    FRangeLEDSettings.InactiveColor);
+
+                // Now the border
+                FLEDInactiveBitmap.RoundRectAntialias(
+                          0, 0,
+                          FLEDActiveBitmap.Width - 1,
+                          FLEDActiveBitmap.Height - 1,
+                          Origin.Radius / 2,
+                          Origin.Radius / 2,
+                          FRangeLEDSettings.BorderColor,
+                          1);
+              end;
+          end // square
+        else
+          if RangeLEDSettings.Shape = lshTriangle then
+            begin
+              // draw a triangle and border
+
+              if FRangeLEDSettings.Style = lsFlat then  // TODO : add lsShaded
+                begin
+                  FLEDActiveBitmap.DrawPolyLineAntialias(
+                      [ PointF(FLEDActiveBitmap.Width / 2, 1),
+                        PointF(FLEDActiveBitmap.Width - 1, FLEDActiveBitmap.Height - 1),
+                        PointF(1, FLEDActiveBitmap.Height - 1),
+                        PointF(FLEDActiveBitmap.Width / 2, 1) // close it for border
+                      ],
+                      FRangeLEDSettings.BorderColor,
+                      1,
+                      FRangeLEDSettings.ActiveColor);
+
+                end
+              else
+                if FRangeLEDSettings.Style = lsShaded then
+                  begin
+                    // draw shaded
+                     FLEDActiveBitmap.FillPolyLinearColor(
+                          [ PointF(FLEDActiveBitmap.Width / 2, 1),
+                          PointF(FLEDActiveBitmap.Width - 1, FLEDActiveBitmap.Height - 1),
+                          PointF(1, FLEDActiveBitmap.Height - 1)],
+                          [FRangeLEDSettings.InactiveColor,
+                          FRangeLEDSettings.ActiveColor,
+                          FRangeLEDSettings.ActiveColor]);
+                    // draw border
+                     FLEDActiveBitmap.DrawPolyLineAntialias(
+                         [ PointF(FLEDActiveBitmap.Width / 2, 1),
+                           PointF(FLEDActiveBitmap.Width - 1, FLEDActiveBitmap.Height - 1),
+                           PointF(1, FLEDActiveBitmap.Height - 1),
+                           PointF(FLEDActiveBitmap.Width / 2, 1) // close it for border
+                         ],
+                         FRangeLEDSettings.BorderColor,
+                         1,
+                         BGRA(0,0,0,0));
+                  end;
+                if RangeLEDSettings.Style <> lsNone then
+                  begin
+                    FLEDInactiveBitmap.DrawPolyLineAntialias(
+                        [ PointF(FLEDActiveBitmap.Width / 2, 1),
+                          PointF(FLEDActiveBitmap.Width - 1, FLEDActiveBitmap.Height - 1),
+                          PointF(1, FLEDActiveBitmap.Height - 1),
+                          PointF(FLEDActiveBitmap.Width / 2, 1) // close it for border
+                        ],
+                        FRangeLEDSettings.BorderColor,
+                        1,
+                        FRangeLEDSettings.InactiveColor);
+                  end;
+            end // triangle
+          else
+            if RangeLEDSettings.Shape = lshDownTriangle then
+              begin
+                  // draw a downward pointing triangle and border
+                  if FRangeLEDSettings.Style = lsFlat then
+                    begin
+                      FLEDActiveBitmap.DrawPolyLineAntialias(
+                        [ PointF(1,1),
+                          PointF(FLEDActiveBitmap.Width / 2, FLEDActiveBitmap.Height  - 1),
+                          PointF(FLEDActiveBitmap.Width - 1, 1),
+                          PointF(1,1)
+                        ],
+                        FRangeLEDSettings.BorderColor,
+                        1,
+                        FRangeLEDSettings.ActiveColor);
+                      end
+                    else
+                      if FRangeLEDSettings.Style = lsShaded then
+                        begin
+                          // draw shaded
+
+                          FLEDActiveBitmap.FillPolyLinearColor(
+                             [ PointF(1,1),
+                               PointF(FLEDActiveBitmap.Width / 2, FLEDActiveBitmap.Height  - 1),
+                               PointF(FLEDActiveBitmap.Width - 1, 1)
+                             ],
+                             [FRangeLEDSettings.InactiveColor,
+                             FRangeLEDSettings.ActiveColor,
+                             FRangeLEDSettings.ActiveColor]);
+
+                          // draw border
+
+                          FLEDActiveBitmap.DrawPolyLineAntialias(
+                             [ PointF(1,1),
+                               PointF(FLEDActiveBitmap.Width / 2, FLEDActiveBitmap.Height  - 1),
+                               PointF(FLEDActiveBitmap.Width - 1, 1),
+                               PointF(1,1)
+                             ],
+                               FRangeLEDSettings.BorderColor,
+                               1,
+                               BGRA(0,0,0,0));
+                        end;
+                  // Draw Inactive DownTri
+                  if RangeLEDSettings.Style <> lsNone then
+                  begin
+                    FLEDInactiveBitmap.DrawPolyLineAntialias(
+                      [ PointF(1,1),
+                        PointF(FLEDActiveBitmap.Width / 2, FLEDActiveBitmap.Height  - 1),
+                        PointF(FLEDActiveBitmap.Width - 1, 1),
+                        PointF(1,1)
+                      ],
+                      FRangeLEDSettings.BorderColor,
+                      1,
+                      FRangeLEDSettings.InactiveColor);
+                  end;
+
+              end;
+end;
+
+procedure TSGCustomSuperGauge.DrawMarkers;
+var
+  i: integer;
+begin
+  if not IsAnyMarkerDirty then
+    exit;
+
+  Initializebitmap(FMarkerBitmap, Width, Height); // clear it before we draw anything
+
+  // Draws low to high, so if overlapping, last will be visible
+
+  for i := low(FMarkersSettings) to high(FMArkersSettings) do
+  begin
+    FMarkersSettings[i].Dirty := True; // need to dirty them all
+    DrawMarker(FMarkerBitmap, FMarkersSettings[i]);    // will clear any dirty
+  end;
+end;
+
+procedure TSGCustomSuperGauge.DrawMarker(MarkerBitmap: TBGRABitmap; const MarkerSettings: TSGMarkerSettings);
+var
+  x1, y1, x2, y2: integer;
+  cenX, cenY: integer;
+  j, vecLen: single;
+  A, B, U, V: TPointF;
+
+begin
+  // skip drawing if nothing changed or not drawn
+
+  if not MarkerSettings.Dirty then
+    Exit;
+
+  MarkerSettings.Dirty := False;
+
+  if not MarkerSettings.Enabled then
+    Exit;
+
+  // Center of bitmap
+
+  cenX := MarkerBitmap.Width div 2;
+  cenY := MarkerBitmap.Height div 2;
+
+  j := (180 - 270) / 2;
+  x1 := cenX - Round(MarkerSettings.Radius * cos((j + MarkerSettings.Value * 270 / 100) * Pi / 180));
+  y1 := cenY - Round(MarkerSettings.Radius * sin((j + MarkerSettings.Value * 270 / 100) * Pi / 180));
+  A := PointF(x1,y1);
+
+  // Calculate draw to point top
+
+  x2 := cenX - Round((MarkerSettings.Radius - MarkerSettings.Height) * cos((j + MarkerSettings.Value * 270 / 100) * Pi / 180));
+  y2 := cenY - Round((MarkerSettings.Radius - MarkerSettings.Height) * sin((j + MarkerSettings.Value * 270 / 100) * Pi / 180));
+  B := PointF(X2, y2);
+
+  // set line cap just in case
+
+  FMarkerBitmap.LineCap := pecRound; // Ensure Round Cap
+
+  // This is the vector that runs from outer to inner
+
+  U := B - A;
+
+  // build the perpendicular vector
+  // (clockwise in screen coordinates while the opposite would be counter clockwise)
+
+  V := PointF(-U.y, U.x);
+
+  // scale it to set the new segment length
+
+  vecLen := VectLen(V);
+
+  // catch odd case of zero len vector, do nothing
+
+  if vecLen = 0.0 then
+    Exit;
+
+  V := V * (MarkerSettings.Width / vecLen);
+
+  case MarkerSettings.Style of
+    msCenter: // triangle centered on the value
+      begin
+        MarkerBitmap.FillPolyAntialias([B, A + V, A - V], MarkerSettings.Color);
+      end;
+
+    msLeft:   // triangle left side only (if looking at it at half way on the gauge)
+      begin
+        MarkerBitmap.FillPolyAntialias([B, A + V, A], MarkerSettings.Color);
+      end;
+
+    msRight:
+      begin   // triangle right side only
+        MarkerBitmap.FillPolyAntialias([B, A, A - V], MarkerSettings.Color);
+      end;
+  end;
+end;
+
+/////////////////
+
+function TSGCustomSuperGauge.CheckRangeLED(AValue: single): boolean;
+begin
+  // If a single value is used for both StartRangeValue and
+  // EndRangeValue the option for rcBetween makes no sense and is a not valid
+  // and will never trigger. Also Manually setting the .Active prop will ONLY
+  // work if rcNone is set, otherwise the range checks will prevail as the
+  // way the Active state is set and overide the manual setting.
+  //
+  // Current List
+  // TSGRangeCheckType = (rcNone, rcBetween, rcBothInclusive, rcStartInclusive,
+  //                      rcEndInclusive, rcBothBetweenOutside,
+  //                      rcBothInclusiveOutside, rcGreaterStart, RangeEndValue);
+  //
+  // NOTE - rcGreaterStart, RangeEndValue ignore RangeEnd and RangeStart respectivly
+
+  if FRangeLEDSettings.RangeType = rcNone then
+  begin
+    Result := FRangeLEDSettings.Active;   // need to always return the current state here, Will never trigger RangeLED Events
+  end
+  else
+    if FRangeLEDSettings.Rangetype = rcGaugeOutOfRange then     // Special case to ONLY look at the gauge state, ignores the start/end
+      Result := FOutOfRangeState                                // Will NOT trigger any events for RangeLED, this is handled elsewhere
+    else
+      if FRangeLEDSettings.RangeType = rcGreaterStart then
+        Result := (AValue > FRangeLEDSettings.RangeStartValue)  // ignore range end, most common case
+      else
+        if FRangeLEDSettings.RangeType = rcLessEnd then
+          Result := (AValue < FRangeLEDSettings.RangeEndValue)  // ignor range start
+        else
+          if FRangeLEDSettings.RangeType = rcBetween then
+            Result := (AValue > FRangeLEDSettings.RangeStartValue) and (AValue < FRangeLEDSettings.RangeEndValue)
+          else
+            if FRangeLEDSettings.Rangetype = rcBothInclusive then
+              Result := (AValue >= FRangeLEDSettings.RangeStartValue) and (AValue <= FRangeLEDSettings.RangeEndValue)
+            else
+              if FRangeLEDSettings.Rangetype = rcBothBetweenOutside then
+                Result := (AValue < FRangeLEDSettings.RangeStartValue) or (AValue > FRangeLEDSettings.RangeEndValue)
+              else
+                if FRangeLEDSettings.Rangetype = rcStartInclusive then
+                  Result := (AValue >= FRangeLEDSettings.RangeStartValue) and (AValue < FRangeLEDSettings.RangeEndValue)
+                else
+                  if FRangeLEDSettings.Rangetype = rcEndInclusive then
+                    Result := (AValue > FRangeLEDSettings.RangeStartValue) and (AValue <= FRangeLEDSettings.RangeEndValue)
+                  else
+                    if FRangeLEDSettings.Rangetype = rcBothInclusiveOutside then
+                      Result := (AValue <= FRangeLEDSettings.RangeStartValue) or (AValue >= FRangeLEDSettings.RangeEndValue);
+
+  // Now set the flag we have changed so others SetValue() can update as needed
+
+  FRangeLEDStateChanged := FRangeLEDStateChanged or (Result <> FRangeLEDSettings.Active);
+
+  // Try the callbacks now, should hit one or the other depending on Active state
+  // if they are assigned! Rember some will NEVER casuse a call back, rcNone and
+  // rcGaugeOutOfRange
+
+  if FRangeLEDStateChanged and (FRangeLEDSettings.RangeType <> rcNone)
+    and (FRangeLEDSettings.RangeType <> rcGaugeOutOfRange) then
+  begin
+      if Assigned(FRangeLedActive) and Result then
+        FRangeLEDActive(Self, AValue)
+      else
+        if Assigned(FRangeLedActive) and (not Result) then
+          FRangeLEDInactive(Self, AValue);
+
+      FRangeLEDStateChanged := False;   // clear the state
+  end;
+
+  FRangeLEDSettings.ActiveNoDoChange := Result;
+end;
+
+end.

supergaugecommon.pas

@@ -0,0 +1,1688 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+{
+  Part of BGRA Controls. Made by third party.
+  For detailed information see readme.txt
+
+  Site: https://sourceforge.net/p/bgra-controls/
+  Wiki: http://wiki.lazarus.freepascal.org/BGRAControls
+  Forum: http://forum.lazarus.freepascal.org/index.php/board,46.0.html
+
+}
+{******************************* CONTRIBUTOR(S) ******************************
+- Edivando S. Santos Brasil | [email protected]
+  (Compatibility with delphi VCL 11/2018)
+- Sandy Ganz | [email protected]
+  Evolved from DTAnalogCommon, specific for New Gauge Work
+  Massive overhaul, fixes and features, begat Super Gauge
+  Needed to split off as changes broke compatibility badly
+
+***************************** END CONTRIBUTOR(S) *****************************}
+unit supergaugecommon;
+
+{$I bgracontrols.inc}
+
+interface
+
+uses
+  Classes, SysUtils, {$IFDEF FPC}LResources,{$ELSE}Types, {$ENDIF} Forms, Controls, Graphics, Dialogs,
+  BGRABitmap, BGRABitmapTypes, BGRAGradients, BCTypes;
+
+type
+  TSGFillStyle = (fsNone, fsGradient, fsFlat, fsPhong);   // Add more if needed here
+  TSGPointerStyle = (psLine, psLineExt, psArc , psTriangle {, psTriangleLine, psTriangleLineExt}); // Todo : Add others at some point
+  TSGLEDStyle = (lsNone, lsFlat, lsShaded);
+  TSGLEDShape = (lshRound, lshSquare, lshTriangle, lshDownTriangle);
+  TSGPointerCapPosition = (cpUnder, cpOver);
+  TSGCapStyle = (csNone, csFlat, csShaded, csPhong);
+  TSGTickArc = (taNone, taOuter, taInner, taBoth);  // Arc above or below ticks, inner/both is automatic on inner, main if exist, minor othewise
+  TSGRangeCheckType = (rcNone, rcGaugeOutOfRange, rcBetween, rcBothInclusive, rcStartInclusive,
+                      rcEndInclusive, rcBothBetweenOutside, rcBothInclusiveOutside,
+                      rcGreaterStart, rcLessEnd);   // added for range check led, see code for details
+  TSGMarkerStyle = (msCenter, msLeft, msRight);
+
+  { TSGOrigin }
+
+  TSGOrigin = packed record
+    CenterPoint: TPoint;
+    Radius: integer;
+  end;
+
+  { TSGPointerCapSettings }
+
+  TSGPointerCapSettings = class(TPersistent)
+  private
+    FEdgeColor: TColor;
+    FEdgeThickness: integer;
+    FFillColor: TColor;
+    FOnChange: TNotifyEvent;
+    FRadius: integer;
+    FCurveExponent: single;
+    FCapStyle: TSGCapStyle;
+    FCapPosition: TSGPointerCapPosition;
+    FDirty: boolean;
+
+    procedure SetEdgeColor(AValue: TColor);
+    procedure SetEdgeThickness(AValue: integer);
+    procedure SetFillColor(AValue: TColor);
+    procedure SetOnChange(AValue: TNotifyEvent);
+    procedure SetRadius(AValue: integer);
+    procedure SetLightIntensity(const AValue: integer);
+    function GetLightIntensity: integer;
+    procedure SetCurveExponent(const AValue: single);
+    procedure SetCapStyle(const AValue: TSGCapStyle);
+    procedure SetPointerCapPos(const AValue: TSGPointerCapPosition);
+    procedure DirtyOnChange;
+  protected
+  public
+    FPhong: TPhongShading;
+    property Dirty: boolean read FDirty write FDirty;
+    constructor Create;
+    destructor Destroy; override;
+    property OnChange: TNotifyEvent read FOnChange write SetOnChange;
+
+  published
+    property EdgeColor: TColor read FEdgeColor write SetEdgeColor default clGray;
+    property FillColor: TColor read FFillColor write SetFillColor default clBlack;
+    property Radius: integer read FRadius write SetRadius default 30;
+    property EdgeThickness: integer read FEdgeThickness write SetEdgeThickness default 2;
+    property LightIntensity: integer read GetLightIntensity write SetLightIntensity default 300;
+    property CurveExponent: single read FCurveExponent write SetCurveExponent default 0.05;
+    property CapStyle: TSGCapStyle read FCapStyle write SetCapStyle default csPhong;
+    property CapPosition: TSGPointerCapPosition read FCapPosition write SetPointerCapPos default cpUnder;
+  end;
+
+  { TSGPointerSettings }
+
+  TSGPointerSettings = class(TPersistent)
+  private
+    FColor: TColor;
+    FLength: integer;
+    FExtensionLength: integer;
+    FOnChange: TNotifyEvent;
+    FThickness: integer;
+    FStyle: TSGPointerStyle;
+    FDirty: boolean;
+
+    procedure SetColor(AValue: TColor);
+    procedure SetLength(AValue: integer);
+    procedure SetOnChange(AValue: TNotifyEvent);
+    procedure SetThickness(AValue: integer);
+    procedure SetStyle(AValue: TSGPointerStyle);
+    procedure SetExtensionLength(AValue: integer);
+    procedure DirtyOnChange;
+
+  protected
+  public
+    constructor Create;
+    destructor Destroy; override;
+    property OnChange: TNotifyEvent read FOnChange write SetOnChange;
+    property Dirty: boolean read FDirty write FDirty;
+
+  published
+    property Color: TColor read FColor write SetColor;
+    property Length: integer read FLength write SetLength default 160;
+    property ExtensionLength: integer read FExtensionLength write SetExtensionLength default 20;
+    property Thickness: integer read FThickness write SetThickness default 5;
+    property Style: TSGPointerStyle read FStyle write SetStyle default psLineExt;
+  end;
+
+  { TSGScaleSettings }
+
+  TSGScaleSettings = class(TPersistent)
+  private
+    FEnableScaleText: boolean;
+    FStart: integer;
+    FStep: integer;
+    FMaximum: integer;
+    FMinimum: integer;
+    FTextFont: string;
+    FTextRadius: integer;
+    FTextSize: integer;
+    FTextStyle: TFontStyles;
+    FTickColor: TColor;
+    FEnableMainTicks: boolean;
+    FEnableSubTicks: boolean;
+    FReverseScale: boolean;
+    FThicknessMainTick: integer;
+    FThicknessSubTick: integer;
+    FLengthMainTick: integer;
+    FLengthSubTick: integer;
+    FMainTickCount: integer;
+    FOnChange: TNotifyEvent;
+    FSubTickCount: integer;
+    FTextColor: TColor;
+    FScaleRadius: integer;
+    FTickArcStyle: TSGTickArc;
+    FDirty: boolean;
+
+    procedure SetEnableScaleText(AValue: boolean);
+    procedure SetStart(AValue: integer);
+    procedure SetStep(AValue: integer);
+    procedure SetMaximum(AValue: integer);
+    procedure SetMinimum(AValue: integer);
+    procedure SetTextFont(AValue: string);
+    procedure SetTextRadius(AValue: integer);
+    procedure SetTextSize(AValue: integer);
+    procedure SetTextStyle(AValue: TFontStyles);
+    procedure SetTickColor(AValue: TColor);
+    procedure SetEnableMainTicks(AValue: boolean);
+    procedure SetEnableSubTicks(AValue: boolean);
+    procedure SetReverseScale(AValue: boolean);
+    procedure SetLengthMainTick(AValue: integer);
+    procedure SetLengthSubTick(AValue: integer);
+    procedure SetMainTickCount(AValue: integer);
+    procedure SetOnChange(AValue: TNotifyEvent);
+    procedure SetSubTickCount(AValue: integer);
+    procedure SetTextColor(AValue: TColor);
+    procedure SetThicknessMainTick(AValue: integer);
+    procedure SetThicknessSubTick(AValue: integer);
+    procedure SetTickArcStyle(AValue: TSGTickArc);
+    procedure SetScaleRadius(AValue: integer);
+    procedure DirtyOnChange;
+
+  protected
+  public
+    constructor Create;
+    destructor Destroy; override;
+    property OnChange: TNotifyEvent read FOnChange write SetOnChange;
+    property Dirty: boolean read FDirty write FDirty;
+
+  published
+    property TickColor: TColor read FTickColor write SetTickColor;
+    property TextColor: TColor read FTextColor write SetTextColor;
+    property TextSize: integer read FTextSize write SetTextSize default 20;
+    property TextStyle: TFontStyles read FTextStyle write SetTextStyle;
+    property TextFont: string read FTextFont write SetTextFont;
+    property EnableMainTicks: boolean read FEnableMainTicks write SetEnableMainTicks;
+    property EnableSubTicks: boolean read FEnableSubTicks write SetEnableSubTicks;
+    property EnableScaleText: boolean read FEnableScaleText write SetEnableScaleText;
+    property ReverseScale: boolean read FReverseScale write SetReverseScale default False;
+    property Start: integer read FStart write SetStart default 0;
+    property Step: integer read FStep write SetStep default 1;
+    property MainTickCount: integer read FMainTickCount write SetMainTickCount;
+    property SubTickCount: integer read FSubTickCount write SetSubTickCount;
+    property LengthMainTick: integer read FLengthMainTick write SetLengthMainTick;
+    property LengthSubTick: integer read FLengthSubTick write SetLengthSubTick;
+    property ThicknessMainTick: integer read FThicknessMainTick write SetThicknessMainTick;
+    property ThicknessSubTick: integer read FThicknessSubTick write SetThicknessSubTick;
+    property TextRadius: integer read FTextRadius write SetTextRadius default 120;
+    property ScaleRadius: integer read FScaleRadius write SetScaleRadius;
+    property TickArcStyle : TSGTickArc read FTickArcStyle write SetTickArcStyle default taOuter;
+  end;
+
+  { TSGBandSettings }
+
+  TSGBandSettings = class(TPersistent)
+  private
+    FEnabled: boolean;
+    FStartValue: single;
+    FEndValue: single;
+    FEnableText: boolean;
+    FText: TCaption;
+    FTextFont: string;
+    FTextStyle: TFontStyles;
+    FTextRadius: integer;
+    FTextSize: integer;
+    FTextColor: TColor;
+    FOnChange: TNotifyEvent;
+    FBandThickness: integer;
+    FBandRadius: integer;       // defines the outer Radius length in pixels, likely center of width/thickness
+    FBandColor: TColor;
+    FDirty: boolean;
+
+    procedure SetEnabled(AValue: boolean);
+    procedure SetStartValue(AValue: single);
+    procedure SetEndValue(AValue: single);
+    procedure SetEnableText(AValue: boolean);
+    procedure SetText(AValue: TCaption);
+    procedure SetTextSize(AValue: integer);
+    procedure SetTextFont(AValue: string);
+    procedure SetTextStyle(AValue: TFontStyles);
+    procedure SetTextRadius(AValue: integer);
+    procedure SetTextColor(AValue: TColor);
+    procedure SetOnChange(AValue: TNotifyEvent);
+    procedure SetBandThickness(AValue: integer);
+    procedure SetBandRadius(AValue: integer);
+    procedure SetBandColor(AValue: TColor);
+    procedure DirtyOnChange;
+
+  protected
+  public
+    constructor Create;
+    destructor Destroy; override;
+    property OnChange: TNotifyEvent read FOnChange write SetOnChange;
+    property Dirty: boolean read FDirty write FDirty;
+
+  published
+    property Enabled: boolean read FEnabled write SetEnabled default False;
+    property StartValue: single read FStartValue write SetStartValue default 0.0;
+    property EndValue: single read FEndValue write SetEndValue default 100.0;
+    property EnableText: boolean read FEnableText write SetEnableText;
+    property Text: TCaption read FText write SetText;
+    property TextSize: integer read FTextSize write SetTextSize default 20;
+    property TextFont: string read FTextFont write SetTextFont;
+    property TextStyle: TFontStyles read FTextStyle write SetTextStyle;
+    property TextRadius: integer read FTextRadius write SetTextRadius;
+    property TextColor: TColor read FTextColor write SetTextColor;
+    property Thickness: integer read FBandThickness write SetBandThickness;
+    property BandRadius: integer read FBandRadius write SetBandRadius;
+    Property BandColor: TColor read FBandColor write SetBandColor;
+  end;
+
+  { TSGFaceSettings }
+
+  TSGFaceSettings = class(TPersistent)
+  private
+    FInnerColor: TColor;
+    FOuterColor: TColor;
+    FFillStyle: TSGFillStyle;
+    FPicture: TPicture;
+    FPictureEnabled: boolean;
+    FPictureOffsetX, FPictureOffsetY: integer;
+    FCurveExponent: single;
+    FOnChange: TNotifyEvent;
+    FDirty: boolean;
+
+    procedure SetInnerColor(AValue: TColor);
+    procedure SetOuterColor(AValue: TColor);
+    procedure SetFillStyle(AValue: TSGFillStyle);
+    procedure SetPicture(AValue: TPicture);
+    procedure SetPictureEnabled(AValue: boolean);
+    procedure SetPictureOffsetX(AValue: integer);
+    procedure SetPictureOffsetY(AValue: integer);
+    procedure SetLightIntensity(const AValue: integer);
+    function GetLightIntensity: integer;
+    procedure SetCurveExponent(const AValue: single);
+
+    procedure SetOnChange(AValue: TNotifyEvent);
+    procedure DirtyOnChange;
+  protected
+  public
+    FPhong: TPhongShading;
+
+    constructor Create;
+    destructor Destroy; override;
+    property OnChange: TNotifyEvent read FOnChange write SetOnChange;
+    property Dirty: boolean read FDirty write FDirty;
+
+  published
+    property FillStyle: TSGFillStyle read FFillStyle write SetFillStyle;
+    property InnerColor: TColor read FInnerColor write SetInnerColor;
+    property OuterColor: TColor read FOuterColor write SetOuterColor;
+    property Picture: TPicture read FPicture write SetPicture;
+    property PictureEnabled: boolean read FPictureEnabled write SetPictureEnabled;
+    property PictureOffsetX: integer read FPictureOffsetX write SetPictureOffsetX default 0;
+    property PictureOffsetY: integer read FPictureOffsetY write SetPictureOffsetY default 0;
+    property LightIntensity: integer read GetLightIntensity write SetLightIntensity default 300;
+    property CurveExponent: single read FCurveExponent write SetCurveExponent default 0.05;
+  end;
+
+  { TSGFrameSettings }
+
+  TSGFrameSettings = class(TPersistent)
+  private
+    FFrameColor: TColor;
+    FBorderColor: TColor;
+    FBorderRadius: integer;
+    FOnChange: TNotifyEvent;
+    FDirty: boolean;
+
+    procedure SetBorderRadius(AValue: integer);
+    procedure SetFrameColor(AValue: TColor);
+    procedure SetBorderColor(AValue: TColor);
+    procedure SetOnChange(AValue: TNotifyEvent);
+    procedure DirtyOnChange;
+  protected
+  public
+    constructor Create;
+    destructor Destroy; override;
+    property OnChange: TNotifyEvent read FOnChange write SetOnChange;
+    property Dirty: boolean read FDirty write FDirty;
+
+  published
+    property BorderRadius: integer read FBorderRadius write SetBorderRadius;
+    property FrameColor: TColor read FFrameColor write SetFrameColor;
+    property BorderColor: TColor read FBorderColor write SetBorderColor;
+  end;
+
+  { TSGLEDSettings }
+
+  TSGLEDSettings = class(TPersistent)
+  private
+    FActiveColor: TColor;
+    FInactiveColor: TColor;
+    FBorderColor: TColor;
+    FSize: integer;
+    FOffsetX, FOffsetY: integer;
+    FStyle: TSGLEDStyle;
+    FShape: TSGLEDShape;
+    FOnChange: TNotifyEvent;
+    FActive: boolean;
+    FDirty: boolean;
+
+    procedure SetActive(AValue: boolean);
+    procedure SetActiveNoDoChange(AValue: boolean);
+    procedure SetActiveColor(AValue: TColor);
+    procedure SetInactiveColor(AValue: TColor);
+    procedure SetBorderColor(AValue: TColor);
+    procedure SetSize(AValue: integer);
+    procedure SetOffsetX(AValue: integer);
+    procedure SetOffsetY(AValue: integer);
+    procedure SetStyle(AValue: TSGLEDStyle);
+    procedure SetShape(AValue: TSGLEDShape);
+    procedure SetOnChange(AValue: TNotifyEvent);
+    procedure DirtyOnChange;
+
+  protected
+  public
+    constructor Create;
+    destructor Destroy; override;
+    property OnChange: TNotifyEvent read FOnChange write SetOnChange;
+    property Dirty: boolean read FDirty write FDirty;
+
+  published
+    property ActiveColor: TColor read FActiveColor write SetActiveColor;
+    property InactiveColor: TColor read FInactiveColor write SetInactiveColor;
+    property BorderColor: TColor read FBorderColor write SetBorderColor;
+    property Size: integer read FSize write SetSize default 10;
+    property OffsetX: integer read FOffsetX write SetOffsetX default 0;
+    property OffsetY: integer read FOffsetY write SetOffsetY default 50;
+    property Style: TSGLEDStyle read FStyle write SetStyle default lsShaded;
+    property Shape: TSGLEDShape read FShape write SetShape default lshRound;
+    property Active: boolean read FActive write SetActive;
+    property ActiveNoDoChange: boolean read FActive write SetActiveNoDoChange;
+  end;
+
+  { TSGRangeCheckLEDSettings }
+
+  TSGRangeCheckLEDSettings = class(TSGLEDSettings)
+    private
+      FRangeStartValue : single;
+      FRangeEndValue : single;
+      FRangeType: TSGRangeCheckType;
+      procedure SetRangeStartValue(AValue: single);
+      procedure SetRangeEndValue(AValue: single);
+      procedure SetRangeType(AValue: TSGRangeCheckType);
+
+    protected
+    public
+      constructor Create;
+      destructor Destroy; override;
+
+    published
+      property RangeStartValue: single read FRangeStartValue write SetRangeStartValue default 0;
+      property RangeEndValue: single read FRangeEndValue write SetRangeEndValue default 100;
+      property RangeType: TSGRangeCheckType read FRangeType write SetRangeType;
+      property ActiveColor;
+      property InactiveColor;
+      property BorderColor;
+      property Size;
+      property OffsetX;   // origin at center based offset
+      property OffsetY;
+      property Style;
+  end;
+
+{ TSGTextSettings }
+
+TSGTextSettings = class(TPersistent)
+private
+  FEnabled: boolean;
+  FFontEx: TBCFont;
+  FText : TCaption;
+  FOffsetX, FOffsetY: integer;
+  FOnChange: TNotifyEvent;
+  FDirty: boolean;
+
+  procedure SetEnabled(AValue: boolean);
+  procedure SetOffsetX(AValue: integer);
+  procedure SetOffsetY(AValue: integer);
+  procedure SetOnChange(AValue: TNotifyEvent);
+  procedure DirtyOnChange;
+  procedure SetText(AValue: TCaption);
+  procedure SetFontEx(AValue: TBCFont);
+
+protected
+public
+  constructor Create;
+  destructor Destroy; override;
+  property OnChange: TNotifyEvent read FOnChange write SetOnChange;
+  property Dirty: boolean read FDirty write FDirty;
+
+published
+  property Enabled: boolean read FEnabled write SetEnabled default False;
+  property FontEx: TBCFont read FFontEx write SetFontEx;
+  property Text: TCaption read FText write SetText;
+  property OffsetX: integer read FOffsetX write SetOffsetX;
+  property OffsetY: integer read FOffsetY write SetOffsetY;
+end;
+
+{ TSGMarkerSettings }
+
+//  Marker can be left or right or centered. The flat side should
+//  be aligned with the markers value or in the case of centered, will
+//  be the center of the marker. Like -  \| - Left, |/ - Right, \/ - Centered
+
+TSGMarkerSettings = class(TPersistent)
+private
+  FValue: single;     // this is the internal gauge value not user value
+  FEnabled: boolean;
+  FColor: TColor;
+  FHeight: integer;
+  FRadius: integer;
+  FWidth: integer;
+  FStyle: TSGMarkerStyle;
+  FOnChange: TNotifyEvent;
+  FDirty: boolean;
+
+  procedure SetValue(AValue: single);
+  procedure SetEnabled(AValue: boolean);
+  procedure SetColor(AValue: TColor);
+  procedure SetHeight(AValue: integer);
+  procedure SetRadius(AValue: integer);
+  procedure SetWidth(AValue: integer);
+  procedure SetOnChange(AValue: TNotifyEvent);
+  procedure SetStyle(AValue: TSGMarkerStyle);
+  procedure DirtyOnChange;
+
+protected
+public
+  constructor Create;
+  destructor Destroy; override;
+  property OnChange: TNotifyEvent read FOnChange write SetOnChange;
+  property Dirty: boolean read FDirty write FDirty;
+
+published
+  property Value: single read FValue write SetValue default 0.0;
+  property Enabled: boolean read FEnabled write SetEnabled default False;
+  property Color: TColor read FColor write SetColor;
+  property Height: integer read FHeight write SetHeight;
+  property Radius: integer read FRadius write SetRadius;
+  property Width: integer read FWidth write SetWidth;
+  property Style: TSGMarkerStyle read FStyle write SetStyle default msCenter;
+end;
+
+function Initializebitmap(var Bitmap: TBGRABitmap; Width, Height: integer): TSGOrigin;
+
+implementation
+
+function Initializebitmap(var Bitmap: TBGRABitmap; Width, Height: integer): TSGOrigin;
+begin
+  Bitmap.SetSize(Width, Height);
+
+  // Clear bitmap to transparent
+
+  BitMap.Fill(BGRA(0, 0, 0, 0));
+
+  // Get origin information
+
+  Result.CenterPoint.x := Width div 2;
+  Result.CenterPoint.y := Height div 2;
+
+  // Take the smallest so radius will always fit
+
+  if Result.CenterPoint.x < Result.CenterPoint.y then
+    Result.Radius := Result.CenterPoint.x
+  else
+    Result.Radius := Result.CenterPoint.y;
+end;
+
+{ TSGPointerCapSettings }
+
+procedure TSGPointerCapSettings.SetCapStyle(const AValue: TSGCapStyle);
+begin
+  if FCapStyle = AValue then
+    Exit;
+
+  FCapStyle := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGPointerCapSettings.SetPointerCapPos(const AValue: TSGPointerCapPosition);
+begin
+  if FCapPosition = AValue then
+    Exit;
+
+  FCapPosition := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGPointerCapSettings.SetLightIntensity(const AValue: integer);
+begin
+  if AValue = FPhong.LightSourceIntensity then
+    Exit;
+
+  FPhong.LightSourceIntensity := AValue;
+  DirtyOnChange;
+end;
+
+function TSGPointerCapSettings.GetLightIntensity: integer;
+begin
+  Result := round(FPhong.LightSourceIntensity);
+end;
+
+procedure TSGPointerCapSettings.SetCurveExponent(const AValue: single);
+begin
+  if FCurveExponent = AValue then
+    Exit;
+
+  FCurveExponent := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGPointerCapSettings.SetEdgeColor(AValue: TColor);
+begin
+  if FEdgeColor = AValue then
+    Exit;
+
+  FEdgeColor := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGPointerCapSettings.SetEdgeThickness(AValue: integer);
+begin
+  if (FEdgeThickness = AValue) or (AValue < 0) then
+    Exit;
+
+  FEdgeThickness := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGPointerCapSettings.SetFillColor(AValue: TColor);
+begin
+  if FFillColor = AValue then
+    Exit;
+
+  FFillColor := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGPointerCapSettings.SetOnChange(AValue: TNotifyEvent);
+begin
+  FOnChange := AValue;
+
+  // no dirty needed possibly, call directly
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+procedure TSGPointerCapSettings.SetRadius(AValue: integer);
+begin
+  if FRadius = AValue then
+    Exit;
+
+  FRadius := AValue;
+  DirtyOnChange;
+end;
+
+constructor TSGPointerCapSettings.Create;
+begin
+  // create a phong shader, will need to delete on clean up
+
+  FPhong := TPhongShading.Create;
+  FPhong.LightPositionZ := 100;
+  FPhong.LightSourceIntensity := 300;
+  FPhong.NegativeDiffusionFactor := 0.8;
+  FPhong.AmbientFactor := 0.5;
+  FPhong.DiffusionFactor := 0.6;
+
+  FCurveExponent := 0.05;
+  FCapStyle := csPhong;
+  FCapPosition := cpUnder;
+  FEdgeColor := clGray;
+  FFillColor := clBlack;
+  FRadius := 20;
+  FEdgeThickness := 2;
+  FDirty := True;
+end;
+
+destructor TSGPointerCapSettings.Destroy;
+begin
+  FPhong.Free;
+  inherited Destroy;
+end;
+
+procedure TSGPointerCapSettings.DirtyOnChange;
+begin
+  FDirty := True;   // if we get here some props must have changed, mark dirty
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+{ TSGPointerSettings }
+
+procedure TSGPointerSettings.SetColor(AValue: TColor);
+begin
+  if FColor = AValue then
+    Exit;
+
+  FColor := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGPointerSettings.SetLength(AValue: integer);
+begin
+  if FLength = AValue then
+    Exit;
+
+  FLength := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGPointerSettings.SetOnChange(AValue: TNotifyEvent);
+begin
+  FOnChange := AValue;
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+procedure TSGPointerSettings.SetThickness(AValue: integer);
+begin
+  if FThickness = AValue then
+    Exit;
+
+  FThickness := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGPointerSettings.SetStyle(AValue: TSGPointerStyle);
+begin
+  if FStyle = AValue then
+    Exit;
+
+  FStyle := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGPointerSettings.SetExtensionLength(AValue: integer);
+begin
+  if FExtensionLength = AValue then
+    Exit;
+
+  FExtensionLength := AValue;
+  DirtyOnChange;
+end;
+
+constructor TSGPointerSettings.Create;
+begin
+  FColor := BGRA(255, 127, 63); // Orange pointer
+  FLength := 160;
+  FThickness := 5;
+  FExtensionLength := 20;
+  FStyle := psLineExt;
+  FDirty := True;
+end;
+
+procedure TSGPointerSettings.DirtyOnChange;
+begin
+  FDirty := True;   // if we get here a prop must have changed, mark dirty
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+destructor TSGPointerSettings.Destroy;
+begin
+  inherited Destroy;
+end;
+
+{ TSGScaleSettings }
+
+constructor TSGScaleSettings.Create;
+begin
+  FTickColor := BGRA(223, 196, 125);  // Tan
+  FTextColor := BGRA(140, 208, 211);  // Light Blue
+  FTextFont := 'Calibri';
+  FTextSize := 20;
+  FTextRadius := 120;
+  FEnableMainTicks := True;
+  FEnableSubTicks := True;
+  FEnableScaleText := True;
+  FReverseScale := False;
+  FMainTickCount := 10;
+  FSubTickCount := 5;
+  FStart := 0;
+  FStep := 1;
+  FLengthMainTick := 15;
+  FLengthSubTick := 8;
+  FThicknessMainTick := 3;
+  FThicknessSubTick := 1;
+  FTickArcStyle := taOuter;
+  FScaleRadius := 155;
+  FDirty := True;
+end;
+
+destructor TSGScaleSettings.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TSGScaleSettings.SetTextFont(AValue: string);
+begin
+  if FTextFont = AValue then
+    Exit;
+  FTextFont := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetEnableScaleText(AValue: boolean);
+begin
+  if FEnableScaleText = AValue then
+    Exit;
+  FEnableScaleText := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetReverseScale(AValue: boolean);
+begin
+  if FReverseScale = AValue then
+    Exit;
+  FReverseScale := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetScaleRadius(AValue: integer);
+begin
+  if (FScaleRadius = AValue) or (AValue < 1) then
+    Exit;
+
+  FScaleRadius := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetMaximum(AValue: integer);
+begin
+  if (FMaximum = AValue) or (AValue <= FMinimum) then
+    Exit;
+
+  FMaximum := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetStart(AValue: integer);
+begin
+  if (FStart = AValue)then
+    Exit;
+
+  FStart := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetStep(AValue: integer);
+begin
+  if (FStep = AValue)then
+    Exit;
+
+  FStep := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetMinimum(AValue: integer);
+begin
+  if (FMinimum = AValue) then
+    Exit;
+
+  FMinimum := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetTextRadius(AValue: integer);
+begin
+  if (FTextRadius = AValue) or (AValue < 1) then
+    Exit;
+
+  FTextRadius := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetTextSize(AValue: integer);
+begin
+  if (FTextSize = AValue) or (AValue < 1) then
+    Exit;
+
+  FTextSize := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetTickColor(AValue: TColor);
+begin
+  if FTickColor = AValue then
+    Exit;
+
+  FTickColor := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetTickArcStyle(AValue: TSGTickArc);
+begin
+  if FTickArcStyle = AValue then
+     exit;
+
+  FTickArcStyle := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetEnableMainTicks(AValue: boolean);
+begin
+  if FEnableMainTicks = AValue then
+    Exit;
+
+  FEnableMainTicks := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetEnableSubTicks(AValue: boolean);
+begin
+  if FEnableSubTicks = AValue then
+    Exit;
+
+  FEnableSubTicks := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetLengthMainTick(AValue: integer);
+begin
+  if (FLengthMainTick = AValue) or (AValue < 1) then
+    Exit;
+
+  FLengthMainTick := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetLengthSubTick(AValue: integer);
+begin
+  if (FLengthSubTick = AValue) or (AValue < 1) then
+    Exit;
+
+  FLengthSubTick := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetMainTickCount(AValue: integer);
+begin
+  if (FMainTickCount = AValue) or (AValue < 1) then
+    Exit;
+
+  FMainTickCount := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetOnChange(AValue: TNotifyEvent);
+begin
+  FOnChange := AValue;
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+procedure TSGScaleSettings.SetSubTickCount(AValue: integer);
+begin
+  if (FSubTickCount = AValue) or (AValue < 1) then
+    Exit;
+
+  FSubTickCount := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetTextColor(AValue: TColor);
+begin
+  if FTextColor = AValue then
+    Exit;
+
+  FTextColor := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetTextStyle(AValue: TFontStyles);
+begin
+  if FTextStyle = AValue then
+    Exit;
+
+  FTextStyle := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetThicknessMainTick(AValue: integer);
+begin
+  if (FThicknessMainTick = AValue) or (AValue < 1) then
+    Exit;
+
+  FThicknessMainTick := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.SetThicknessSubTick(AValue: integer);
+begin
+  if (FThicknessSubTick = AValue) or (AValue < 1)  then
+    Exit;
+
+  FThicknessSubTick := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGScaleSettings.DirtyOnChange;
+begin
+  FDirty := True;   // if we get here a prop must have changed, mark dirty
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+{ TSGBandSettings}
+
+constructor TSGBandSettings.Create;
+begin
+  FEnabled := False;
+  FEnableText := False;
+  FText := '';
+  FTextColor := clBlack;
+  FTextFont := 'default';
+  FTextStyle := [];
+  FTextSize := 20;
+  FTextRadius := 100;
+  FStartValue := 0;
+  FEndValue := 20;
+  FBandRadius := 100;
+  FBandColor := clGreen;
+  FBandThickness := 40;
+  FStartValue := 0;
+  FEndValue := 100;
+
+  FDirty := True;
+end;
+
+destructor TSGBandSettings.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TSGBandSettings.SetEnabled(AValue: boolean);
+begin
+  if FEnabled = AValue then
+    Exit;
+
+  FEnabled := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGBandSettings.SetTextFont(AValue: string);
+begin
+  if FTextFont = AValue then
+    Exit;
+
+  FTextFont := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGBandSettings.SetTextStyle(AValue: TFontStyles);
+begin
+  if FTextStyle = AValue then
+    Exit;
+
+  FTextStyle := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGBandSettings.SetEnableText(AValue: boolean);
+begin
+  if FEnableText = AValue then
+    Exit;
+
+  FEnableText := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGBandSettings.SetText(AValue: TCaption);
+begin
+  if FText = AValue then
+    Exit;
+
+  FText := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGBandSettings.SetTextRadius(AValue: integer);
+begin
+  if (FTextRadius = AValue) or (AValue < 1) then
+    Exit;
+
+  FTextRadius := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGBandSettings.SetBandRadius(AValue: integer);
+begin
+  if (FBandRadius = AValue) or (AValue < 1) then
+    Exit;
+
+  FBandRadius := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGBandSettings.SetStartValue(AValue: single);
+begin
+  if (FStartValue = AValue) or (AValue >= FEndValue) then
+    Exit;
+
+  FStartValue := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGBandSettings.SetEndValue(AValue: single);
+begin
+  if (FEndValue = AValue) or (AValue <= FStartValue) then
+    Exit;
+
+  FEndValue := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGBandSettings.SetTextSize(AValue: integer);
+begin
+  if (FTextSize = AValue) or (AValue < 1) then
+    Exit;
+
+  FTextSize := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGBandSettings.SetOnChange(AValue: TNotifyEvent);
+begin
+  FOnChange := AValue;
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+procedure TSGBandSettings.SetTextColor(AValue: TColor);
+begin
+  if FTextColor = AValue then
+    Exit;
+
+  FTextColor := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGBandSettings.SetBandColor(AValue: TColor);
+begin
+  if FBandColor = AValue then
+    Exit;
+
+  FBandColor := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGBandSettings.SetBandThickness(AValue: integer);
+begin
+  if (FBandThickness = AValue) or (AValue < 1) then
+    Exit;
+
+  FBandThickness := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGBandSettings.DirtyOnChange;
+begin
+  FDirty := True;
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+{ TSGFaceSettings }
+
+constructor TSGFaceSettings.Create;
+begin
+  // create a Phong shader, will need to delete on clean up
+
+  FPhong := TPhongShading.Create;
+
+  FPhong.LightPositionZ := 100;
+  FPhong.LightSourceIntensity := 300;
+  FPhong.NegativeDiffusionFactor := 0.8;
+  FPhong.AmbientFactor := 0.5;
+  FPhong.DiffusionFactor := 0.6;
+
+  FCurveExponent := 0.05;
+  FOuterColor := clBlack;
+  FInnerColor := clGray;
+  FFillStyle := fsGradient;
+  FPicture := TPicture.Create;
+  FPictureEnabled := FALSE;
+  FPictureOffsetX := 0;
+  FPictureOffsetY := 0;
+
+  FDirty := True;
+end;
+
+destructor TSGFaceSettings.Destroy;
+begin
+  FPhong.Free;
+  FPicture.Free;
+
+  inherited Destroy;
+end;
+
+procedure TSGFaceSettings.SetInnerColor(AValue: TColor);
+begin
+  if FInnerColor = AValue then
+    Exit;
+
+  FInnerColor := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGFaceSettings.SetOuterColor(AValue: TColor);
+begin
+  if FOuterColor = AValue then
+    Exit;
+
+  FOuterColor := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGFaceSettings.SetFillStyle(AValue: TSGFillStyle);
+begin
+  if FFillStyle = AValue then
+    Exit;
+
+  FFillStyle := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGFaceSettings.SetPicture(AValue: TPicture);
+begin
+  if FPicture = AValue then
+    Exit;
+
+  FPicture := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGFaceSettings.SetPictureEnabled(AValue: boolean);
+begin
+
+  if FPictureEnabled = AValue then
+    Exit;
+
+  FPictureEnabled := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGFaceSettings.SetPictureOffsetX(AValue: integer);
+begin
+  if FPictureOffsetX = AValue then
+    Exit;
+
+  FPictureOffsetX := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGFaceSettings.SetPictureOffsetY(AValue: integer);
+begin
+  if FPictureOffsetY = AValue then
+    Exit;
+
+  FPictureOffsetY := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGFaceSettings.SetLightIntensity(const AValue: integer);
+begin
+  if AValue = FPhong.LightSourceIntensity then
+    Exit;
+
+  FPhong.LightSourceIntensity := AValue;
+  DirtyOnChange;
+end;
+
+function TSGFaceSettings.GetLightIntensity: integer;
+begin
+  Result := round(FPhong.LightSourceIntensity);
+end;
+
+procedure TSGFaceSettings.SetCurveExponent(const AValue: single);
+begin
+  if FCurveExponent = AValue then
+    Exit;
+
+  FCurveExponent := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGFaceSettings.SetOnChange(AValue: TNotifyEvent);
+begin
+  FOnChange := AValue;
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+procedure TSGFaceSettings.DirtyOnChange;
+begin
+  FDirty := True;   // if we get here a prop must have changed, mark dirty
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+{ TSGFrameSettings }
+
+constructor TSGFrameSettings.Create;
+begin
+  FFrameColor := clBlack;
+  FBorderColor := clGray;
+  FBorderRadius := 2;
+  FDirty := True;
+end;
+
+destructor TSGFrameSettings.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TSGFrameSettings.SetBorderRadius(AValue: integer);
+begin
+  if (FBorderRadius = AValue) or (AValue < 0) then
+    Exit;
+
+  FBorderRadius := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGFrameSettings.SetFrameColor(AValue: TColor);
+begin
+  if FFrameColor = AValue then
+    Exit;
+
+  FFrameColor := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGFrameSettings.SetBorderColor(AValue: TColor);
+begin
+  if FBorderColor = AValue then
+    Exit;
+
+  FBorderColor := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGFrameSettings.SetOnChange(AValue: TNotifyEvent);
+begin
+  FOnChange := AValue;
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+procedure TSGFrameSettings.DirtyOnChange;
+begin
+  FDirty := True;   // if we get here a prop must have changed, mark dirty
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+{ TSGLEDSettings }
+
+constructor TSGLEDSettings.Create;
+begin
+  FActiveColor := clRed;
+  FInActiveColor := clBlack;
+  FBorderColor := clGray;
+  FSize := 10;
+  FOffsetX := 0;
+  FOffsetY := 50;
+  FStyle := lsShaded;
+
+  FDirty := True;
+end;
+
+destructor TSGLEDSettings.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TSGLEDSettings.SetActive(AValue: boolean);
+begin
+  if FActive = AValue then
+    Exit;
+
+  FActive := AValue;
+  DirtyOnChange;
+end;
+
+// HACK, need to have a way to NOT dirty on change
+
+procedure TSGLEDSettings.SetActiveNoDoChange(AValue: boolean);
+begin
+  if FActive = AValue then
+    Exit;
+
+  FActive := AValue;
+end;
+
+procedure TSGLEDSettings.SetActiveColor(AValue: TColor);
+begin
+  if FActiveColor = AValue then
+    Exit;
+
+  FActiveColor := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGLEDSettings.SetInactiveColor(AValue: TColor);
+begin
+  if FInactiveColor = AValue then
+    Exit;
+
+  FInActiveColor := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGLEDSettings.SetBorderColor(AValue: TColor);
+begin
+  if FBorderColor = AValue then
+    Exit;
+
+  FBorderColor := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGLEDSettings.SetSize(AValue: integer);
+begin
+  if FSize = AValue then
+    Exit;
+
+  FSize := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGLEDSettings.SetOffsetX(AValue: integer);
+begin
+  if FOffsetX = AValue then
+    Exit;
+
+  FOffsetX := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGLEDSettings.SetOffsetY(AValue: integer);
+begin
+  if FOffsetY = AValue then
+    Exit;
+
+  FOffsetY := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGLEDSettings.SetStyle(AValue: TSGLEDStyle);
+begin
+  if FStyle = AValue then
+    Exit;
+
+  FStyle := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGLEDSettings.SetShape(AValue: TSGLEDShape);
+begin
+  if FShape = AValue then
+    Exit;
+
+  FShape := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGLEDSettings.SetOnChange(AValue: TNotifyEvent);
+begin
+  FOnChange := AValue;
+
+  // this will not dirty it, may need to not sure
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+procedure TSGLEDSettings.DirtyOnChange;
+begin
+  FDirty := True;   // if we get here a prop must have changed, mark dirty
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+{ TSGRangeCheckLEDSettings }
+
+constructor TSGRangeCheckLEDSettings.Create;
+begin
+  inherited Create;
+
+  FRangeStartValue := 0;
+  FRangeEndValue := 100;
+  FRangeType := rcNone;
+  FOffsetX := 90;
+  FOffsetY := 120;
+end;
+
+destructor TSGRangeCheckLEDSettings.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TSGRangeCheckLEDSettings.SetRangeStartValue(AValue: single);
+begin
+  if (FRangeStartValue = AValue) or (AValue > FRangeEndValue) then
+    Exit;
+
+  FRangeStartValue := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGRangeCheckLEDSettings.SetRangeEndValue(AValue: single);
+begin
+  if (FRangeEndValue = AValue) or (AValue < FRangeStartValue) then
+    Exit;
+
+  FRangeEndValue := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGRangeCheckLEDSettings.SetRangeType(AValue: TSGRangeCheckType);
+begin
+  if FRangeType = AValue then
+    Exit;
+
+  FRangeType := AValue;
+  DirtyOnChange;
+end;
+
+{ TSGTextSettings }
+
+constructor TSGTextSettings.Create;
+begin
+  FText := 'Gauge';
+  OffsetX := 0;
+  OffsetY := 50; // default should be clear of default cap radius when it's drawn
+  FDirty := True;
+
+  // create font, must free in dtor
+
+  FFontEx := TBCFont.Create(nil);
+  FFontEx.Color := clWhite;
+  FFontEx.Style := [fsBold];
+  FFontEx.Height := 24;
+end;
+
+destructor TSGTextSettings.Destroy;
+begin
+  FFontEx.Free;
+
+  inherited Destroy;
+end;
+
+procedure TSGTextSettings.SetEnabled(AValue: boolean);
+begin
+  if FEnabled = AValue then
+    Exit;
+
+  FEnabled := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGTextSettings.SetText(AValue: TCaption);
+begin
+  if FText = AValue then
+    Exit;
+
+  FText := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGTextSettings.SetOffsetX(AValue: integer);
+begin
+  if FOffsetX = AValue then
+    Exit;
+
+  FOffsetX := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGTextSettings.SetOffsetY(AValue: integer);
+begin
+  if FOffsetY = AValue then
+    Exit;
+
+  FOffsetY := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGTextSettings.SetOnChange(AValue: TNotifyEvent);
+begin
+  FOnChange := AValue;
+
+  // this will not dirty it, may need to not sure
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+procedure TSGTextSettings.DirtyOnChange;
+begin
+  FDirty := True;
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+procedure TSGTextSettings.SetFontEx(AValue: TBCFont);
+begin
+  FFontEx.Assign(AValue);
+  FDirty := True;
+  DirtyOnChange;
+end;
+
+{TSGMarkerSettings}
+
+constructor TSGMarkerSettings.Create;
+begin
+  FEnabled := False;
+  FColor := clLime;
+  FHeight := 20;
+  FWidth := 10;
+  FRadius := 165;
+  FStyle := msCenter;
+  FDirty := True;
+  FValue := 0.0;
+end;
+
+destructor TSGMarkerSettings.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TSGMarkerSettings.SetValue(AValue: single);
+begin
+  if FValue = AValue then
+    Exit;
+
+  FValue := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGMarkerSettings.SetEnabled(AValue: boolean);
+begin
+  if FEnabled = AValue then
+    Exit;
+
+  FEnabled := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGMarkerSettings.SetColor(AValue: TColor);
+begin
+  if FColor = AValue then
+    Exit;
+
+  FColor := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGMarkerSettings.SetHeight(AValue: integer);
+begin
+  if FHeight = AValue then
+    Exit;
+
+  FHeight := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGMarkerSettings.SetRadius(AValue: integer);
+begin
+  if FRadius = AValue then
+    Exit;
+
+  FRadius := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGMarkerSettings.SetWidth(AValue: integer);
+begin
+  if FWidth = AValue then
+    Exit;
+
+  FWidth := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGMarkerSettings.SetOnChange(AValue: TNotifyEvent);
+begin
+  FOnChange := AValue;
+
+  // no dirty needed possibly, call directly
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+procedure TSGMarkerSettings.SetStyle(AValue: TSGMarkerStyle);
+begin
+  if FStyle = AValue then
+    Exit;
+
+  FStyle := AValue;
+  DirtyOnChange;
+end;
+
+procedure TSGMarkerSettings.DirtyOnChange;
+begin
+  FDirty := True;   // if we get here some props must have changed, mark dirty
+
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+end.

test/test_bcroundedimage_pictdialogs/test_bcroundedimage_pictdialogs.lpi

@@ -0,0 +1,88 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="test_bcroundedimage_pictdialogs"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+      <Icon Value="0"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <RequiredPackages>
+      <Item>
+        <PackageName Value="bgracontrols"/>
+      </Item>
+      <Item>
+        <PackageName Value="LCL"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="test_bcroundedimage_pictdialogs.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="test_bcroundedimage_pictdialogs_main.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="bin\$(TargetCPU)-$(TargetOS)\test_bcroundedimage"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Optimizations>
+        <OptimizationLevel Value="0"/>
+      </Optimizations>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

test/test_bcroundedimage_pictdialogs/test_bcroundedimage_pictdialogs.lpr

@@ -0,0 +1,28 @@
+program test_bcroundedimage_pictdialogs;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  {$IFDEF HASAMIGA}
+  athreads,
+  {$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, test_bcroundedimage_pictdialogs_main
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  {$PUSH}{$WARN 5044 OFF}
+  Application.MainFormOnTaskbar:=True;
+  {$POP}
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

test/test_bcroundedimage_pictdialogs/test_bcroundedimage_pictdialogs_main.lfm

@@ -0,0 +1,212 @@
+object Form1: TForm1
+  Left = 334
+  Height = 328
+  Top = 229
+  Width = 510
+  Caption = 'Form1'
+  ClientHeight = 328
+  ClientWidth = 510
+  LCLVersion = '4.99.0.0'
+  object rgStyle: TRadioGroup
+    Left = 320
+    Height = 80
+    Top = 136
+    Width = 168
+    AutoFill = True
+    Caption = 'Style'
+    ChildSizing.LeftRightSpacing = 6
+    ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+    ChildSizing.EnlargeVertical = crsHomogenousChildResize
+    ChildSizing.ShrinkHorizontal = crsScaleChilds
+    ChildSizing.ShrinkVertical = crsScaleChilds
+    ChildSizing.Layout = cclLeftToRightThenTopToBottom
+    ChildSizing.ControlsPerLine = 1
+    ClientHeight = 60
+    ClientWidth = 164
+    ItemIndex = 2
+    Items.Strings = (
+      'Circle'
+      'Rounded Rectangle'
+      'Square'
+    )
+    ParentBackground = False
+    TabOrder = 0
+    OnClick = rgStyleClick
+  end
+  object Label1: TLabel
+    Left = 320
+    Height = 15
+    Top = 219
+    Width = 55
+    Caption = 'Rounding:'
+  end
+  object edRounding: TFloatSpinEdit
+    Left = 384
+    Height = 23
+    Top = 216
+    Width = 56
+    MaxValue = 100
+    TabOrder = 1
+    Value = 10
+    OnChange = edRoundingChange
+  end
+  object btLoad: TButton
+    Left = 320
+    Height = 25
+    Top = 248
+    Width = 80
+    Caption = 'Load (BGRA)'
+    TabOrder = 2
+    OnClick = btLoadClick
+  end
+  object cbProportional: TCheckBox
+    Left = 320
+    Height = 19
+    Top = 32
+    Width = 84
+    Caption = 'Proportional'
+    TabOrder = 3
+    OnChange = cbProportionalChange
+  end
+  object Panel1: TPanel
+    Left = 8
+    Height = 302
+    Top = 8
+    Width = 302
+    ClientHeight = 302
+    ClientWidth = 302
+    TabOrder = 4
+    object BCRoundedImage1: TBCRoundedImage
+      Left = 0
+      Height = 300
+      Top = 0
+      Width = 300
+      Style = isSquare
+      BorderStyle = []
+      Rounding = 10
+      Quality = rfLinear
+      Proportional = False
+      OnPaintEvent = BCRoundedImage1PaintEvent
+    end
+  end
+  object rgAlign: TRadioGroup
+    Left = 320
+    Height = 80
+    Top = 56
+    Width = 79
+    AutoFill = True
+    Caption = 'Align'
+    ChildSizing.LeftRightSpacing = 6
+    ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+    ChildSizing.EnlargeVertical = crsHomogenousChildResize
+    ChildSizing.ShrinkHorizontal = crsScaleChilds
+    ChildSizing.ShrinkVertical = crsScaleChilds
+    ChildSizing.Layout = cclLeftToRightThenTopToBottom
+    ChildSizing.ControlsPerLine = 1
+    ClientHeight = 60
+    ClientWidth = 75
+    ItemIndex = 2
+    Items.Strings = (
+      'Left'
+      'Right'
+      'Center'
+    )
+    TabOrder = 5
+    OnClick = rgAlignClick
+  end
+  object rgAlignV: TRadioGroup
+    Left = 400
+    Height = 81
+    Top = 56
+    Width = 79
+    AutoFill = True
+    Caption = 'Align Vert'
+    ChildSizing.LeftRightSpacing = 6
+    ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+    ChildSizing.EnlargeVertical = crsHomogenousChildResize
+    ChildSizing.ShrinkHorizontal = crsScaleChilds
+    ChildSizing.ShrinkVertical = crsScaleChilds
+    ChildSizing.Layout = cclLeftToRightThenTopToBottom
+    ChildSizing.ControlsPerLine = 1
+    ClientHeight = 61
+    ClientWidth = 75
+    ItemIndex = 1
+    Items.Strings = (
+      'Top'
+      'Center'
+      'Bottom'
+    )
+    TabOrder = 6
+    OnClick = rgAlignVClick
+  end
+  object cbStretch: TCheckBox
+    Left = 320
+    Height = 19
+    Top = 8
+    Width = 55
+    Caption = 'Stretch'
+    Checked = True
+    State = cbChecked
+    TabOrder = 7
+    OnChange = cbStretchChange
+  end
+  object btLoadT: TButton
+    Left = 408
+    Height = 25
+    Top = 248
+    Width = 96
+    Caption = 'Load (TPicture)'
+    TabOrder = 8
+    OnClick = btLoadTClick
+  end
+  object btSavePictBGRA: TButton
+    Left = 320
+    Height = 25
+    Top = 277
+    Width = 80
+    Caption = 'Save (BGRA)'
+    TabOrder = 9
+    OnClick = btSavePictBGRAClick
+  end
+  object btSavePict: TButton
+    Left = 408
+    Height = 25
+    Top = 277
+    Width = 96
+    Caption = 'Save (TPicture)'
+    TabOrder = 10
+    OnClick = btSavePictClick
+  end
+  object lbDetails: TLabel
+    Left = 320
+    Height = 15
+    Top = 304
+    Width = 36
+    Caption = 'image:'
+  end
+  object Button1: TButton
+    Left = 448
+    Height = 25
+    Top = 216
+    Width = 40
+    Caption = 'test'
+    TabOrder = 11
+    OnClick = Button1Click
+  end
+  object openPict: TOpenPictureDialog
+    Left = 72
+    Top = 136
+  end
+  object savePict: TSavePictureDialog
+    Left = 192
+    Top = 136
+  end
+  object openPictBGRA: TBGRAOpenPictureDialog
+    Left = 72
+    Top = 56
+  end
+  object savePictBGRA: TBGRASavePictureDialog
+    Left = 192
+    Top = 56
+  end
+end

test/test_bcroundedimage_pictdialogs/test_bcroundedimage_pictdialogs_main.pas

@@ -0,0 +1,146 @@
+unit test_bcroundedimage_pictdialogs_main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin, StdCtrls, ExtDlgs,
+  BCRoundedImage, BGRABitmap, BGRADialogs, BGRABitmapTypes;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    BCRoundedImage1: TBCRoundedImage;
+    openPictBGRA: TBGRAOpenPictureDialog;
+    savePictBGRA: TBGRASavePictureDialog;
+    btLoad: TButton;
+    btLoadT: TButton;
+    btSavePictBGRA: TButton;
+    btSavePict: TButton;
+    Button1: TButton;
+    cbProportional: TCheckBox;
+    cbStretch: TCheckBox;
+    edRounding: TFloatSpinEdit;
+    Label1: TLabel;
+    lbDetails: TLabel;
+    openPict: TOpenPictureDialog;
+    Panel1: TPanel;
+    rgAlign: TRadioGroup;
+    rgAlignV: TRadioGroup;
+    rgStyle: TRadioGroup;
+    savePict: TSavePictureDialog;
+    procedure BCRoundedImage1PaintEvent(const Sender: TBCRoundedImage; const Bitmap: TBGRABitmap);
+    procedure btSavePictBGRAClick(Sender: TObject);
+    procedure btSavePictClick(Sender: TObject);
+    procedure btLoadClick(Sender: TObject);
+    procedure btLoadTClick(Sender: TObject);
+    procedure Button1Click(Sender: TObject);
+    procedure cbProportionalChange(Sender: TObject);
+    procedure cbStretchChange(Sender: TObject);
+    procedure edRoundingChange(Sender: TObject);
+    procedure rgAlignClick(Sender: TObject);
+    procedure rgAlignVClick(Sender: TObject);
+    procedure rgStyleClick(Sender: TObject);
+  private
+
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.BCRoundedImage1PaintEvent(const Sender: TBCRoundedImage; const Bitmap: TBGRABitmap);
+begin
+  //
+end;
+
+procedure TForm1.btSavePictBGRAClick(Sender: TObject);
+begin
+  if savePictBGRA.Execute then
+  begin
+  end;
+end;
+
+procedure TForm1.btSavePictClick(Sender: TObject);
+begin
+  if savePict.Execute then
+  begin
+  end;
+end;
+
+procedure TForm1.btLoadClick(Sender: TObject);
+begin
+  try
+     if openPictBGRA.Execute then
+     begin
+       BCRoundedImage1.Picture:= nil;
+       BCRoundedImage1.Bitmap.LoadFromFile(openPictBGRA.FileName); //'c:\tmp\Acquisitions Book 1.03.01, Byzantine.jpg'
+       BCRoundedImage1.Invalidate;
+       lbDetails.Caption:= 'image: BGRA '+IntToStr(BCRoundedImage1.Bitmap.Width)+' x '+IntToStr(BCRoundedImage1.Bitmap.Height);
+     end;
+
+  finally
+  end;
+end;
+
+procedure TForm1.btLoadTClick(Sender: TObject);
+begin
+  if openPict.Execute then
+  begin
+    BCRoundedImage1.Bitmap:= nil;
+    BCRoundedImage1.Picture.LoadFromFile(openPict.FileName); //'c:\tmp\Acquisitions Book 1.03.01, Byzantine.jpg'
+    BCRoundedImage1.Invalidate;
+    lbDetails.Caption:= 'image: PICT '+IntToStr(BCRoundedImage1.Picture.Width)+' x '+IntToStr(BCRoundedImage1.Picture.Height);
+  end;
+end;
+
+procedure TForm1.Button1Click(Sender: TObject);
+var
+   t, t2: String;
+
+begin
+  BuildBGRAFilterStrings(True, t, t2);
+end;
+
+procedure TForm1.cbProportionalChange(Sender: TObject);
+begin
+  BCRoundedImage1.Proportional:= cbProportional.Checked;
+end;
+
+procedure TForm1.cbStretchChange(Sender: TObject);
+begin
+  BCRoundedImage1.Stretch:= cbStretch.Checked;
+end;
+
+procedure TForm1.edRoundingChange(Sender: TObject);
+begin
+  BCRoundedImage1.Rounding:= edRounding.Value;
+end;
+
+procedure TForm1.rgAlignClick(Sender: TObject);
+begin
+  BCRoundedImage1.Alignment:= TAlignment(rgAlign.ItemIndex);
+end;
+
+procedure TForm1.rgAlignVClick(Sender: TObject);
+begin
+  BCRoundedImage1.VerticalAlignment:= TTextLayout(rgAlignV.ItemIndex);
+end;
+
+procedure TForm1.rgStyleClick(Sender: TObject);
+begin
+  BCRoundedImage1.Style:= TBCRoundedImageStyle(rgStyle.ItemIndex);
+end;
+
+end.
+

test/test_bgraimagelist/test_BGRAImgList.lpi

@@ -0,0 +1,134 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="test_BGRAImgList"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+      <Icon Value="0"/>
+    </General>
+    <BuildModes>
+      <Item Name="Debug" Default="True"/>
+      <Item Name="Release">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="test_BGRAImgList"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+              <RunWithoutDebug Value="True"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+        </CompilerOptions>
+      </Item>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <RequiredPackages>
+      <Item>
+        <PackageName Value="BGRABitmapPack"/>
+      </Item>
+      <Item>
+        <PackageName Value="bgracontrols"/>
+      </Item>
+      <Item>
+        <PackageName Value="LCL"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="test_BGRAImgList.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="test_BGRAImgList_m.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="test_BGRAImgList"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <IncludeAssertionCode Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <Checks>
+        <IOChecks Value="True"/>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+        <StackChecks Value="True"/>
+      </Checks>
+      <VerifyObjMethodCallValidity Value="True"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+        <UseHeaptrc Value="True"/>
+        <TrashVariables Value="True"/>
+        <UseExternalDbgSyms Value="True"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

test/test_bgraimagelist/test_BGRAImgList.lpr

@@ -0,0 +1,26 @@
+program test_BGRAImgList;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  {$IFDEF HASAMIGA}
+  athreads,
+  {$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, test_BGRAImgList_m
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  Application.{%H-}MainFormOnTaskbar:=True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

test/test_bgraimagelist/test_BGRAImgList_m.lfm

@@ -0,0 +1,419 @@
+object Form1: TForm1
+  Left = 336
+  Height = 528
+  Top = 157
+  Width = 790
+  Caption = 'Form1'
+  ClientHeight = 528
+  ClientWidth = 790
+  DesignTimePPI = 120
+  Menu = MainMenu1
+  OnCreate = FormCreate
+  object PageControl1: TPageControl
+    Left = 0
+    Height = 560
+    Top = 0
+    Width = 890
+    ActivePage = tabReadWrite
+    TabIndex = 0
+    TabOrder = 0
+    object tabReadWrite: TTabSheet
+      Caption = 'Read/Write Tests'
+      ClientHeight = 527
+      ClientWidth = 882
+      object lvCaptured: TListView
+        Left = 0
+        Height = 240
+        Top = 256
+        Width = 784
+        AutoSort = False
+        Columns = <>
+        ColumnClick = False
+        IconOptions.Arrangement = iaLeft
+        LargeImages = imgListThumbs
+        ParentShowHint = False
+        ReadOnly = True
+        ScrollBars = ssAutoHorizontal
+        ShowColumnHeaders = False
+        ShowHint = True
+        TabOrder = 0
+        ViewStyle = vsIcon
+      end
+      object btAddThumb: TButton
+        Left = 18
+        Height = 32
+        Top = 153
+        Width = 140
+        Caption = 'Add Thumb File'
+        TabOrder = 1
+        OnClick = btAddThumbClick
+      end
+      object rgHorizontal: TRadioGroup
+        Left = 18
+        Height = 60
+        Top = 11
+        Width = 221
+        AutoFill = True
+        Caption = 'Horizontal Align'
+        ChildSizing.LeftRightSpacing = 6
+        ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+        ChildSizing.EnlargeVertical = crsHomogenousChildResize
+        ChildSizing.ShrinkHorizontal = crsScaleChilds
+        ChildSizing.ShrinkVertical = crsScaleChilds
+        ChildSizing.Layout = cclLeftToRightThenTopToBottom
+        ChildSizing.ControlsPerLine = 3
+        ClientHeight = 35
+        ClientWidth = 217
+        Columns = 3
+        ItemIndex = 2
+        Items.Strings = (
+          'left'
+          'right'
+          'center'
+        )
+        TabOrder = 2
+      end
+      object rgVertical: TRadioGroup
+        Left = 18
+        Height = 60
+        Top = 72
+        Width = 221
+        AutoFill = True
+        Caption = 'Vertical Align'
+        ChildSizing.LeftRightSpacing = 6
+        ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+        ChildSizing.EnlargeVertical = crsHomogenousChildResize
+        ChildSizing.ShrinkHorizontal = crsScaleChilds
+        ChildSizing.ShrinkVertical = crsScaleChilds
+        ChildSizing.Layout = cclLeftToRightThenTopToBottom
+        ChildSizing.ControlsPerLine = 3
+        ClientHeight = 35
+        ClientWidth = 217
+        Columns = 3
+        ItemIndex = 1
+        Items.Strings = (
+          'top'
+          'center'
+          'bottom'
+        )
+        TabOrder = 3
+      end
+      object btAddThumbCol: TButton
+        Left = 168
+        Height = 32
+        Top = 153
+        Width = 176
+        Caption = 'Add Thumb File Color'
+        TabOrder = 4
+        OnClick = btAddThumbClick
+      end
+      object ColorBox1: TColorBox
+        Left = 168
+        Height = 26
+        Top = 224
+        Width = 176
+        Selected = clFuchsia
+        ItemHeight = 20
+        TabOrder = 5
+      end
+      object Button1: TButton
+        Left = 734
+        Height = 32
+        Top = 11
+        Width = 50
+        Caption = 'Tests'
+        TabOrder = 6
+        OnClick = Button1Click
+      end
+      object btReadData: TButton
+        Left = 640
+        Height = 32
+        Top = 152
+        Width = 72
+        Caption = 'Read All'
+        TabOrder = 7
+        OnClick = btReadDataClick
+      end
+      object btWriteData: TButton
+        Left = 712
+        Height = 32
+        Top = 152
+        Width = 72
+        Caption = 'Write All'
+        TabOrder = 8
+        OnClick = btWriteDataClick
+      end
+      object btReadSel: TButton
+        Left = 640
+        Height = 32
+        Top = 190
+        Width = 72
+        Caption = 'Read Sel.'
+        TabOrder = 9
+        OnClick = btReadSelClick
+      end
+      object btWriteSel: TButton
+        Left = 712
+        Height = 32
+        Top = 190
+        Width = 72
+        Caption = 'Write Sel.'
+        TabOrder = 10
+        OnClick = btWriteSelClick
+      end
+      object btChangeThumb: TButton
+        Left = 18
+        Height = 32
+        Top = 190
+        Width = 140
+        Caption = 'Change Thumb File'
+        TabOrder = 11
+        OnClick = btChangeThumbClick
+      end
+      object btChangeThumbCol: TButton
+        Left = 168
+        Height = 32
+        Top = 190
+        Width = 176
+        Caption = 'Change Thumb File Color'
+        TabOrder = 12
+        OnClick = btChangeThumbClick
+      end
+      object Image1: TImage
+        Left = 376
+        Height = 240
+        Top = 0
+        Width = 240
+        AutoSize = True
+        Proportional = True
+        Transparent = True
+      end
+    end
+    object tabDraw: TTabSheet
+      Caption = 'Draw Tests'
+      ClientHeight = 527
+      ClientWidth = 882
+      object btStretchDraw: TButton
+        Left = 8
+        Height = 31
+        Top = 224
+        Width = 94
+        Caption = 'Stretch Draw'
+        TabOrder = 0
+        OnClick = btStretchDrawClick
+      end
+      object DrawGrid1: TDrawGrid
+        Left = 10
+        Height = 150
+        Top = 60
+        Width = 350
+        ColCount = 4
+        Columns = <        
+          item
+            Title.ImageIndex = 0
+            Title.Caption = 'Title'
+          end        
+          item
+            Title.ImageIndex = 1
+            Title.Caption = 'Title'
+          end        
+          item
+            Title.ImageIndex = 2
+            Title.Caption = 'Title'
+          end>
+        ExtendedSelect = False
+        TabOrder = 1
+        TitleImageList = ImageList1
+      end
+      object cbIndexDraw: TCheckBox
+        Left = 130
+        Height = 24
+        Top = 0
+        Width = 89
+        Caption = 'Add Index'
+        TabOrder = 2
+        OnChange = cbIndexDrawChange
+      end
+      object Panel1: TPanel
+        Left = 120
+        Height = 200
+        Top = 224
+        Width = 200
+        BevelOuter = bvNone
+        Caption = 'Panel1'
+        TabOrder = 3
+      end
+      object cbOverlay: TCheckBox
+        Left = 10
+        Height = 24
+        Top = 0
+        Width = 103
+        Caption = 'Add Overlay'
+        TabOrder = 4
+        OnChange = cbIndexDrawChange
+      end
+      object cbBGRADraw: TCheckBox
+        Left = 10
+        Height = 24
+        Top = 30
+        Width = 98
+        Caption = 'BGRA Draw'
+        Checked = True
+        State = cbChecked
+        TabOrder = 5
+        OnChange = cbBGRADrawChange
+      end
+    end
+  end
+  object ImageList1: TBGRAImageList
+    UseBGRADraw = True
+    OnBeforeDraw = ImageList1BeforeDraw
+    OnAfterDraw = ImageList1AfterDraw
+    Left = 176
+    Top = 360
+    Bitmap = {
+      4C7A070000001000000010000000070C00000000000078DAED970754546716C7
+      EF7B0F468A0541372A8A48119881418A4A51A94315446063B06C846862140C12
+      8D11D6165B8C15156C091656298A8A800144CAA860A408A8941935AE6E8C2022
+      6528C2C0DDEF2113C78DACE8E69CDDB3C777CEFF307CF3FDBE7BEFF7BEFFDCF7
+      00608C9696963391A01F7206321F1141263737379FA6C646ECAFD8F9F2BCA3A3
+      A3CF5DB118FB2B76BE3CEFE9E1F167B14884AC84797998101FDFA3F8B8B8D7CA
+      C2DC7C035B8BA6A6A613A9657848707020F65EF9F9F9FDAEE3597D7D27E14DE5
+      F92B972FF7BB0E5155D5EF78A15088B25ADEA4EACA4A29E127C8F3050505D8DF
+      ABBBBB1BFF27F89090F9FF4D9E3DCF6666661E449E010101BBDF96973F8BF2B9
+      F49337FD2379B95A7AEAF9773236367663CF3FD108228B77540F2B696EC67791
+      6C9DFBF7EEE1BB48C697DDB881EF22198FEF78FDBFF0C2DC5C7C17BDDFBF3F84
+      FF4FFDF7475C6A44366F293539DEED1D6A7793E7D9DFB327B5355857F704EBEB
+      9FE2B367F5D8D0D0808D6CBF6D6AC2E66656CD3DEA8B7FFAB48EB02CF7AC8763
+      1989A4195B5A24442DD8DACAAAB54F5E16938DF7827B31BFADAD0DDBDBDB7FD3
+      EB7876ACB151C64A5EE19E3F7F8E1D1D1DBFA92F5E9E95E73A3B3B5F515F3C9B
+      B38C95C562E74BA5D257D417CFD6CBE62C1FF7EA550906063EC0ACAC66ECEAEA
+      EAE93B7979ADE8EC5C5E4FD35553E57936B63CCBC69A33A71A53527EC665CBAA
+      C81A0D989BDB888B16DDC663C7AAD0C6A6F4BE3CCFC69667D97805058D38776E
+      116EDA5486FEFE85E8E3731D23228AD1D333BF89A22EDBCAF3B2BAE57936DFFD
+      FB2FA193531ECE9A5540D6C8474BCB2CC2A6DAFE6BFDF2B9CB58F6EFBE7D9938
+      7C781A8E1A9585EAEA9948D3E75A008E38F6C5CBC7CEC97980AAAAE7C97E6713
+      9D6A266A04C8219F93C91A918E6FF28FBE7E2299FB13D169C26E9A06B0D58AAC
+      D100709D8CC5C8F66F58EFFD7C8D04B301A2AA0122A6BC4C37C2AA776CB2AAAA
+      2A2829290DF2F6F62E30E773B5C0281882A67C40E30980A60080F3D3014EB8F4
+      FDC3316DDA34707575A5C78D1BF7BDB2B2B29A92B23219E5C04FDF7952B91193
+      98DCD5D6CCE5F5F6CCD52DEE74E19E00BAE4E0023A63A92E1D3D9E54AF09F07D
+      FA4DA868459A6B685061AF0D891153C12DD219349256017C3B0B803DA83B8CFA
+      8E9F74A3096ED574337C639EC8451770A52DE0117FA5FA1F3F1B212471A22FAD
+      3009CB099F1890F3571BF76B3B7C1D4A0E04F966046BBBC64C04CE213ED9C992
+      46B8558B8C098FFB829F424963E7A863569821E6AD998205DBBCB1F8401056C6
+      876365E21A2C8A9E9F99F6E908F3DAC283F073C636385326818A3AC21BFFC677
+      FF6DAE06667D69D4255C6F2F2D8A9CD551FAFD679D79BBE649B257DB855EE203
+      A721793F53FAF544EAE6EAA97038FB3E08AB9E323C230359FE9DB10143A4D961
+      FA5D79AB27E3A5754EF8E3467F14467D81E2F8358FAA634212AE47D8B8677802
+      7D7408C0FAD82B7022B38419AFAF2BE3BB7F98C9C1D38123F0D46213CC58ED5E
+      5BBA6F41FAFD98CF436FEDF4E3C6F0815E4EF62DEBE30F40F8B93E2CDC180B5B
+      8F5F6474C68D150B74A0E6EB29706CA313BD74ADDB08FF0B6176E66DFB3D0677
+      A4EC82CA03CBA1EA6C243C4C8F82926F9CA9CC990017FD009C5D5C61FA8C991C
+      AD31638A070FA074951429505552A0862953803BED01F7B84345C651EADEF130
+      E6E60E3FEA62801A6410EEDA7213280AB7046B6B6BB0B3B3E38C1C39F23A4551
+      A30118583C8956D8EA3D924E5B3685BEB3C1168E927CD389CA660014FB0F7CE5
+      FEF34D4DC1C2D292336CD8B0429AF0640D601886621414E023E337373E3D3D3D
+      303030E0A8A9A915927F7B789AA6A9FE364EF21E09E47D92437CF413CBB36364
+      0D8AACD12F9E9D47C49AA6844D07D80D00502552E915FB9D12D10022C5DEEFD9
+      C5E573643785BDAD938958B798129910718988D3605C6F6E7FEAEDDBAABD6B51
+      F2FEE74F9EA06509DAC0FBCC925E8155609D3E1BF8492E6072CAA9DFFE575652
+      EE49CE2A670E659D338F99766D11E35CBE9C7117AFA767FCB283F679BC9BF6F9
+      B547C02A39220EEACEDDA78D8CB9157A8B262458A6B8BAEA1DB2541F11C705C3
+      44F213FD2180FE61B33EE3976EBD028FF2EE3326A62622ED1063348EB743FE69
+      41BD459A8FD02A7B6EF4B48245614E65CB03DCAAD6B87B3FDCE640E2FB92B8AE
+      441C367EE5B622682C20FEE3F344A3438CD0F4ACABD42275064EBEF811DA5E0E
+      42FBC21014DC5A89D31F6E419F9A48F4791C9949D6302702F2192AB6144053C1
+      13C21B8BB4BF34C789E97EDD569766B36C97DDF5255241C5D71DD31F7CDBE95A
+      BA5622280B0FB52A98C5F1BAB39D99F1EB0E8AAC0739A1A7417CB69C31323612
+      E9855BA38DF0E3CEA9F90BA58EA5A15DAED511E8521A8E562767A3C10E1BB44C
+      F37B24B8F555C28C5F76BAFBD4EEA5E7E15938E6F31D64ED3EC7E81BEA8B0CD6
+      39A27D5170B763F132B41306E3C4C48F90BFDFA9967BD826DD3CD32BD4AE7031
+      D7E3F6267A7E5306B855AD05C1ADAF618DD94238B2603B334E5F47CCDBE4FED8
+      A57AD551EB739F2CD55D69E53F669DBEB97E96D9E0D12B15416BF93070CC0906
+      978A7020FB48F93F3B04AC04F64EE0E5E2C919A3A55534505B4387A3A602CA1A
+      83A8813A1A60D4E00D06356E60B4D59C324BF1606CAF0451EED5EBC0E71FBBC1
+      B96C0538947CF11AFF9397EA485F05830DF6B4EE36339A9766077A8F67813146
+      00F7A607185D7BB519F1F97CB0B4B0E8F13FC5D02FFD4F3310F0F4C07BFFBF85
+      FF793C33ADC0403271F46CFA45E72D27B5FC40F2DBD37FFF2B2B91FD27B6FD30
+      8B72744C660482F38CA7671AE3EF9F417FF2490E1D1272999E302191ACBF96D0
+      ABA0A4E43820DEA50D0CB8158A8A36892A2A4BDD060C58AFA1A57502860D63E7
+      E4117DD567FCBABA54E8E8A862783CBE88C3B14365E5C5E4596D57BDBE7E9C70
+      C28484686BEB33610E0EC9010241B2FB9C39171D962C11FA9A9824B892A70B0E
+      C04678F224053A3BAB182ED7A48757555D22D5D2DA479E1193D0D5350503022E
+      2261F09B6F8A71F3E6125CBC5898696070D23C2E4E0C5151B7A0BE3E0DBABA44
+      F27CB7B676144E9A94D4E5E9992A0D0CCCED080BCBEF5CB8F082C4C1E15428C0
+      971C2EF7203370600CA5A6760444A2E3505393CF181A727B781595C59DA347EF
+      955A589CE9120852D1CBEB1CFAF9C561505012C923F711C927415B3BD69D747E
+      9AFD71CCCEFE160A0B13185DDDF1B2FABB353476A08ECE61E4F1A2C933764CED
+      F4E9E7D27D7DB343A74E3D4FCEC3A784230F01F42E50578F8698982570E1C24E
+      66EC581D318733B5464525F898AAEA8AA583062DF2D7D4DC6EAEA99933D8D9F9
+      2CD8DA1E8655AB3261F3E662E0F1E2C9D9DB44767F0BB9F7029839D38B3386F4
+      7F9A1EA44BD34AA0A8A84A1CA006DADA85C0E516C39E3DF9D4BC79398CADED59
+      C26D25DC66183A3406468E8C7DADFF55543E56183A348C1E3B76373D6A541219
+      F1603B0AD1CE5EBDBC4C4D89FF2D7BFD4FBDF4BF8202030306F8BCF7FF5BF89F
+      6B31492B980C7EB0641D0DEC2B22AB42A2ACC6B7E8FF03C8D33F8067552735A9
+      B495B12E6B65ECCB5B19F7DB6D7440553BBD40DC4EEB16B5D0709EBCC29C7906
+      37A33603965CA20D78C615E0363B11BE3BED06B1251A905E0CB037F1450EF135
+      7DC66F3A1109DD372E333C535311CC0842D874129592C5F5230ADB84BA859268
+      9392D6B089A5AD01D63724EE332BDA1C8244EDBEDA852DAEF0632307521BA031
+      763720E1B9267C11780721B5F9A4543DED2E1A96B4E194B256F4AE6843C260F8
+      0329AE79D08181A2F6CC51D75BCC8FD54A61D72F1D2039B107B0EC2AC3E5BF88
+      4FF86E0DC21B95B476D995B54867893A3A3EBFD7D939B7E8B164D2B5BA504843
+      8E76560D03575B28C897C0FDBDEBE0E9A56486D42FCBBF7348EA5DE9F8D28E2E
+      EB9BCFD1B1E8297A648B718E508C41959247DE95ED09EA0512774869A4E1E013
+      B8B2EA5328391AC5E81A18CAF86EC5B3D5383CEB118E4DAD42D3CC3BB58E45F5
+      E92E7730D4ACBC830B87EED3B08C1CD5CC67A09CD30CB17FF1828B1B56306375
+      F5C4E035BF06B6C41F833D179632EB8FFA0F395D6E3EE8090E36B887A0274408
+      2E6F87B57F7F0E63AE93DCD3C899B8D008AECE4E3073BA07DBFF8B29350D5D4A
+      591514060EA660B826A8917BA749B4BDFC21E5279632A6A56D145CA80748AD03
+      C52BCD30E85ACBEFFCCF1E6EEAABBD0A9CED49B4C6D9DBF4A00A72FF7FB84B5E
+      007ACF6201BEEA7FF9FE4FCBF99F6D420B56BFF7FF1BFCFF4F24216E05
+    }
+  end
+  object MainMenu1: TMainMenu
+    Images = ImageList1
+    Left = 40
+    Top = 288
+    object MenuItem1: TMenuItem
+      Caption = 'MenuItem1'
+      ImageIndex = 0
+      object MenuItem2: TMenuItem
+        Caption = 'MenuItem2'
+        ImageIndex = 1
+      end
+      object MenuItem3: TMenuItem
+        Caption = 'MenuItem3'
+        ImageIndex = 2
+      end
+    end
+  end
+  object imgListThumbs: TBGRAImageList
+    DrawingStyle = dsTransparent
+    Height = 132
+    Width = 132
+    UseBGRADraw = False
+    Left = 176
+    Top = 440
+  end
+  object OpenPictDialog: TOpenPictureDialog
+    Left = 448
+    Top = 360
+  end
+  object ImageList2: TImageList
+    Height = 132
+    Width = 132
+    Left = 176
+    Top = 288
+  end
+  object OpenDialog1: TOpenDialog
+    Filter = 'All Files (*.*)|*.*|Img File (*.img)|*.img'
+    Left = 264
+    Top = 360
+  end
+  object SaveDialog1: TSaveDialog
+    Filter = 'All Files (*.*)|*.*|Img File (*.img)|*.img'
+    Left = 352
+    Top = 360
+  end
+end

test/test_bgraimagelist/test_BGRAImgList_m.pas

@@ -0,0 +1,334 @@
+unit test_BGRAImgList_m;
+
+{$ifdef FPC}
+  {$mode objfpc}
+{$endif}
+
+{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus, ComCtrls, StdCtrls, Grids, ColorBox,
+  ExtCtrls, GraphType, ImgList, ExtDlgs, BGRAImageList
+  {$ifdef FPC}, LCLVersion{$endif};
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    btAddThumb: TButton;
+    btAddThumbCol: TButton;
+    btChangeThumb: TButton;
+    btChangeThumbCol: TButton;
+    btReadData: TButton;
+    btReadSel: TButton;
+    btStretchDraw: TButton;
+    btWriteData: TButton;
+    btWriteSel: TButton;
+    Button1: TButton;
+    cbBGRADraw: TCheckBox;
+    cbIndexDraw: TCheckBox;
+    cbOverlay: TCheckBox;
+    ColorBox1: TColorBox;
+    DrawGrid1: TDrawGrid;
+    Image1: TImage;
+    ImageList1: TBGRAImageList;
+    ImageList2: TImageList;
+    imgListThumbs: TBGRAImageList;
+    lvCaptured: TListView;
+    MainMenu1: TMainMenu;
+    MenuItem1: TMenuItem;
+    MenuItem2: TMenuItem;
+    MenuItem3: TMenuItem;
+    OpenDialog1: TOpenDialog;
+    OpenPictDialog: TOpenPictureDialog;
+    PageControl1: TPageControl;
+    Panel1: TPanel;
+    rgHorizontal: TRadioGroup;
+    rgVertical: TRadioGroup;
+    SaveDialog1: TSaveDialog;
+    tabDraw: TTabSheet;
+    tabReadWrite: TTabSheet;
+    procedure btAddThumbClick(Sender: TObject);
+    procedure btChangeThumbClick(Sender: TObject);
+    procedure btReadDataClick(Sender: TObject);
+    procedure btReadSelClick(Sender: TObject);
+    procedure btStretchDrawClick(Sender: TObject);
+    procedure btWriteDataClick(Sender: TObject);
+    procedure btWriteSelClick(Sender: TObject);
+    procedure Button1Click(Sender: TObject);
+    procedure cbBGRADrawChange(Sender: TObject);
+    procedure cbIndexDrawChange(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure ImageList1AfterDraw(Sender: TBGRAImageList; ACanvas: TCanvas; ARect: TRect; AIndex: Integer;
+      ADrawingStyle: TDrawingStyle; AImageType: TImageType; ADrawOverlay: Boolean; AOverlay: TOverlay;
+      ADrawEffect: TGraphicsDrawEffect);
+    function ImageList1BeforeDraw(Sender: TBGRAImageList; ACanvas: TCanvas; var ARect: TRect; var AIndex: Integer;
+      var ADrawingStyle: TDrawingStyle; var AImageType: TImageType; var ADrawOverlay: Boolean; var AOverlay: TOverlay;
+      var ADrawEffect: TGraphicsDrawEffect): Boolean;
+  private
+     procedure LoadImgList(AFileName: String);
+
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.btStretchDrawClick(Sender: TObject);
+begin
+  ImageList1.StretchDrawOverlay(Panel1.Canvas, 0, Rect(16, 16, 128, 128), 0, True) //AOverlay is changed in Event
+end;
+
+procedure TForm1.Button1Click(Sender: TObject);
+var
+   newItem: TListItem;
+   newImgI: Integer;
+   pict: TPicture;
+   AResult,
+   AResult2: TBitmap;
+   c:Boolean;
+
+begin
+  if OpenPictDialog.Execute then
+  try
+    pict:= TPicture.Create;
+    pict.LoadFromFile(OpenPictDialog.FileName);
+
+    AResult:=TBitmap.Create;
+    AResult.Assign(pict.Bitmap);
+    AResult.TransparentColor := ColorBox1.Selected;
+    AResult.TransparentMode := tmFixed;
+    AResult.Transparent := True;
+    AResult.Masked:= True;
+    //AResult.Mask(ColorBox1.Selected);
+
+    AResult2:= imgListThumbs.CreateProportionalImage(AResult, taCenter, tlCenter);
+    c:= AResult2.Masked;
+    c:= AResult2.Transparent;
+    AResult2.TransparentColor:=AResult.TransparentColor;
+
+    Image1.Picture.Assign(AResult2);
+
+    newImgI:= imgListThumbs.AddMasked(AResult2, ColorBox1.Selected);
+    newItem:= lvCaptured.Items.Add;
+    newItem.Caption:= ExtractFileName(OpenPictDialog.FileName);
+    newItem.ImageIndex:= newImgI;
+
+  finally
+    AResult2.Free;
+    AResult.Free;
+    pict.Free;
+  end;
+end;
+
+procedure TForm1.btAddThumbClick(Sender: TObject);
+var
+   newItem: TListItem;
+   newImgI: Integer;
+   newBmp: TBitmap;
+
+begin
+  if OpenPictDialog.Execute then
+  try
+    if (Sender=btAddThumbCol)
+    then newImgI:= imgListThumbs.AddMaskedProportionally(OpenPictDialog.FileName, ColorBox1.Selected,
+                                              TAlignment(rgHorizontal.ItemIndex),
+                                              TTextLayout(rgVertical.ItemIndex))
+    else newImgI:= imgListThumbs.AddProportionally(OpenPictDialog.FileName, '',
+                                              TAlignment(rgHorizontal.ItemIndex),
+                                              TTextLayout(rgVertical.ItemIndex));
+    newItem:= lvCaptured.Items.Add;
+    newItem.Caption:= ExtractFileName(OpenPictDialog.FileName);
+    newItem.ImageIndex:= newImgI;
+
+    newBmp:= TBitmap.Create;
+    imgListThumbs.GetBitmap(newImgI, newBmp);
+    Image1.Picture.Assign(newBmp);
+
+  finally
+    newBmp.Free;
+  end;
+end;
+
+procedure TForm1.btChangeThumbClick(Sender: TObject);
+var
+   newItem: TListItem;
+   oID: Integer;
+   newBmp: TBitmap;
+
+begin
+  if (lvCaptured.Selected<>nil) and OpenPictDialog.Execute then
+  try
+    oID:= lvCaptured.Selected.ImageIndex;
+
+    if (Sender=btChangeThumbCol)
+    then imgListThumbs.ReplaceMaskedProportionally(oID, OpenPictDialog.FileName, ColorBox1.Selected, True,
+                                              TAlignment(rgHorizontal.ItemIndex),
+                                              TTextLayout(rgVertical.ItemIndex))
+    else imgListThumbs.ReplaceProportionally(oID, OpenPictDialog.FileName, '', True,
+                                              TAlignment(rgHorizontal.ItemIndex),
+                                              TTextLayout(rgVertical.ItemIndex));
+
+    //lvCaptured.Selected.Caption:= ExtractFileName(OpenPictDialog.FileName);
+    lvCaptured.Selected.ImageIndex:=-1;
+    lvCaptured.Selected.ImageIndex:=oID;
+
+    newBmp:= TBitmap.Create;
+    imgListThumbs.GetBitmap(oID, newBmp);
+    Image1.Picture.Assign(newBmp);
+
+  finally
+    newBmp.Free;
+  end;
+end;
+
+procedure TForm1.btReadDataClick(Sender: TObject);
+var
+   i:Integer;
+   oCap: String;
+   oId: Integer;
+
+begin
+  if OpenDialog1.Execute then
+  begin
+    lvCaptured.Clear;
+    LoadImgList(OpenDialog1.FileName);
+(*    for i:=0 to lvCaptured.Items.Count-1 do
+    begin
+      oID:= lvCaptured.Items[i].ImageIndex;
+      lvCaptured.Items[i].ImageIndex:= -1;
+      lvCaptured.Items[i].ImageIndex:= oID;
+    end; *)
+  end;
+end;
+
+procedure TForm1.btReadSelClick(Sender: TObject);
+var
+   oCap: String;
+   oID: Integer;
+
+begin
+  {$if lcl_fullversion>=4990000}
+  if (lvCaptured.Selected<>nil) and OpenDialog1.Execute then
+  begin
+    oID:=lvCaptured.Selected.ImageIndex;
+    imgListThumbs.LoadFromFile(OpenDialog1.FileName, oID);
+
+    //Is the only way to Update the Image?
+    //oCap:=lvCaptured.Selected.Caption;
+    //lvCaptured.Selected.Caption:='';
+    //lvCaptured.Selected.Caption:=oCap;
+    lvCaptured.Selected.ImageIndex:=-1;
+    lvCaptured.Selected.ImageIndex:=oID;
+  end;
+  {$endif}
+end;
+
+procedure TForm1.btWriteDataClick(Sender: TObject);
+begin
+  if SaveDialog1.Execute then
+  begin
+    imgListThumbs.SaveToFile(SaveDialog1.FileName);
+  end;
+end;
+
+procedure TForm1.btWriteSelClick(Sender: TObject);
+begin
+  {$if lcl_fullversion>=4990000}
+  if (lvCaptured.Selected<>nil) and SaveDialog1.Execute then
+  begin
+    imgListThumbs.SaveToFile(SaveDialog1.FileName, lvCaptured.Selected.ImageIndex);
+  end;
+  {$endif}
+end;
+
+procedure TForm1.cbBGRADrawChange(Sender: TObject);
+begin
+  ImageList1.UseBGRADraw:= cbBGRADraw.Checked;
+  DrawGrid1.Invalidate;
+end;
+
+procedure TForm1.cbIndexDrawChange(Sender: TObject);
+begin
+  DrawGrid1.Invalidate;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  ImageList1.Overlay(3, 1);
+  ImageList1.Overlay(4, 2);
+  ImageList1.Overlay(5, 3);
+  ImageList1.Overlay(6, 4);
+  //LoadImgList('c:\tmp\imgList_o.img');
+end;
+
+procedure TForm1.ImageList1AfterDraw(Sender: TBGRAImageList; ACanvas: TCanvas; ARect: TRect; AIndex: Integer;
+  ADrawingStyle: TDrawingStyle; AImageType: TImageType; ADrawOverlay: Boolean; AOverlay: TOverlay;
+  ADrawEffect: TGraphicsDrawEffect);
+begin
+  if cbIndexDraw.Checked then
+  begin
+    ACanvas.SaveHandleState;
+    ACanvas.Brush.Color:= clSkyBlue;
+    ACanvas.Brush.Style:= bsSolid;
+    ACanvas.Font.Size:=8;
+    ACanvas.TextOut(ARect.Left+ARect.Right-8, ARect.Top+ARect.Bottom-10, IntToStr(AIndex));
+    ACanvas.RestoreHandleState;
+  end;
+end;
+
+function TForm1.ImageList1BeforeDraw(Sender: TBGRAImageList; ACanvas: TCanvas; var ARect: TRect; var AIndex: Integer;
+  var ADrawingStyle: TDrawingStyle; var AImageType: TImageType; var ADrawOverlay: Boolean; var AOverlay: TOverlay;
+  var ADrawEffect: TGraphicsDrawEffect): Boolean;
+begin
+  ARect.Left:=ARect.Left-8;
+  ADrawEffect:=gdeHighlighted;
+
+  if cbOverlay.Checked then
+  begin
+    ADrawOverlay:= True;
+    AOverlay:=AIndex+1;
+  end;
+  Result:= True;
+end;
+
+procedure TForm1.LoadImgList(AFileName: String);
+var
+   newItem: TListItem;
+   i, k, t: Integer;
+
+begin
+//    lvCaptured.BeginUpdate;
+
+    imgListThumbs.LoadFromFile(AFileName);
+
+    if (lvCaptured.Items.Count<imgListThumbs.Count) then
+    begin
+      k:= lvCaptured.Items.Count;
+      t:= imgListThumbs.Count;
+
+      for i:=k to t-1 do
+      begin
+        newItem:= lvCaptured.Items.Add;
+        newItem.Caption:= ExtractFileName(OpenDialog1.FileName+' ('+IntToStr(i)+')');
+        newItem.ImageIndex:= i;
+      end;
+    end;
+
+//    lvCaptured.EndUpdate;
+//    lvCaptured.Invalidate;
+end;
+
+
+end.
+

test/test_bgraimagemanipulation/ProjectBGRAImageManipulationDemo.lpi → test/test_bgraimagemanipulation/BGRAImageManipulationDemo.lpi

@@ -7,6 +7,7 @@
         <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
+      <Title Value="BGRAImageManipulationDemo"/>
       <Scaled Value="True"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
@@ -28,7 +29,7 @@
         <CompilerOptions>
           <Version Value="11"/>
           <Target>
-            <Filename Value="ProjectBGRAImageManipulationDemo"/>
+            <Filename Value="bin/$(TargetCPU)-$(TargetOS)/BGRAImageManipulationDemo"/>
           </Target>
           <SearchPaths>
             <IncludeFiles Value="$(ProjOutDir)"/>
@@ -60,16 +61,9 @@
       <Version Value="2"/>
     </PublishOptions>
     <RunParams>
-      <local>
-        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
-      </local>
       <FormatVersion Value="2"/>
       <Modes Count="1">
-        <Mode0 Name="default">
-          <local>
-            <LaunchingApplication PathPlusParams="/usr/bin/xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
-          </local>
-        </Mode0>
+        <Mode0 Name="default"/>
       </Modes>
     </RunParams>
     <RequiredPackages Count="2">
@@ -82,7 +76,7 @@
     </RequiredPackages>
     <Units Count="2">
       <Unit0>
-        <Filename Value="ProjectBGRAImageManipulationDemo.lpr"/>
+        <Filename Value="BGRAImageManipulationDemo.lpr"/>
         <IsPartOfProject Value="True"/>
       </Unit0>
       <Unit1>
@@ -98,7 +92,7 @@
   <CompilerOptions>
     <Version Value="11"/>
     <Target>
-      <Filename Value="ProjectBGRAImageManipulationDemo"/>
+      <Filename Value="bin/$(TargetCPU)-$(TargetOS)/BGRAImageManipulationDemo-dbg"/>
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
@@ -117,6 +111,7 @@
         <StackChecks Value="True"/>
       </Checks>
       <Optimizations>
+        <OptimizationLevel Value="0"/>
         <VariablesInRegisters Value="True"/>
       </Optimizations>
     </CodeGeneration>

test/test_bgraimagemanipulation/ProjectBGRAImageManipulationDemo.lpr → test/test_bgraimagemanipulation/BGRAImageManipulationDemo.lpr

@@ -1,4 +1,4 @@
-program ProjectBGRAImageManipulationDemo;
+program BGRAImageManipulationDemo;
 
 {$mode objfpc}{$H+}
 
@@ -13,7 +13,6 @@ uses
 
 begin
   Application.Scaled:=True;
-  Application.Title:='';
   Application.Initialize;
   Application.CreateForm(TFormBGRAImageManipulationDemo, FormBGRAImageManipulationDemo);
   Application.Run;

test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.lfm

@@ -1,20 +1,21 @@
 object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
   Left = 262
-  Height = 543
+  Height = 679
   Top = 84
-  Width = 926
+  Width = 1158
   Caption = 'Demonstration of TBGRAImageManipulation'
-  ClientHeight = 543
-  ClientWidth = 926
+  ClientHeight = 679
+  ClientWidth = 1158
+  DesignTimePPI = 120
   ShowHint = True
-  LCLVersion = '3.99.0.0'
+  LCLVersion = '4.99.0.0'
   OnCloseQuery = FormCloseQuery
   OnCreate = FormCreate
   object Background: TBCPanel
-    Left = 678
-    Height = 543
+    Left = 848
+    Height = 679
     Top = 0
-    Width = 248
+    Width = 310
     Align = alRight
     Background.Color = clSilver
     Background.Gradient1.StartColor = clWhite
@@ -49,19 +50,19 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
     Rounding.RoundY = 1
     TabOrder = 0
     object RateCompression: TTrackBar
-      Left = 40
-      Height = 24
-      Top = 336
-      Width = 180
+      Left = 50
+      Height = 47
+      Top = 420
+      Width = 225
       Max = 100
       Position = 80
       TabOrder = 0
     end
     object KeepAspectRatio: TCheckBox
-      Left = 25
-      Height = 19
-      Top = 176
-      Width = 115
+      Left = 31
+      Height = 25
+      Top = 220
+      Width = 168
       Caption = 'Keep aspect ratio'
       Checked = True
       Color = clWhite
@@ -74,10 +75,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       OnClick = KeepAspectRatioClick
     end
     object lbOptions: TLabel
-      Left = 10
-      Height = 15
-      Top = 72
-      Width = 87
+      Left = 12
+      Height = 23
+      Top = 80
+      Width = 131
       Caption = 'Image Options :'
       Color = clBlack
       Font.Color = clWhite
@@ -87,10 +88,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       Transparent = False
     end
     object lbCompression: TLabel
-      Left = 25
-      Height = 15
-      Top = 320
-      Width = 77
+      Left = 31
+      Height = 23
+      Top = 400
+      Width = 116
       Caption = 'Compression :'
       Font.Color = clWhite
       Font.Style = [fsBold]
@@ -98,18 +99,18 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       ParentFont = False
     end
     object edAspectRatio: TEdit
-      Left = 123
-      Height = 23
-      Top = 204
-      Width = 44
+      Left = 154
+      Height = 35
+      Top = 255
+      Width = 55
       TabOrder = 2
       Text = '3:4'
     end
     object lbAspectRatio: TLabel
-      Left = 25
-      Height = 15
-      Top = 208
-      Width = 76
+      Left = 31
+      Height = 23
+      Top = 260
+      Width = 113
       Caption = 'Aspect Ratio :'
       Color = clBlack
       Font.Color = clWhite
@@ -119,10 +120,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       Transparent = False
     end
     object btnOpenPicture: TBCButton
-      Left = 10
-      Height = 40
-      Top = 8
-      Width = 134
+      Left = 12
+      Height = 50
+      Top = 10
+      Width = 168
       StateClicked.Background.Gradient1.StartColor = 8404992
       StateClicked.Background.Gradient1.EndColor = 4194304
       StateClicked.Background.Gradient1.GradientType = gtRadial
@@ -286,10 +287,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       MemoryUsage = bmuHigh
     end
     object btnSavePicture: TBCButton
-      Left = 15
-      Height = 40
-      Top = 440
-      Width = 200
+      Left = 19
+      Height = 50
+      Top = 550
+      Width = 250
       StateClicked.Background.Gradient1.StartColor = 8404992
       StateClicked.Background.Gradient1.EndColor = 4194304
       StateClicked.Background.Gradient1.GradientType = gtRadial
@@ -453,11 +454,11 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       MemoryUsage = bmuHigh
     end
     object btnSetAspectRatio: TBCButton
-      Left = 175
-      Height = 28
+      Left = 219
+      Height = 35
       Hint = 'Apply new aspect ratio'
-      Top = 204
-      Width = 40
+      Top = 255
+      Width = 50
       StateClicked.Background.Gradient1.StartColor = 8404992
       StateClicked.Background.Gradient1.EndColor = 4194304
       StateClicked.Background.Gradient1.GradientType = gtRadial
@@ -620,11 +621,11 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       MemoryUsage = bmuHigh
     end
     object btnGetAspectRatioFromImage: TBCButton
-      Left = 25
-      Height = 30
+      Left = 31
+      Height = 38
       Hint = 'Get aspect ratio from image'
-      Top = 240
-      Width = 30
+      Top = 300
+      Width = 38
       StateClicked.Background.Gradient1.StartColor = 8404992
       StateClicked.Background.Gradient1.EndColor = 4194304
       StateClicked.Background.Gradient1.GradientType = gtRadial
@@ -787,11 +788,11 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       MemoryUsage = bmuHigh
     end
     object btnRotateLeft: TBCButton
-      Left = 69
-      Height = 30
+      Left = 86
+      Height = 38
       Hint = 'Rotate Left'
-      Top = 240
-      Width = 30
+      Top = 300
+      Width = 38
       StateClicked.Background.Gradient1.StartColor = 8404992
       StateClicked.Background.Gradient1.EndColor = 4194304
       StateClicked.Background.Gradient1.GradientType = gtRadial
@@ -954,11 +955,11 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       MemoryUsage = bmuHigh
     end
     object btnRotateRight: TBCButton
-      Left = 105
-      Height = 30
+      Left = 131
+      Height = 38
       Hint = 'Rotate Right'
-      Top = 240
-      Width = 30
+      Top = 300
+      Width = 38
       StateClicked.Background.Gradient1.StartColor = 8404992
       StateClicked.Background.Gradient1.EndColor = 4194304
       StateClicked.Background.Gradient1.GradientType = gtRadial
@@ -1121,10 +1122,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       MemoryUsage = bmuHigh
     end
     object btnShape: TBCButton
-      Left = 32
-      Height = 24
-      Top = 336
-      Width = 200
+      Left = 40
+      Height = 30
+      Top = 420
+      Width = 250
       StateClicked.Background.Gradient1.StartColor = 8404992
       StateClicked.Background.Gradient1.EndColor = 4194304
       StateClicked.Background.Gradient1.GradientType = gtRadial
@@ -1211,10 +1212,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       MemoryUsage = bmuHigh
     end
     object btnSavePictureAll: TBCButton
-      Left = 15
-      Height = 40
-      Top = 392
-      Width = 200
+      Left = 19
+      Height = 50
+      Top = 490
+      Width = 250
       StateClicked.Background.Gradient1.StartColor = 8404992
       StateClicked.Background.Gradient1.EndColor = 4194304
       StateClicked.Background.Gradient1.GradientType = gtRadial
@@ -1378,10 +1379,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       MemoryUsage = bmuHigh
     end
     object chkFullSize: TCheckBox
-      Left = 15
-      Height = 19
-      Top = 480
-      Width = 83
+      Left = 19
+      Height = 25
+      Top = 600
+      Width = 117
       Caption = 'Original Size'
       Checked = True
       State = cbChecked
@@ -1389,16 +1390,16 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
     end
     object lbResolution: TLabel
       Left = 0
-      Height = 15
-      Top = 95
-      Width = 65
+      Height = 23
+      Top = 100
+      Width = 93
       Caption = 'Resolution : '
     end
     object BCLabel7: TBCLabel
-      Left = 11
-      Height = 15
-      Top = 296
-      Width = 44
+      Left = 14
+      Height = 23
+      Top = 370
+      Width = 63
       Background.Gradient1.StartColor = clWhite
       Background.Gradient1.EndColor = clBlack
       Background.Gradient1.GradientType = gtLinear
@@ -1428,29 +1429,29 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       Rounding.RoundY = 1
     end
     object cbSaveFormat: TComboBox
-      Left = 60
-      Height = 23
-      Top = 288
-      Width = 180
-      ItemHeight = 15
+      Left = 75
+      Height = 39
+      Top = 360
+      Width = 225
+      ItemHeight = 0
       Style = csDropDownList
       TabOrder = 4
     end
     object SpeedButton1: TSpeedButton
-      Left = 208
-      Height = 19
-      Top = 56
-      Width = 32
+      Left = 260
+      Height = 33
+      Top = 70
+      Width = 53
       AutoSize = True
       Caption = ':Tests'
       OnClick = SpeedButton1Click
     end
     object btnEmptyImage: TBCButton
-      Left = 152
-      Height = 40
+      Left = 190
+      Height = 50
       Hint = 'Get aspect ratio from image'
-      Top = 8
-      Width = 88
+      Top = 10
+      Width = 110
       StateClicked.Background.Gradient1.StartColor = 8404992
       StateClicked.Background.Gradient1.EndColor = 4194304
       StateClicked.Background.Gradient1.GradientType = gtRadial
@@ -1603,26 +1604,33 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       MemoryUsage = bmuHigh
     end
     object chkCopyProperties: TCheckBox
-      Left = 105
-      Height = 19
-      Top = 480
-      Width = 102
+      Left = 146
+      Height = 25
+      Top = 600
+      Width = 144
       Caption = 'Copy Properties'
       Checked = True
       State = cbChecked
       TabOrder = 5
     end
+    object lbFormat: TLabel
+      Left = 0
+      Height = 23
+      Top = 192
+      Width = 67
+      Caption = 'Format : '
+    end
   end
   object BGRAImageManipulation: TBGRAImageManipulation
-    Left = 198
-    Height = 543
+    Left = 248
+    Height = 679
     Top = 0
-    Width = 480
+    Width = 600
     Align = alClient
     AnchorSize = 9
     AspectRatio = '3:4'
-    MinHeight = 40
-    MinWidth = 30
+    MinHeight = 0
+    MinWidth = 0
     EmptyImage.ResolutionWidth = 21
     EmptyImage.ResolutionHeight = 29.7000007629395
     EmptyImage.ShowBorder = True
@@ -1632,12 +1640,14 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
     OnCropAreaDeleted = DeletedCrop
     OnCropAreaChanged = ChangedCrop
     OnSelectedCropAreaChanged = SelectedChangedCrop
+    OnBitmapLoadAfter = BGRAImageManipulationBitmapLoadAfter
+    OnBitmapSaveBefore = BGRAImageManipulationBitmapSaveBefore
   end
   object BCPanelCropAreas: TBCPanel
     Left = 0
-    Height = 543
+    Height = 679
     Top = 0
-    Width = 198
+    Width = 248
     Align = alLeft
     Background.Color = clSilver
     Background.ColorOpacity = 35
@@ -1674,20 +1684,20 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
     TabOrder = 1
     object cbBoxList: TComboBox
       Left = 0
-      Height = 23
-      Top = 20
-      Width = 125
-      ItemHeight = 15
+      Height = 39
+      Top = 25
+      Width = 156
+      ItemHeight = 0
       Style = csDropDownList
       TabOrder = 0
       OnChange = cbBoxListChange
     end
     object btBox_Add: TBGRASpeedButton
-      Left = 126
-      Height = 22
+      Left = 158
+      Height = 28
       Hint = 'Add a Box'
-      Top = 21
-      Width = 23
+      Top = 26
+      Width = 29
       Caption = '+'
       Flat = True
       ShowHint = True
@@ -1695,11 +1705,11 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       OnClick = btBox_AddClick
     end
     object btBox_Del: TBGRASpeedButton
-      Left = 149
-      Height = 22
+      Left = 186
+      Height = 28
       Hint = 'Remove this Box'
-      Top = 21
-      Width = 23
+      Top = 26
+      Width = 29
       Caption = '-'
       Flat = True
       ShowHint = True
@@ -1708,9 +1718,9 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
     end
     object lbOptions1: TLabel
       Left = 0
-      Height = 15
+      Height = 23
       Top = 0
-      Width = 66
+      Width = 99
       Caption = 'Crop Areas :'
       Color = clBlack
       Font.Color = clWhite
@@ -1721,9 +1731,9 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
     end
     object BCPanelCropAreaLoad: TBCPanel
       Left = 1
-      Height = 106
-      Top = 436
-      Width = 196
+      Height = 132
+      Top = 546
+      Width = 246
       Align = alBottom
       Background.Color = clBtnFace
       Background.Gradient1.StartColor = clWhite
@@ -1758,10 +1768,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       Rounding.RoundY = 1
       TabOrder = 1
       object btnLoadCropList: TBCButton
-        Left = 8
-        Height = 40
-        Top = 8
-        Width = 150
+        Left = 10
+        Height = 50
+        Top = 10
+        Width = 188
         StateClicked.Background.Gradient1.StartColor = 8404992
         StateClicked.Background.Gradient1.EndColor = 4194304
         StateClicked.Background.Gradient1.GradientType = gtRadial
@@ -1981,10 +1991,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         MemoryUsage = bmuHigh
       end
       object btnSaveCropList: TBCButton
-        Left = 7
-        Height = 40
-        Top = 56
-        Width = 150
+        Left = 9
+        Height = 50
+        Top = 70
+        Width = 188
         StateClicked.Background.Gradient1.StartColor = 8404992
         StateClicked.Background.Gradient1.EndColor = 4194304
         StateClicked.Background.Gradient1.GradientType = gtRadial
@@ -2206,9 +2216,9 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
     end
     object BCPanelCropArea: TBCPanel
       Left = 0
-      Height = 384
-      Top = 48
-      Width = 186
+      Height = 480
+      Top = 60
+      Width = 232
       Background.Color = clBtnFace
       Background.Gradient1.StartColor = clWhite
       Background.Gradient1.EndColor = clBlack
@@ -2243,10 +2253,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       Rounding.RoundY = 1
       TabOrder = 2
       object BCLabel1: TBCLabel
-        Left = 20
-        Height = 15
-        Top = 67
-        Width = 26
+        Left = 25
+        Height = 23
+        Top = 84
+        Width = 36
         Background.Gradient1.StartColor = clWhite
         Background.Gradient1.EndColor = clBlack
         Background.Gradient1.GradientType = gtLinear
@@ -2276,10 +2286,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         Rounding.RoundY = 1
       end
       object BCLabel2: TBCLabel
-        Left = 20
-        Height = 15
-        Top = 95
-        Width = 25
+        Left = 25
+        Height = 23
+        Top = 119
+        Width = 36
         Background.Gradient1.StartColor = clWhite
         Background.Gradient1.EndColor = clBlack
         Background.Gradient1.GradientType = gtLinear
@@ -2309,10 +2319,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         Rounding.RoundY = 1
       end
       object BCLabel3: TBCLabel
-        Left = 8
-        Height = 15
-        Top = 123
-        Width = 38
+        Left = 10
+        Height = 23
+        Top = 154
+        Width = 53
         Background.Gradient1.StartColor = clWhite
         Background.Gradient1.EndColor = clBlack
         Background.Gradient1.GradientType = gtLinear
@@ -2342,10 +2352,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         Rounding.RoundY = 1
       end
       object BCLabel4: TBCLabel
-        Left = 4
-        Height = 15
-        Top = 151
-        Width = 42
+        Left = 5
+        Height = 23
+        Top = 189
+        Width = 59
         Background.Gradient1.StartColor = clWhite
         Background.Gradient1.EndColor = clBlack
         Background.Gradient1.GradientType = gtLinear
@@ -2375,12 +2385,12 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         Rounding.RoundY = 1
       end
       object edUnit_Type: TComboBox
-        Left = 56
-        Height = 23
-        Top = 36
-        Width = 103
+        Left = 70
+        Height = 29
+        Top = 45
+        Width = 129
         AutoSize = False
-        ItemHeight = 15
+        ItemHeight = 0
         ItemIndex = 0
         Items.Strings = (
           'pixels'
@@ -2393,10 +2403,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnChange = edUnit_TypeChange
       end
       object BCLabel5: TBCLabel
-        Left = 18
-        Height = 15
-        Top = 39
-        Width = 28
+        Left = 22
+        Height = 23
+        Top = 49
+        Width = 39
         Background.Gradient1.StartColor = clWhite
         Background.Gradient1.EndColor = clBlack
         Background.Gradient1.GradientType = gtLinear
@@ -2426,10 +2436,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         Rounding.RoundY = 1
       end
       object BCLabel6: TBCLabel
-        Left = 8
-        Height = 15
-        Top = 12
-        Width = 38
+        Left = 10
+        Height = 23
+        Top = 15
+        Width = 53
         Background.Gradient1.StartColor = clWhite
         Background.Gradient1.EndColor = clBlack
         Background.Gradient1.GradientType = gtLinear
@@ -2459,27 +2469,27 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         Rounding.RoundY = 1
       end
       object edName: TEdit
-        Left = 56
-        Height = 23
-        Top = 8
-        Width = 103
+        Left = 70
+        Height = 29
+        Top = 10
+        Width = 129
         AutoSize = False
         TabOrder = 1
         OnEditingDone = edNameChange
       end
       object edAspectPersonal: TEdit
-        Left = 45
-        Height = 23
-        Top = 330
-        Width = 87
+        Left = 56
+        Height = 29
+        Top = 412
+        Width = 109
         AutoSize = False
         TabOrder = 2
       end
       object rgAspect: TRadioGroup
-        Left = 20
-        Height = 68
-        Top = 256
-        Width = 137
+        Left = 25
+        Height = 85
+        Top = 320
+        Width = 171
         AutoFill = True
         Caption = 'Aspect Ratio'
         ChildSizing.LeftRightSpacing = 6
@@ -2489,8 +2499,8 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         ChildSizing.ShrinkVertical = crsScaleChilds
         ChildSizing.Layout = cclLeftToRightThenTopToBottom
         ChildSizing.ControlsPerLine = 1
-        ClientHeight = 48
-        ClientWidth = 133
+        ClientHeight = 61
+        ClientWidth = 169
         Items.Strings = (
           'Parent'
           'Free'
@@ -2500,10 +2510,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnSelectionChanged = rgAspectSelectionChanged
       end
       object btApplyAspectRatio: TSpeedButton
-        Left = 133
-        Height = 22
-        Top = 331
-        Width = 23
+        Left = 166
+        Height = 28
+        Top = 414
+        Width = 29
         Glyph.Data = {
           C6070000424DC607000000000000360000002800000016000000160000000100
           2000000000009007000064000000640000000000000000000000000000000000
@@ -2572,10 +2582,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnClick = btApplyAspectRatioClick
       end
       object edLeft: TFloatSpinEdit
-        Left = 56
-        Height = 23
-        Top = 64
-        Width = 103
+        Left = 70
+        Height = 30
+        Top = 80
+        Width = 129
         DecimalPlaces = 3
         Font.Color = clWindowText
         Font.Name = 'Arial'
@@ -2586,10 +2596,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnChange = edLeftChange
       end
       object edTop: TFloatSpinEdit
-        Left = 56
-        Height = 23
-        Top = 92
-        Width = 103
+        Left = 70
+        Height = 30
+        Top = 115
+        Width = 129
         DecimalPlaces = 3
         Font.Color = clWindowText
         Font.Name = 'Arial'
@@ -2600,10 +2610,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnChange = edTopChange
       end
       object edWidth: TFloatSpinEdit
-        Left = 56
-        Height = 23
-        Top = 120
-        Width = 103
+        Left = 70
+        Height = 30
+        Top = 150
+        Width = 129
         DecimalPlaces = 3
         Font.Color = clWindowText
         Font.Name = 'Arial'
@@ -2614,10 +2624,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnChange = edWidthChange
       end
       object edHeight: TFloatSpinEdit
-        Left = 56
-        Height = 23
-        Top = 148
-        Width = 103
+        Left = 70
+        Height = 30
+        Top = 185
+        Width = 129
         DecimalPlaces = 3
         Font.Color = clWindowText
         Font.Name = 'Arial'
@@ -2628,18 +2638,18 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnChange = edHeightChange
       end
       object Label1: TLabel
-        Left = 7
-        Height = 15
-        Top = 224
-        Width = 46
+        Left = 9
+        Height = 23
+        Top = 280
+        Width = 65
         Caption = 'Z Order :'
       end
       object btZFront: TSpeedButton
-        Left = 57
-        Height = 22
+        Left = 71
+        Height = 28
         Hint = 'To Front'
-        Top = 224
-        Width = 23
+        Top = 280
+        Width = 29
         Glyph.Data = {
           36040000424D3604000000000000360000002800000010000000100000000100
           2000000000000004000000000000000000000000000000000000FFFFFF00FFFF
@@ -2679,11 +2689,11 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnClick = btZFrontClick
       end
       object btZBack: TSpeedButton
-        Left = 81
-        Height = 22
+        Left = 101
+        Height = 28
         Hint = 'To Back'
-        Top = 224
-        Width = 23
+        Top = 280
+        Width = 29
         Glyph.Data = {
           36040000424D3604000000000000360000002800000010000000100000000100
           2000000000000004000000000000000000000000000000000000FFFFFF00FFFF
@@ -2723,11 +2733,11 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnClick = btZBackClick
       end
       object btZDown: TSpeedButton
-        Left = 134
-        Height = 22
+        Left = 168
+        Height = 28
         Hint = 'Down'
-        Top = 224
-        Width = 23
+        Top = 280
+        Width = 29
         Glyph.Data = {
           36040000424D3604000000000000360000002800000010000000100000000100
           2000000000000004000000000000000000000000000000000000FFFFFF00FFFF
@@ -2767,11 +2777,11 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnClick = btZDownClick
       end
       object btZUp: TSpeedButton
-        Left = 110
-        Height = 22
+        Left = 138
+        Height = 28
         Hint = 'Up'
-        Top = 224
-        Width = 23
+        Top = 280
+        Width = 29
         Glyph.Data = {
           36040000424D3604000000000000360000002800000010000000100000000100
           2000000000000004000000000000000000000000000000000000FFFFFF00FFFF
@@ -2811,18 +2821,18 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnClick = btZUpClick
       end
       object Label2: TLabel
-        Left = 14
-        Height = 15
-        Top = 176
-        Width = 40
+        Left = 18
+        Height = 23
+        Top = 220
+        Width = 58
         Caption = 'Rotate :'
       end
       object btCRotateLeft: TSpeedButton
-        Left = 58
-        Height = 22
+        Left = 72
+        Height = 28
         Hint = 'Rotate Left'
-        Top = 176
-        Width = 23
+        Top = 220
+        Width = 29
         Glyph.Data = {
           36040000424D3604000000000000360000002800000010000000100000000100
           2000000000000004000000000000000000000000000000000000000000000000
@@ -2862,11 +2872,11 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnClick = btCRotateLeftClick
       end
       object btCRotateRight: TSpeedButton
-        Left = 82
-        Height = 22
+        Left = 102
+        Height = 28
         Hint = 'Rotate Right'
-        Top = 176
-        Width = 23
+        Top = 220
+        Width = 29
         Glyph.Data = {
           36040000424D3604000000000000360000002800000010000000100000000100
           2000000000000004000000000000000000000000000000000000FFFFFF00FFFF
@@ -2906,18 +2916,18 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnClick = btCRotateRightClick
       end
       object Label3: TLabel
-        Left = 28
-        Height = 15
-        Top = 200
-        Width = 25
+        Left = 35
+        Height = 23
+        Top = 250
+        Width = 34
         Caption = 'Flip :'
       end
       object btCFlipVUp: TSpeedButton
-        Left = 58
-        Height = 22
+        Left = 72
+        Height = 28
         Hint = 'Flip Vertical Up'
-        Top = 200
-        Width = 23
+        Top = 250
+        Width = 29
         Glyph.Data = {
           36040000424D3604000000000000360000002800000010000000100000000100
           2000000000000004000000000000000000000000000000000000FFFFFF00FFFF
@@ -2957,11 +2967,11 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnClick = btCFlipVUpClick
       end
       object btCFlipVDown: TSpeedButton
-        Left = 82
-        Height = 22
+        Left = 102
+        Height = 28
         Hint = 'Flip Vertical Down'
-        Top = 200
-        Width = 23
+        Top = 250
+        Width = 29
         Glyph.Data = {
           36040000424D3604000000000000360000002800000010000000100000000100
           2000000000000004000000000000000000000000000000000000FFFFFF00FFFF
@@ -3001,11 +3011,11 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnClick = btCFlipVDownClick
       end
       object btCFlipHLeft: TSpeedButton
-        Left = 111
-        Height = 22
+        Left = 139
+        Height = 28
         Hint = 'Flip Horizzontal Left'
-        Top = 200
-        Width = 23
+        Top = 250
+        Width = 29
         Glyph.Data = {
           36040000424D3604000000000000360000002800000010000000100000000100
           2000000000000004000000000000000000000000000000000000FFFFFF00FFFF
@@ -3045,11 +3055,11 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnClick = btCFlipHLeftClick
       end
       object btCFlipHRight: TSpeedButton
-        Left = 134
-        Height = 22
+        Left = 168
+        Height = 28
         Hint = 'Flip Horizzontal Right'
-        Top = 200
-        Width = 23
+        Top = 250
+        Width = 29
         Glyph.Data = {
           36040000424D3604000000000000360000002800000010000000100000000100
           2000000000000004000000000000000000000000000000000000FFFFFF00FFFF
@@ -3089,11 +3099,11 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnClick = btCFlipHRightClick
       end
       object btCropDuplicateOp: TSpeedButton
-        Left = 161
-        Height = 22
+        Left = 201
+        Height = 28
         Hint = 'Duplicate when Rotate/Flip'
-        Top = 192
-        Width = 23
+        Top = 240
+        Width = 29
         AllowAllUp = True
         Flat = True
         Glyph.Data = {
@@ -3135,10 +3145,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         GroupIndex = 1
       end
       object cbIconIndex: TCheckBox
-        Left = 48
-        Height = 19
-        Top = 359
-        Width = 47
+        Left = 60
+        Height = 25
+        Top = 449
+        Width = 66
         Caption = 'Index'
         Checked = True
         State = cbChecked
@@ -3146,19 +3156,19 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         OnChange = cbIconIndexChange
       end
       object Label4: TLabel
-        Left = 7
-        Height = 15
-        Top = 359
-        Width = 34
+        Left = 9
+        Height = 23
+        Top = 449
+        Width = 49
         Caption = 'Icons :'
       end
     end
     object btCropDuplicate: TSpeedButton
-      Left = 172
-      Height = 22
+      Left = 215
+      Height = 28
       Hint = 'Duplicate this Area'
-      Top = 20
-      Width = 23
+      Top = 25
+      Width = 29
       Flat = True
       Glyph.Data = {
         36040000424D3604000000000000360000002800000010000000100000000100
@@ -3201,31 +3211,31 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
   end
   object OpenPictureDialog: TOpenPictureDialog
     Title = 'Open an existing image'
-    Left = 400
-    Top = 16
+    Left = 500
+    Top = 20
   end
   object SavePictureDialog: TSavePictureDialog
     Title = 'Save image as'
     DefaultExt = '.jpg'
-    Left = 312
-    Top = 16
+    Left = 390
+    Top = 20
   end
   object SelectDirectoryDialog1: TSelectDirectoryDialog
-    Left = 312
-    Top = 74
+    Left = 390
+    Top = 93
   end
   object SaveCropList: TSaveDialog
     DefaultExt = '.clf'
     Filter = 'Crop List File (*.clf)|*.clf|All Files (*.*)|*.*'
     FilterIndex = 0
-    Left = 191
-    Top = 368
+    Left = 239
+    Top = 460
   end
   object OpenCropList: TOpenDialog
     DefaultExt = '.clf'
     Filter = 'Crop List File (*.clf)|*.clf|All Files (*.*)|*.*'
     FilterIndex = 0
-    Left = 192
-    Top = 418
+    Left = 240
+    Top = 523
   end
 end

test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.pas

@@ -119,6 +119,7 @@ type
     lbOptions:         TLabel;
     lbCompression:     TLabel;
     lbOptions1: TLabel;
+    lbFormat: TLabel;
     OpenCropList: TOpenDialog;
     OpenPictureDialog: TOpenPictureDialog;
     rgAspect: TRadioGroup;
@@ -132,6 +133,10 @@ type
     btZDown: TSpeedButton;
     btZUp: TSpeedButton;
     btCropDuplicateOp: TSpeedButton;
+    procedure BGRAImageManipulationBitmapLoadAfter(Sender: TBGRAImageManipulation; AStream: TStream;
+      AFormat: TBGRAImageFormat; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions);
+    procedure BGRAImageManipulationBitmapSaveBefore(Sender: TBGRAImageManipulation; AStream: TStream;
+      AFormat: TBGRAImageFormat; AHandler: TFPCustomImageWriter);
     procedure btCFlipHLeftClick(Sender: TObject);
     procedure btCFlipHRightClick(Sender: TObject);
     procedure btCFlipVDownClick(Sender: TObject);
@@ -180,6 +185,10 @@ type
     lastNewBoxNum :Word;
     changingAspect, closing,
     inFillBoxUI :Boolean;
+    sourceFormat,
+    destFormat: TBGRAImageFormat;
+
+    jpgGray: Boolean;
 
     function GetCurrentCropArea: TCropArea;
     procedure FillBoxUI(ABox :TCropArea);
@@ -196,7 +205,11 @@ implementation
 
 {$R *.lfm}
 
-//uses BGRAWriteBMP, BGRAReadWriteConfig;
+uses
+  {$ifopt D+}
+   LazLogger,
+  {$endif}
+  UniversalDrawer, BGRAReadJpeg, BGRAWriteJpeg;
 
 const
   ResUnitStr :array[TResolutionUnit] of String = ('ruNone', 'ruPixelsPerInch', 'ruPixelsPerCentimeter');
@@ -207,19 +220,15 @@ procedure TFormBGRAImageManipulationDemo.btnOpenPictureClick(Sender: TObject);
 var
   Bitmap: TBGRABitmap;
   test:Integer;
-//  reader:TFPCustomImageReader;
+  tt:TPicture;
 
 begin
   // To put a new image in the component, you will simply need execute open
   // picture dialog to locate an image...
   if OpenPictureDialog.Execute then
   begin
-    // ...and create a new TBGRABitmap and load to it
-    Bitmap := TBGRABitmap.Create;
-    Bitmap.LoadFromFile(OpenPictureDialog.FileName);
-    // Finally, associate the image into component
-    BGRAImageManipulation.Bitmap := Bitmap;
-    Bitmap.Free;
+    //...and load it
+    BGRAImageManipulation.LoadFromFile(OpenPictureDialog.FileName);
 
     lbResolution.Caption:='Resolution : '+#13#10+'  '+
           FloatToStrF(BGRAImageManipulation.Bitmap.ResolutionX, ffFixed, 15, 3)+' x '+
@@ -323,6 +332,49 @@ begin
   end;
 end;
 
+procedure TFormBGRAImageManipulationDemo.BGRAImageManipulationBitmapLoadAfter(Sender: TBGRAImageManipulation;
+  AStream: TStream; AFormat: TBGRAImageFormat; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions);
+var
+   i: Integer;
+
+begin
+  sourceFormat:= AFormat;
+  //Store AHandler properties
+  case sourceFormat of
+    ifJpeg: begin
+      if (AHandler is TBGRAReaderJPEG) then
+      begin
+        { #todo -oMaxM : only a Test, we should save the reader properties so we can use them in the writer, but how? }
+        jpgGray:= TBGRAReaderJPEG(AHandler).GrayScale;
+      end;
+    end;
+  end;
+
+  //Find Loaded Format and select it
+  i:= cbSaveFormat.Items.IndexOfObject(TObject(PtrUInt(sourceFormat)));
+  if (i < 0) then i:= cbSaveFormat.Items.IndexOfObject(TObject(PtrUInt(ifJpeg)));
+
+  if (i >= 0) then
+  begin
+    lbFormat.Caption:= 'Format: '+BGRAImageFormat[TBGRAImageFormat(PtrUint(cbSaveFormat.Items.Objects[i]))].TypeName;
+    RateCompression.Enabled:= TBGRAImageFormat(PtrUint(cbSaveFormat.Items.Objects[i])) = ifJpeg;
+  end;
+
+end;
+
+procedure TFormBGRAImageManipulationDemo.BGRAImageManipulationBitmapSaveBefore(Sender: TBGRAImageManipulation;
+  AStream: TStream; AFormat: TBGRAImageFormat; AHandler: TFPCustomImageWriter);
+begin
+  if (AFormat = ifJpeg) and (RateCompression.Enabled) then
+  begin
+    if (AHandler is TBGRAWriterJPEG) then
+    begin
+      TBGRAWriterJPEG(AHandler).CompressionQuality:= RateCompression.Position;
+      TBGRAWriterJPEG(AHandler).GrayScale:= jpgGray;
+    end;
+  end;
+end;
+
 procedure TFormBGRAImageManipulationDemo.btCFlipHRightClick(Sender: TObject);
 var
    CropArea :TCropArea;
@@ -408,6 +460,10 @@ end;
 procedure TFormBGRAImageManipulationDemo.btnSavePictureClick(Sender: TObject);
 var
   curBitmap :TBGRABitmap;
+  ext:String;
+  i,
+  selE:Integer;
+  destHandler: TFPCustomImageWriter;
 
 begin
   if SavePictureDialog.Execute then
@@ -417,8 +473,37 @@ begin
       then curBitmap :=BGRAImageManipulation.getBitmap(Nil, chkCopyProperties.Checked)
       else curBitmap :=BGRAImageManipulation.getResampledBitmap(Nil, chkCopyProperties.Checked);
 
-      curBitmap.SaveToFile(SavePictureDialog.FileName);
+      selE:= cbSaveFormat.ItemIndex;
+      if (selE = 0)
+      then begin
+             //Same format as Input
+             destFormat:= sourceFormat;
+           end
+      else begin
+             destFormat:= TBGRAImageFormat(PtrUInt(cbSaveFormat.Items.Objects[selE]));
+           end;
+
+      destHandler:= TUniversalDrawer.CreateBGRAImageWriter(curBitmap, destFormat);
+
+      if (destFormat = ifJpeg) and (RateCompression.Enabled) then
+      begin
+        if (destHandler is TBGRAWriterJPEG) then
+        begin
+          TBGRAWriterJPEG(destHandler).CompressionQuality:= RateCompression.Position;
+          TBGRAWriterJPEG(destHandler).GrayScale:= jpgGray;
+        end;
+      end;
+
+     ext:= SuggestImageExtension(destFormat);
+
+     // This Save with Default Properties
+     //curBitmap.SaveToFile(SavePictureDialog.FileName+'.'+ext, destFormat);
+
+     // This save with Stored Properties
+     curBitmap.SaveToFile(SavePictureDialog.FileName+'.'+ext, destHandler);
+
     finally
+      destHandler.Free;
       curBitmap.Free;
     end;
   end;
@@ -427,13 +512,50 @@ end;
 procedure TFormBGRAImageManipulationDemo.SaveCallBack(Bitmap: TBGRABitmap; CropArea: TCropArea; AUserData: Integer);
 var
   ext:String;
-  i:Integer;
+  i,
+  selE:Integer;
+  destHandler: TFPCustomImageWriter;
 
 begin
-   ext:=ImageHandlers.Extensions[cbSaveFormat.Items[cbSaveFormat.ItemIndex]];
+  try
+   selE:= cbSaveFormat.ItemIndex;
+   if (selE = 0)
+   then begin
+          //Same format as Input
+          destFormat:= sourceFormat;
+        end
+   else begin
+          destFormat:= TBGRAImageFormat(PtrUInt(cbSaveFormat.Items.Objects[selE]));
+        end;
+
+   destHandler:= TUniversalDrawer.CreateBGRAImageWriter(Bitmap, destFormat);
+
+   if (destFormat = ifJpeg) and (RateCompression.Enabled) then
+   begin
+     if (destHandler is TBGRAWriterJPEG) then
+     begin
+       TBGRAWriterJPEG(destHandler).CompressionQuality:= RateCompression.Position;
+       TBGRAWriterJPEG(destHandler).GrayScale:= jpgGray;
+     end;
+   end;
+
+  ext:= SuggestImageExtension(destFormat);
+
+  // This Save with Default Properties
+  //Bitmap.SaveToFile(SelectDirectoryDialog1.FileName+DirectorySeparator+CropArea.Name+'.'+ext, destFormat);
+
+  // This Save with Stored Properties
+  Bitmap.SaveToFile(SelectDirectoryDialog1.FileName+DirectorySeparator+CropArea.Name+'.'+ext, destHandler);
+
+  (*  ext:=ImageHandlers.Extensions[cbSaveFormat.Items[selE]];
    i :=Pos(';', ext);
    if (i>0) then ext :=Copy(ext, 1, i-1);
    Bitmap.SaveToFile(SelectDirectoryDialog1.FileName+DirectorySeparator+CropArea.Name+'.'+ext);
+*)
+
+  finally
+    destHandler.Free;
+  end;
 end;
 
 procedure TFormBGRAImageManipulationDemo.UpdateBoxList;
@@ -660,7 +782,7 @@ end;
 procedure TFormBGRAImageManipulationDemo.FormCreate(Sender: TObject);
 var
    i,j :Integer;
-   t,e:String;
+   iFormat:TBGRAImageFormat;
 
 begin
    closing :=False;
@@ -669,6 +791,10 @@ begin
    lastNewBoxNum :=0;
    TStringList(cbBoxList.Items).OwnsObjects:=False;
    j:=0;
+
+   cbSaveFormat.Items.Add('Same As Input');
+
+   (* fpc Formats
    for i :=0 to ImageHandlers.Count-1 do
    begin
      t :=ImageHandlers.TypeNames[i];
@@ -676,10 +802,22 @@ begin
      if (ImageHandlers.ImageWriter[t]<>nil) then
      begin
        cbSaveFormat.Items.Add(t);
-       if (Pos('jpg', e)>0) then j:=i;
+       if (Pos('jpg', e)>0) then j:=i+1;
      end;
    end;
-   cbSaveFormat.ItemIndex:=j-1;
+   *)
+
+   //BGRA Formats
+   for iFormat:= low(TBGRAImageFormat) to high(TBGRAImageFormat) do
+   begin
+     if (DefaultBGRAImageWriter[iFormat]<>nil) then
+     begin
+       i:= cbSaveFormat.Items.AddObject(BGRAImageFormat[iFormat].TypeName+' ('+SuggestImageExtension(iFormat)+')',
+                                        TObject(PtrUInt(iFormat)));
+       if (iFormat = ifJpeg) then j:=i;
+     end;
+   end;
+   cbSaveFormat.ItemIndex:=0;
 end;
 
 procedure TFormBGRAImageManipulationDemo.rgAspectSelectionChanged(Sender: TObject);
@@ -714,21 +852,32 @@ var
   curIndex :Integer;
 
 begin
-   curIndex :=BGRAImageManipulation.CropAreas.IndexOf(CropArea);
+  {$ifopt D+}
+   DebugLn('AddedCrop');
+  {$endif}
+
+  curIndex :=BGRAImageManipulation.CropAreas.IndexOf(CropArea);
 
-   if (CropArea.Name='')
-   then CropArea.Name:='Name '+IntToStr(curIndex);
+   if (CropArea.Name='') then CropArea.Name:='Name '+IntToStr(curIndex);
 
    cbBoxList.AddItem(CropArea.Name, CropArea);
    cbBoxList.ItemIndex:=cbBoxList.Items.IndexOfObject(CropArea);
    //CropArea.AreaUnit:=BGRAImageManipulation.Bitmap.ResolutionUnit;
    FillBoxUI(CropArea);
+
+   {$ifopt D+}
+    DebugLn('AddedCrop done');
+   {$endif}
 end;
 
 procedure TFormBGRAImageManipulationDemo.DeletedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
 var
    delIndex :Integer;
 begin
+  {$ifopt D+}
+   DebugLn('DeletedCrop');
+  {$endif}
+
   try
     if not(closing) then
     begin
@@ -740,11 +889,19 @@ begin
   except
   end;
   //MessageDlg('Deleting Crop Area', 'Deleting '+CropArea.Name, mtInformation, [mbOk], 0);
+
+  {$ifopt D+}
+   DebugLn('DeletedCrop done');
+  {$endif}
 end;
 
 procedure TFormBGRAImageManipulationDemo.ChangedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);
 begin
-  if (cbBoxList.Items.Objects[cbBoxList.ItemIndex] = CropArea) then
+  {$ifopt D+}
+   DebugLn('ChangedCrop');
+  {$endif}
+
+  if (cbBoxList.ItemIndex > -1) and (cbBoxList.Items.Objects[cbBoxList.ItemIndex] = CropArea) then
   begin
     FillBoxUI(CropArea);
 
@@ -752,6 +909,10 @@ begin
     if (CropArea.Name<>cbBoxList.Items.Strings[cbBoxList.ItemIndex])
     then cbBoxList.Items.Strings[cbBoxList.ItemIndex] :=CropArea.Name;
   end;
+
+  {$ifopt D+}
+   DebugLn('ChangedCrop done');
+  {$endif}
 end;
 
 procedure TFormBGRAImageManipulationDemo.SelectedChangedCrop(Sender: TBGRAImageManipulation; CropArea: TCropArea);

test/test_bgraknob/project1.lpi

@@ -25,6 +25,12 @@
       <FormatVersion Value="2"/>
     </RunParams>
     <RequiredPackages>
+      <Item>
+        <PackageName Value="LazControls"/>
+      </Item>
+      <Item>
+        <PackageName Value="LazControlDsgn"/>
+      </Item>
       <Item>
         <PackageName Value="bgracontrols"/>
       </Item>

test/test_bgraknob/project1.lpr

@@ -10,7 +10,7 @@ uses
   athreads,
   {$ENDIF}
   Interfaces, // this includes the LCL widgetset
-  Forms, unit1;
+  Forms, lazcontrols, unit1;
 
 {$R *.res}
 

test/test_bgraknob/unit1.lfm

@@ -1,24 +1,25 @@
 object Form1: TForm1
-  Left = 720
-  Height = 483
-  Top = 177
+  Left = 592
+  Height = 503
+  Top = 516
   Width = 1269
-  Caption = 'Form1'
-  ClientHeight = 483
+  Caption = 'BGRAKnob Test'
+  ClientHeight = 503
   ClientWidth = 1269
   DesignTimePPI = 144
   OnCreate = FormCreate
-  LCLVersion = '3.0.0.3'
+  LCLVersion = '3.6.0.0'
   object BGRAKnob1: TBGRAKnob
     Left = 32
     Height = 100
     Top = 48
     Width = 100
     CurveExponent = 0.200000002980232
-    KnobColor = clMedGray
+    KnobColor = clSilver
     PositionColor = clBlack
+    PositionType = kptLineRoundCap
     MinValue = 0
-    MaxValue = 50
+    MaxValue = 100
     Value = 0
     OnValueChanged = BGRAKnob1ValueChanged
     WheelSpeed = 100
@@ -34,12 +35,12 @@ object Form1: TForm1
   end
   object GroupBox1: TGroupBox
     Left = 464
-    Height = 456
+    Height = 480
     Top = 16
-    Width = 168
+    Width = 160
     Caption = 'Set/Get Value'
-    ClientHeight = 426
-    ClientWidth = 164
+    ClientHeight = 450
+    ClientWidth = 156
     TabOrder = 0
     object Set50Btn: TButton
       Left = 24
@@ -234,7 +235,7 @@ object Form1: TForm1
     object BitBtn1: TBitBtn
       Left = 8
       Height = 40
-      Top = 376
+      Top = 400
       Width = 144
       Caption = 'Get Value'
       Glyph.Data = {
@@ -491,13 +492,13 @@ object Form1: TForm1
     end
   end
   object GeneralSettingsGb: TGroupBox
-    Left = 176
-    Height = 456
+    Left = 160
+    Height = 480
     Top = 16
-    Width = 278
+    Width = 294
     Caption = 'General Settings'
-    ClientHeight = 426
-    ClientWidth = 274
+    ClientHeight = 450
+    ClientWidth = 290
     ParentBackground = False
     ParentColor = False
     TabOrder = 1
@@ -505,7 +506,7 @@ object Form1: TForm1
       Left = 16
       Height = 29
       Hint = 'Set the Snap Around Mode'#13#10'SlowSnap prevents twitchy behavior'#13#10'when wrapping at start or end of ranges'
-      Top = 216
+      Top = 264
       Width = 103
       Caption = 'SlowSnap'
       Checked = True
@@ -628,9 +629,9 @@ object Form1: TForm1
       Caption = 'Set Mouse Wheel Speed'
     end
     object ResetGeneralBtn: TBitBtn
-      Left = 16
-      Height = 45
-      Top = 371
+      Left = 15
+      Height = 40
+      Top = 403
       Width = 249
       Caption = 'Reset General'
       Glyph.Data = {
@@ -717,7 +718,7 @@ object Form1: TForm1
       Left = 16
       Height = 29
       Hint = 'Draw Pointer From Top'
-      Top = 249
+      Top = 288
       Width = 174
       Caption = 'Start From Bottom'
       Checked = True
@@ -731,7 +732,7 @@ object Form1: TForm1
       Left = 16
       Height = 29
       Hint = 'Flips scale, can also sometimes be done in tRange mode'
-      Top = 282
+      Top = 312
       Width = 131
       Caption = 'Reverse Scale'
       TabOrder = 5
@@ -741,7 +742,7 @@ object Form1: TForm1
       Left = 16
       Height = 29
       Hint = 'If checked allow the mouse wheel to '#13#10'cycle around over start and end'
-      Top = 316
+      Top = 336
       Width = 181
       Caption = 'Mouse Wheel Wrap'
       ParentShowHint = False
@@ -750,180 +751,413 @@ object Form1: TForm1
       OnChange = MouseWheelWrapCbChange
     end
     object Label9: TLabel
+      Left = 104
+      Height = 25
+      Top = 104
+      Width = 162
+      Caption = 'No Effect in ktSector'
+    end
+    object PositionTypeCb: TComboBox
       Left = 16
+      Height = 33
+      Hint = 'Set Position Indicator'
+      Top = 160
+      Width = 182
+      ItemHeight = 25
+      ItemIndex = 0
+      Items.Strings = (
+        'kptLineSquareCap'
+        'kptLineRoundCap'
+        'kptFilledCircle'
+        'kptHollowCircle'
+        'kptNone'
+      )
+      ParentShowHint = False
+      ReadOnly = True
+      ShowHint = True
+      TabOrder = 7
+      Text = 'kptLineSquareCap'
+      OnChange = PositionTypeCbChange
+    end
+    object Label27: TLabel
+      Left = 16
+      Height = 25
+      Top = 137
+      Width = 105
+      Caption = 'Position Type'
+    end
+    object PositionWidthTB: TBCTrackbarUpdown
+      Left = 200
+      Height = 34
+      Hint = 'Width of the line or circle used as a pointer on'#13#10'the knob face.'
+      Top = 160
+      Width = 85
+      AllowNegativeValues = False
+      BarExponent = 1
+      Increment = 1
+      LongTimeInterval = 400
+      MinValue = 0
+      MaxValue = 255
+      OnChange = PositionWidthTBChange
+      Value = 10
+      ShortTimeInterval = 100
+      Background.Color = clWindow
+      Background.Gradient1.StartColor = clWhite
+      Background.Gradient1.EndColor = clBlack
+      Background.Gradient1.GradientType = gtLinear
+      Background.Gradient1.Point1XPercent = 0
+      Background.Gradient1.Point1YPercent = 0
+      Background.Gradient1.Point2XPercent = 0
+      Background.Gradient1.Point2YPercent = 100
+      Background.Gradient2.StartColor = clWhite
+      Background.Gradient2.EndColor = clBlack
+      Background.Gradient2.GradientType = gtLinear
+      Background.Gradient2.Point1XPercent = 0
+      Background.Gradient2.Point1YPercent = 0
+      Background.Gradient2.Point2XPercent = 0
+      Background.Gradient2.Point2YPercent = 100
+      Background.Gradient1EndPercent = 35
+      Background.Style = bbsColor
+      ButtonBackground.Gradient1.StartColor = clBtnShadow
+      ButtonBackground.Gradient1.EndColor = clBtnFace
+      ButtonBackground.Gradient1.GradientType = gtLinear
+      ButtonBackground.Gradient1.Point1XPercent = 0
+      ButtonBackground.Gradient1.Point1YPercent = -50
+      ButtonBackground.Gradient1.Point2XPercent = 0
+      ButtonBackground.Gradient1.Point2YPercent = 50
+      ButtonBackground.Gradient2.StartColor = clBtnFace
+      ButtonBackground.Gradient2.EndColor = clBtnShadow
+      ButtonBackground.Gradient2.GradientType = gtLinear
+      ButtonBackground.Gradient2.Point1XPercent = 0
+      ButtonBackground.Gradient2.Point1YPercent = 50
+      ButtonBackground.Gradient2.Point2XPercent = 0
+      ButtonBackground.Gradient2.Point2YPercent = 150
+      ButtonBackground.Gradient1EndPercent = 50
+      ButtonBackground.Style = bbsGradient
+      ButtonDownBackground.Color = clBtnShadow
+      ButtonDownBackground.Gradient1.StartColor = clWhite
+      ButtonDownBackground.Gradient1.EndColor = clBlack
+      ButtonDownBackground.Gradient1.GradientType = gtLinear
+      ButtonDownBackground.Gradient1.Point1XPercent = 0
+      ButtonDownBackground.Gradient1.Point1YPercent = 0
+      ButtonDownBackground.Gradient1.Point2XPercent = 0
+      ButtonDownBackground.Gradient1.Point2YPercent = 100
+      ButtonDownBackground.Gradient2.StartColor = clWhite
+      ButtonDownBackground.Gradient2.EndColor = clBlack
+      ButtonDownBackground.Gradient2.GradientType = gtLinear
+      ButtonDownBackground.Gradient2.Point1XPercent = 0
+      ButtonDownBackground.Gradient2.Point1YPercent = 0
+      ButtonDownBackground.Gradient2.Point2XPercent = 0
+      ButtonDownBackground.Gradient2.Point2YPercent = 100
+      ButtonDownBackground.Gradient1EndPercent = 35
+      ButtonDownBackground.Style = bbsColor
+      Border.Color = clWindowText
+      Border.Style = bboSolid
+      Rounding.RoundX = 1
+      Rounding.RoundY = 1
+      Font.Color = clWindowText
+      Font.Name = 'Arial'
+      HasTrackBar = True
+      ArrowColor = clBtnText
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 8
+      TabStop = True
+      UseDockManager = False
+    end
+    object TaperTypeCb: TComboBox
+      Left = 16
+      Height = 33
+      Hint = 'Determines the ''Taper'' of how the knob position '#13#10'relates to the value. '#13#10#13#10'kttLinear is typical of most controls except Audio'#13#10'kttAudioSlow 50% position around 10% of max value'#13#10'kttAudioFast 50% position around 15% of max value'#13#10#13#10'The range of the knob is unchanged just the curve'#13#10
+      Top = 221
+      Width = 182
+      ItemHeight = 25
+      Items.Strings = (
+        'kttLinear'
+        'kttAudioSlow'
+        'kttAudioFast'
+      )
+      ParentShowHint = False
+      ReadOnly = True
+      ShowHint = True
+      TabOrder = 9
+      Text = 'kptLineSquareCap'
+      OnChange = TaperTypeCbChange
+    end
+    object Label35: TLabel
+      Left = 16
+      Height = 25
+      Top = 197
+      Width = 84
+      Caption = 'Taper Type'
+    end
+    object PositionMarginTB: TBCTrackbarUpdown
+      Left = 200
+      Height = 34
+      Hint = 'Offset of Position indicator from Edge of Knob'
+      Top = 221
+      Width = 85
+      AllowNegativeValues = False
+      BarExponent = 1
+      Increment = 1
+      LongTimeInterval = 400
+      MinValue = 0
+      MaxValue = 255
+      OnChange = PositionMarginTBChange
+      Value = 5
+      ShortTimeInterval = 100
+      Background.Color = clWindow
+      Background.Gradient1.StartColor = clWhite
+      Background.Gradient1.EndColor = clBlack
+      Background.Gradient1.GradientType = gtLinear
+      Background.Gradient1.Point1XPercent = 0
+      Background.Gradient1.Point1YPercent = 0
+      Background.Gradient1.Point2XPercent = 0
+      Background.Gradient1.Point2YPercent = 100
+      Background.Gradient2.StartColor = clWhite
+      Background.Gradient2.EndColor = clBlack
+      Background.Gradient2.GradientType = gtLinear
+      Background.Gradient2.Point1XPercent = 0
+      Background.Gradient2.Point1YPercent = 0
+      Background.Gradient2.Point2XPercent = 0
+      Background.Gradient2.Point2YPercent = 100
+      Background.Gradient1EndPercent = 35
+      Background.Style = bbsColor
+      ButtonBackground.Gradient1.StartColor = clBtnShadow
+      ButtonBackground.Gradient1.EndColor = clBtnFace
+      ButtonBackground.Gradient1.GradientType = gtLinear
+      ButtonBackground.Gradient1.Point1XPercent = 0
+      ButtonBackground.Gradient1.Point1YPercent = -50
+      ButtonBackground.Gradient1.Point2XPercent = 0
+      ButtonBackground.Gradient1.Point2YPercent = 50
+      ButtonBackground.Gradient2.StartColor = clBtnFace
+      ButtonBackground.Gradient2.EndColor = clBtnShadow
+      ButtonBackground.Gradient2.GradientType = gtLinear
+      ButtonBackground.Gradient2.Point1XPercent = 0
+      ButtonBackground.Gradient2.Point1YPercent = 50
+      ButtonBackground.Gradient2.Point2XPercent = 0
+      ButtonBackground.Gradient2.Point2YPercent = 150
+      ButtonBackground.Gradient1EndPercent = 50
+      ButtonBackground.Style = bbsGradient
+      ButtonDownBackground.Color = clBtnShadow
+      ButtonDownBackground.Gradient1.StartColor = clWhite
+      ButtonDownBackground.Gradient1.EndColor = clBlack
+      ButtonDownBackground.Gradient1.GradientType = gtLinear
+      ButtonDownBackground.Gradient1.Point1XPercent = 0
+      ButtonDownBackground.Gradient1.Point1YPercent = 0
+      ButtonDownBackground.Gradient1.Point2XPercent = 0
+      ButtonDownBackground.Gradient1.Point2YPercent = 100
+      ButtonDownBackground.Gradient2.StartColor = clWhite
+      ButtonDownBackground.Gradient2.EndColor = clBlack
+      ButtonDownBackground.Gradient2.GradientType = gtLinear
+      ButtonDownBackground.Gradient2.Point1XPercent = 0
+      ButtonDownBackground.Gradient2.Point1YPercent = 0
+      ButtonDownBackground.Gradient2.Point2XPercent = 0
+      ButtonDownBackground.Gradient2.Point2YPercent = 100
+      ButtonDownBackground.Gradient1EndPercent = 35
+      ButtonDownBackground.Style = bbsColor
+      Border.Color = clWindowText
+      Border.Style = bboSolid
+      Rounding.RoundX = 1
+      Rounding.RoundY = 1
+      Font.Color = clWindowText
+      Font.Name = 'Arial'
+      HasTrackBar = True
+      ArrowColor = clBtnText
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 10
+      TabStop = True
+      UseDockManager = False
+    end
+    object Label33: TLabel
+      Left = 200
       Height = 25
-      Top = 128
-      Width = 214
-      Caption = 'No Effect in ktSector mode'
+      Hint = 'Set Position Width'
+      Top = 136
+      Width = 48
+      Caption = 'Width'
+      ParentShowHint = False
+      ShowHint = True
+    end
+    object Label38: TLabel
+      Left = 200
+      Height = 25
+      Hint = 'Set Position Width'
+      Top = 197
+      Width = 56
+      Caption = 'Margin'
+      ParentShowHint = False
+      ShowHint = True
     end
   end
   object DVAPGb: TGroupBox
-    Left = 640
-    Height = 456
+    Left = 632
+    Height = 480
     Top = 16
-    Width = 320
+    Width = 328
     Caption = 'Data Values and Properties'
-    ClientHeight = 426
-    ClientWidth = 316
+    ClientHeight = 450
+    ClientWidth = 324
     TabOrder = 2
     object ValueLbl: TLabel
       Left = 184
       Height = 25
-      Top = 54
+      Top = 69
       Width = 40
       Caption = '        '
     end
     object Label2: TLabel
       Left = 184
       Height = 25
-      Top = 78
+      Top = 93
       Width = 40
       Caption = '        '
     end
     object Label3: TLabel
       Left = 184
       Height = 25
-      Top = 126
+      Top = 141
       Width = 40
       Caption = '        '
     end
     object Label4: TLabel
       Left = 184
       Height = 25
-      Top = 150
+      Top = 165
       Width = 40
       Caption = '        '
     end
     object Label5: TLabel
       Left = 184
       Height = 25
-      Top = 174
+      Top = 189
       Width = 40
       Caption = '        '
     end
     object Label6: TLabel
       Left = 184
       Height = 25
-      Top = 198
+      Top = 213
       Width = 40
       Caption = '        '
     end
     object MouseWheelSpeedLbl: TLabel
       Left = 184
       Height = 25
-      Top = 104
+      Top = 119
       Width = 40
       Caption = '        '
     end
     object Label7: TLabel
       Left = 8
       Height = 25
-      Top = 54
+      Top = 69
       Width = 42
       Caption = 'Value'
     end
     object Label10: TLabel
       Left = 8
       Height = 25
-      Top = 78
+      Top = 93
       Width = 90
       Caption = 'WheelDelta'
     end
     object Label15: TLabel
       Left = 8
       Height = 25
-      Top = 104
+      Top = 119
       Width = 99
       Caption = 'WheelSpeed'
     end
     object Label16: TLabel
       Left = 8
       Height = 25
-      Top = 126
+      Top = 141
       Width = 60
       Caption = 'OnClick'
     end
     object Label17: TLabel
       Left = 8
       Height = 25
-      Top = 150
+      Top = 165
       Width = 88
       Caption = 'OnDblClick'
     end
     object Label18: TLabel
       Left = 8
       Height = 25
-      Top = 174
+      Top = 189
       Width = 136
       Caption = 'Mouse Up/Down'
     end
     object Label19: TLabel
       Left = 8
       Height = 25
-      Top = 198
+      Top = 213
       Width = 150
       Caption = 'Mouse Enter/Leave'
     end
     object Label20: TLabel
       Left = 8
       Height = 25
-      Top = 222
+      Top = 237
       Width = 72
       Caption = 'MinValue'
     end
     object Label21: TLabel
       Left = 8
       Height = 25
-      Top = 246
+      Top = 261
       Width = 75
       Caption = 'MaxValue'
     end
     object MinValueLbl: TLabel
       Left = 184
       Height = 25
-      Top = 222
+      Top = 237
       Width = 72
       Caption = 'MinValue'
     end
     object MaxValueLbl: TLabel
       Left = 184
       Height = 25
-      Top = 246
+      Top = 261
       Width = 75
       Caption = 'MaxValue'
     end
     object Label24: TLabel
       Left = 8
       Height = 25
-      Top = 270
+      Top = 285
       Width = 82
       Caption = 'StartAngle'
     end
     object Label25: TLabel
       Left = 8
       Height = 25
-      Top = 294
+      Top = 309
       Width = 76
       Caption = 'EndAngle'
     end
     object StartAngleLbl: TLabel
       Left = 184
       Height = 25
-      Top = 270
+      Top = 285
       Width = 82
       Caption = 'StartAngle'
     end
     object EndAngleLbl: TLabel
       Left = 184
       Height = 25
-      Top = 294
+      Top = 309
       Width = 76
       Caption = 'EndAngle'
     end
     object CDVDBtn: TBitBtn
-      Left = 16
-      Height = 45
-      Top = 371
+      Left = 18
+      Height = 37
+      Top = 403
       Width = 266
       Caption = 'Clear Data Values Display'
       Glyph.Data = {
@@ -1009,39 +1243,95 @@ object Form1: TForm1
     object Label8: TLabel
       Left = 184
       Height = 25
-      Top = 32
+      Top = 47
       Width = 40
       Caption = '        '
     end
     object Label28: TLabel
       Left = 8
       Height = 25
-      Top = 32
+      Top = 47
       Width = 80
       Caption = 'MouseXY '
     end
     object Label1: TLabel
       Left = 8
       Height = 25
-      Top = 10
+      Top = 0
       Width = 79
       Caption = 'KnobType'
     end
     object KnobTypeLbl: TLabel
       Left = 184
       Height = 25
-      Top = 10
+      Top = 0
       Width = 40
       Caption = '        '
     end
+    object Label34: TLabel
+      Left = 8
+      Height = 25
+      Top = 332
+      Width = 105
+      Caption = 'Position Type'
+    end
+    object PositionWidthLbl: TLabel
+      Left = 184
+      Height = 25
+      Top = 352
+      Width = 111
+      Caption = 'PositionWidth'
+    end
+    object Label36: TLabel
+      Left = 8
+      Height = 25
+      Top = 25
+      Width = 84
+      Caption = 'Taper Type'
+    end
+    object TaperTypeLbl: TLabel
+      Left = 184
+      Height = 25
+      Top = 25
+      Width = 40
+      Caption = '        '
+    end
+    object Label37: TLabel
+      Left = 8
+      Height = 25
+      Top = 352
+      Width = 116
+      Caption = 'Position Width'
+    end
+    object PositionTypeLbl: TLabel
+      Left = 184
+      Height = 25
+      Top = 332
+      Width = 100
+      Caption = 'PositionType'
+    end
+    object Label39: TLabel
+      Left = 8
+      Height = 25
+      Top = 374
+      Width = 124
+      Caption = 'Position Margin'
+    end
+    object PositionMarginLbl: TLabel
+      Left = 184
+      Height = 25
+      Top = 374
+      Width = 119
+      Caption = 'PositionMargin'
+    end
   end
   object RangesGb: TGroupBox
     Left = 968
-    Height = 456
+    Height = 248
     Top = 16
     Width = 288
     Caption = 'Ranges'
-    ClientHeight = 426
+    ClientHeight = 218
     ClientWidth = 284
     ParentBackground = False
     ParentColor = False
@@ -1455,9 +1745,9 @@ object Form1: TForm1
       ParentShowHint = False
     end
     object ResetRangesBtn1: TBitBtn
-      Left = 3
+      Left = 8
       Height = 45
-      Top = 371
+      Top = 160
       Width = 272
       Caption = 'Update All Range Value'
       Glyph.Data = {
@@ -1549,12 +1839,109 @@ object Form1: TForm1
     Font.Style = [fsBold]
     ParentFont = False
   end
-  object Label26: TLabel
+  object KnobVerLbl: TLabel
     Left = 16
     Height = 25
-    Top = 448
-    Width = 68
-    Caption = 'Test v2.0'
+    Top = 456
+    Width = 129
+    Caption = 'KnobVersion 0.0'
+  end
+  object GroupBox2: TGroupBox
+    Left = 968
+    Height = 200
+    Top = 280
+    Width = 288
+    Caption = 'More Visual'
+    ClientHeight = 170
+    ClientWidth = 284
+    TabOrder = 4
+    object KnobColorLbl: TLabel
+      Left = 8
+      Height = 25
+      Top = 1
+      Width = 90
+      Caption = 'Knob Color'
+    end
+    object PositionColorLbl: TLabel
+      Left = 8
+      Height = 25
+      Top = 33
+      Width = 111
+      Caption = 'Position Color'
+    end
+    object PositionColorCb: TColorBox
+      Left = 123
+      Height = 26
+      Hint = 'Frame Border Color'
+      Top = 32
+      Width = 157
+      Style = [cbStandardColors, cbExtendedColors, cbCustomColor]
+      ItemHeight = 20
+      OnChange = PositionColorCbChange
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 0
+    end
+    object KnobColorCb: TColorBox
+      Left = 123
+      Height = 26
+      Hint = 'Frame Color'
+      Top = 1
+      Width = 157
+      Style = [cbStandardColors, cbExtendedColors, cbCustomColor]
+      ItemHeight = 20
+      OnChange = KnobColorCbChange
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 1
+    end
+    object CurveExponentSpe: TFloatSpinEditEx
+      Left = 183
+      Height = 33
+      Hint = 'Shader Curve, Typically for Phong shader'
+      Top = 104
+      Width = 97
+      MaxLength = 0
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 2
+      OnChange = CurveExponentSpeChange
+      Increment = 0.01
+      MaxValue = 10
+      MinValue = -10
+      MinRepeatValue = 10
+    end
+    object CurveExponentLbl: TLabel
+      Left = 8
+      Height = 25
+      Top = 112
+      Width = 124
+      Caption = 'Curve Exponent'
+    end
+    object LightIntensitySpe: TSpinEditEx
+      Left = 183
+      Height = 33
+      Hint = 'Light Intensity of the Shader'
+      Top = 64
+      Width = 97
+      MaxLength = 0
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 3
+      OnChange = LightIntensitySpeChange
+      MaxValue = 1000
+      MinValue = -1000
+      MinRepeatValue = 10
+      NullValue = 0
+      Value = 0
+    end
+    object LightIntensityLbl: TLabel
+      Left = 8
+      Height = 25
+      Top = 72
+      Width = 111
+      Caption = 'Light Intensity'
+    end
   end
   object Timer1: TTimer
     Interval = 3000

test/test_bgraknob/unit1.pas

@@ -5,6 +5,7 @@ unit Unit1;
 {
   v1.0 05-21-2024 Sandy Ganz - Begat. [email protected]
   v2.0 05-26-2024 Sandy Ganz - Removed SectorDivision stuff, Knob now computes it.
+  v3.0 12-30-2024 Sandy Ganz - Added options for Audio taper, color settings, etc.
 
   Hacked up test progam to test the enhanced BGRAKnob.
 }
@@ -13,7 +14,7 @@ interface
 
 uses
   Classes, LCLType, SysUtils, Forms, Controls, Graphics, StdCtrls, Buttons, MaskEdit,
-  ExtCtrls, BGRAKnob, BCTrackbarUpdown;
+  ExtCtrls, ColorBox, SpinEx, BGRAKnob, BCTrackbarUpdown;
 
 type
 
@@ -21,9 +22,34 @@ type
 
   TForm1 = class(TForm)
     BitBtn1: TBitBtn;
+    CurveExponentLbl: TLabel;
+    CurveExponentSpe: TFloatSpinEditEx;
+    Label33: TLabel;
+    Label38: TLabel;
+    Label39: TLabel;
+    LightIntensityLbl: TLabel;
+    LightIntensitySpe: TSpinEditEx;
+    PositionColorCb: TColorBox;
+    PositionColorLbl: TLabel;
+    KnobColorCb: TColorBox;
+    KnobColorLbl: TLabel;
+    GroupBox2: TGroupBox;
+    Label37: TLabel;
+    PositionTypeLbl: TLabel;
+    PositionMarginTB: TBCTrackbarUpdown;
+    PositionMarginLbl: TLabel;
+    TaperTypeLbl: TLabel;
+    Label35: TLabel;
+    Label36: TLabel;
+    TaperTypeCb: TComboBox;
+    PositionWidthLbl: TLabel;
+    Label27: TLabel;
+    Label34: TLabel;
+    PositionWidthTB: TBCTrackbarUpdown;
+    PositionTypeCb: TComboBox;
     Label22: TLabel;
     Label23: TLabel;
-    Label26: TLabel;
+    KnobVerLbl: TLabel;
     Label9: TLabel;
     MouseWheelWrapCb: TCheckBox;
     ReverseScaleCb: TCheckBox;
@@ -97,9 +123,15 @@ type
     Timer1: TTimer;
 
     procedure BitBtn1Click(Sender: TObject);
+    procedure CurveExponentSpeChange(Sender: TObject);
+    procedure KnobColorCbChange(Sender: TObject);
     function KnobTypeToStr(kt : TKnobType) : string;
+    function KnobTaperTypeToStr(ktt : TKnobTaperType) : string;
+    function KnobPositionTypeToStr(kpt : TBGRAKnobPositionType) : string;
+
     procedure EndAngleEdtKeyDown(Sender: TObject; var Key: Word;
       {%H-}Shift: TShiftState);
+    procedure LightIntensitySpeChange(Sender: TObject);
     procedure MaxValueEdtKeyDown(Sender: TObject; var Key: Word;
       {%H-}Shift: TShiftState);
     procedure MinValueEdtKeyDown(Sender: TObject; var Key: Word;
@@ -120,6 +152,10 @@ type
     procedure BGRAKnob1ValueChanged(Sender: TObject; Value: single);
     procedure CDVDBtnClick(Sender: TObject);
     procedure MouseWheelWrapCbChange(Sender: TObject);
+    procedure PositionColorCbChange(Sender: TObject);
+    procedure PositionMarginTBChange(Sender: TObject; AByUser: boolean);
+    procedure PositionTypeCbChange(Sender: TObject);
+    procedure PositionWidthTBChange(Sender: TObject; AByUser: boolean);
     procedure ResetRangesBtn1Click(Sender: TObject);
     procedure ReverseScaleCbChange(Sender: TObject);
     procedure Set1000BtnClick(Sender: TObject);
@@ -145,6 +181,7 @@ type
     procedure SetMinValueBtnClick(Sender: TObject);
     procedure SetStartAngleBtnClick(Sender: TObject);
     procedure SetValueBtnClick(Sender: TObject);
+    procedure TaperTypeCbChange(Sender: TObject);
     procedure Timer1Timer(Sender: TObject);
     procedure ValueEdtKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
   private
@@ -153,6 +190,9 @@ type
 
   end;
 
+  Const
+    VERSIONSTR = 'v3.0';
+
 var
   Form1: TForm1;
 
@@ -164,6 +204,8 @@ implementation
 
 procedure TForm1.FormCreate(Sender: TObject);
 begin
+  Caption := 'BGRAKnob Test ' + VERSIONSTR;
+
   ValueLbl.Caption := FloatToStr(BGRAKnob1.Value);
   MinValueLbl.Caption := FloatToStr(BGRAKnob1.MinValue);
   MinValueEdt.Text := MinValueLbl.Caption;
@@ -179,24 +221,76 @@ begin
   MouseWheelSpeedLbl.Caption := IntToStr(MouseWheelSpeedTB.Value);
 
   KnobTypeLbl.Caption := KnobTypeToStr(BGRAKnob1.KnobType);
-
+  PositionTypeLbl.Caption := KnobPositionTypeToStr(BGRAKnob1.PositionType);
+  PositionTypeCb.ItemIndex := ord(BGRAKnob1.PositionType);
+  TaperTypeLbl.Caption := KnobTaperTypeToStr(BGRAKnob1.TaperType);
+  TaperTypeCb.ItemIndex := ord(BGRAKnob1.TaperType);
+  PositionWidthTB.Value := Round(BGRAKnob1.PositionWidth);
+  PositionWidthLbl.Caption := FloatToStr(BGRAKnob1.PositionWidth);
+  PositionMarginTB.Value := Round(BGRAKnob1.PositionMargin);
+  PositionMarginLbl.Caption := FloatToStr(BGRAKnob1.PositionMargin);
+  KnobColorCb.Selected := BGRAKnob1.KnobColor;
+  PositionColorCb.Selected := BGRAKnob1.PositionColor;
+  LightIntensitySpe.Value := BGRAKnob1.LightIntensity;
+  CurveExponentSpe.Value := BGRAKnob1.CurveExponent;
+
+  KnobVerLbl.Caption := 'BGRAKnob ' + BGRAKnob.VERSIONSTR;
 end;
 
 function TForm1.KnobTypeToStr(kt : TKnobType) : string;
 begin
   case kt of
      ktRange   : Result := 'ktRange';
-     ktSector  : Result := 'ktRange';
+     ktSector  : Result := 'ktSector';
   else
      Result := 'UNKNOWN';
   end;
 end;
 
+function TForm1.KnobTaperTypeToStr(ktt : TKnobTaperType) : string;
+begin
+   // kttLinear, kttAudioSlow, kttAudioFast
+
+   case ktt of
+      kttLinear : Result := 'kttLinear';
+      kttAudioSlow : Result := 'kttAudioSlow';
+      kttAudioFast : Result :='kttAudioFast';
+   else
+      Result := 'UNKNOWN';
+  end;
+end;
+
+function TForm1.KnobPositionTypeToStr(kpt : TBGRAKnobPositionType) : string;
+begin
+   // kptLineSquareCap, kptLineRoundCap, kptFilledCircle, kptHollowCircle, kptNone
+
+   case kpt of
+      kptLineSquareCap : Result := 'kptLineSquareCap';
+      kptLineRoundCap : Result := 'kptLineRoundCap';
+      kptFilledCircle : Result :='kptFilledCircle';
+      kptHollowCircle : Result :='kptHollowCircle';
+      kptNone : Result :='kptNone';
+   else
+      Result := 'UNKNOWN';
+  end;
+end;
+
+
 procedure TForm1.BitBtn1Click(Sender: TObject);
 begin
     ValueLbl.Caption:=FloatToStr(BGRAKnob1.Value);
 end;
 
+procedure TForm1.CurveExponentSpeChange(Sender: TObject);
+begin
+    BGRAKnob1.CurveExponent := CurveExponentSpe.Value;
+end;
+
+procedure TForm1.KnobColorCbChange(Sender: TObject);
+begin
+    BGRAKnob1.KnobColor := KnobColorCb.Selected;
+end;
+
 procedure TForm1.BGRAKnob1ValueChanged(Sender: TObject; Value: single);
 begin
   ValueLbl.Caption:=FloatToStr(Value);
@@ -205,6 +299,8 @@ end;
 
 procedure TForm1.CDVDBtnClick(Sender: TObject);
 begin
+  // just clear some of the data values
+
   ValueLbl.Caption := '';
   label2.Caption := '';
   label3.Caption := '';
@@ -212,11 +308,6 @@ begin
   label5.Caption := '';
   label6.Caption := '';
   label8.Caption := '';
-  MouseWheelSpeedLbl.Caption := '';
-  MinValueLbl.Caption := '';
-  MaxValueLbl.Caption := '';
-  StartAngleLbl.Caption := '';
-  EndAngleLbl.Caption := '';
 end;
 
 procedure TForm1.MouseWheelWrapCbChange(Sender: TObject);
@@ -224,6 +315,62 @@ begin
   BGRAKnob1.WheelWrap := MouseWheelWrapCb.Checked;
 end;
 
+procedure TForm1.PositionColorCbChange(Sender: TObject);
+begin
+  BGRAKnob1.PositionColor := PositionColorCb.Selected;
+end;
+
+procedure TForm1.PositionMarginTBChange(Sender: TObject; AByUser: boolean);
+begin
+  if AByUser then
+  begin
+    BGRAKnob1.PositionMargin := PositionMarginTB.Value;
+    PositionMarginLbl.Caption := FloatToStr(BGRAKnob1.PositionMargin);
+  end;
+end;
+
+procedure TForm1.PositionTypeCbChange(Sender: TObject);
+begin
+  if Sender is TComboBox then
+    with Sender as TComboBox do
+    begin
+         // kptLineSquareCap, kptLineRoundCap, kptFilledCircle, kptHollowCircle, kptNone
+
+         case ItemIndex of
+            0 : begin
+                  // kptLineSquareCap
+                  BGRAKnob1.PositionType := kptLineSquareCap;
+                end;
+            1 : begin
+                  // kptLineRoundCap
+                  BGRAKnob1.PositionType := kptLineRoundCap;
+                end;
+            2 : begin
+                  // kptFilledCircle
+                  BGRAKnob1.PositionType := kptFilledCircle;
+                end;
+            3 : begin
+                  // kptHollowCircle
+                  BGRAKnob1.PositionType := kptHollowCircle;
+                end;
+            4 : begin
+                  // kptNone
+                  BGRAKnob1.PositionType := kptNone;
+                end;
+         end;
+    end;
+    PositionTypeLbl.Caption := KnobPositionTypeToStr(BGRAKnob1.PositionType);
+end;
+
+procedure TForm1.PositionWidthTBChange(Sender: TObject; AByUser: boolean);
+begin
+  if AByUser then // not sure why this is needed but segfault if not
+  begin
+    BGRAKnob1.PositionWidth := PositionWidthTB.Value;
+    PositionWidthLbl.Caption := IntToStr(Round(BGRAKnob1.PositionWidth));
+  end;
+end;
+
 procedure TForm1.StartFromBottomCbChange(Sender: TObject);
 begin
   BGRAKnob1.StartFromBottom := StartFromBottomCb.Checked;
@@ -252,13 +399,26 @@ begin
   BGRAKnob1.StartFromBottom := True;          // Normal Orientation
   StartFromBottomCb.Checked := True;
   MouseWheelSpeedTB.Value := 100;
-  KnobTypeCb.ItemIndex := 0; // ktRange type of knob
-  BGRAKnob1.KnobType:= ktRange;
+  BGRAKnob1.PositionWidth := 4;
+  PositionWidthTB.Value := Round(BGRAKnob1.PositionWidth);
+  BGRAKnob1.PositionMargin := 4;
+  PositionMarginTB.Value := Round(BGRAKnob1.PositionMargin);
+  BGRAKnob1.KnobType := ktRange;
+  KnobTypeCb.ItemIndex := ord(BGRAKnob1.KnobType);
+  BGRAKnob1.TaperType := kttLinear;
+  TaperTypeCb.ItemIndex := ord(BGRAKnob1.TaperType);
+  BGRAKnob1.PositionType := kptLineRoundCap;
+  PositionTypeCb.ItemIndex := ord(BGRAKnob1.PositionType);
   MinValueLbl.Caption := FloatToStr(BGRAKnob1.MinValue);
   MaxValueLbl.Caption := FloatToStr(BGRAKnob1.MaxValue);
   StartAngleLbl.Caption := FloatToStr(BGRAKnob1.StartAngle);
   EndAngleLbl.Caption := FloatToStr(BGRAKnob1.EndAngle);
   KnobTypeLbl.Caption := KnobTypeToStr(BGRAKnob1.KnobType);
+  PositionWidthLbl.Caption := FloatToStr(BGRAKnob1.PositionWidth);
+  LightIntensitySpe.Value := 300;
+  CurveExponentSpe.Value := 0.2;
+  KnobColorCb.Selected := clSilver;
+  PositionColorCb.Selected := clBlack;
 end;
 
 procedure TForm1.StartAngleEdtKeyDown(Sender: TObject; var Key: Word;
@@ -404,6 +564,31 @@ begin
   ValueLbl.Caption := FloatToStr(BGRAKnob1.Value);
 end;
 
+procedure TForm1.TaperTypeCbChange(Sender: TObject);
+begin
+    if Sender is TComboBox then
+    with Sender as TComboBox do
+    begin
+         // kttLinear, kttAudioSlow, kttAudioFast;
+         case ItemIndex of
+            0 : begin
+                  // kttLinear
+                  BGRAKnob1.TaperType := kttLinear;
+                end;
+            1 : begin
+                  // kttAudioSlow
+                  BGRAKnob1.TaperType := kttAudioSlow;
+                end;
+            2 : begin
+                  // kttAudioFast
+                  BGRAKnob1.TaperType:= kttAudioFast;
+                end;
+         end;
+    end;
+    TaperTypeLbl.Caption := KnobTaperTypeToStr(BGRAKnob1.TaperType);
+    ValueLbl.Caption:=FloatToStr(BGRAKnob1.Value); // update just in case!
+end;
+
 procedure TForm1.Timer1Timer(Sender: TObject);
 begin
   // When the timer fires (after leaving knob area) clear stuff out
@@ -460,6 +645,11 @@ begin
     SetEndAngleBtnClick(nil);
 end;
 
+procedure TForm1.LightIntensitySpeChange(Sender: TObject);
+begin
+  BGRAKnob1.LightIntensity := LightIntensitySpe.Value;
+end;
+
 procedure TForm1.BGRAKnob1DblClick(Sender: TObject);
 begin
   label4.Caption := 'DoubleClick';
@@ -474,14 +664,12 @@ end;
 procedure TForm1.BGRAKnob1MouseEnter(Sender: TObject);
 begin
   label6.Caption := 'MouseEnter';
-  BGRAKnob1.KnobColor:=clSilver;
   Timer1.Enabled := False; // While in the knob, turn off the reset timer
 end;
 
 procedure TForm1.BGRAKnob1MouseLeave(Sender: TObject);
 begin
   label6.Caption := 'MouseLeave';
-  BGRAKnob1.KnobColor:=clMedGray;
   Timer1.Enabled := True;  // mouse leaves the knob space, turn on reset timer
 end;