Browse Source

Merge pull request #205 from sganz/dev-bgracontrols

Added background color to gauge, Face Paint Fixes
Leandro Oscar Ezequiel Diaz 11 months ago
parent
commit
4b3d1dadfd

+ 1 - 1
bgracontrols.lpk

@@ -21,7 +21,7 @@
       </Parsing>
       </Parsing>
       <CodeGeneration>
       <CodeGeneration>
         <Optimizations>
         <Optimizations>
-          <OptimizationLevel Value="0"/>
+          <OptimizationLevel Value="2"/>
           <VariablesInRegisters Value="True"/>
           <VariablesInRegisters Value="True"/>
         </Optimizations>
         </Optimizations>
       </CodeGeneration>
       </CodeGeneration>

+ 89 - 20
supergauge.pas

@@ -30,7 +30,7 @@ uses
 const
 const
   INTERNAL_GAUGE_MIN_VALUE = 0;   // internal lowest value
   INTERNAL_GAUGE_MIN_VALUE = 0;   // internal lowest value
   INTERNAL_GAUGE_MAX_VALUE = 270; // internal highest value
   INTERNAL_GAUGE_MAX_VALUE = 270; // internal highest value
-  VERSIONSTR = '1.01';            // SG version, Should ALWAYS show as a delta when merging!
+  VERSIONSTR = '1.02';            // SG version, Should ALWAYS show as a delta when merging!
 
 
 type
 type
 
 
@@ -217,8 +217,10 @@ type
     property BackInRange;
     property BackInRange;
     property RangeLEDActive;
     property RangeLEDActive;
     property RangeLEDInactive;
     property RangeLEDInactive;
+    property Color default clNone;
 
 
     // Added missing events
     // Added missing events
+
     property Anchors;
     property Anchors;
     property OnClick;
     property OnClick;
     property OnDblClick;
     property OnDblClick;
@@ -336,7 +338,7 @@ begin
   FAutoScale := false;
   FAutoScale := false;
   FMinValue := 0;
   FMinValue := 0;
   FMaxValue := 100;
   FMaxValue := 100;
-
+  Color := clNone;
   FDirty := True;   // Always force initial paint/draw on everything!
   FDirty := True;   // Always force initial paint/draw on everything!
 end;
 end;
 
 
@@ -910,8 +912,16 @@ begin
   // subcomponent is not changed, the DrawXXXX will just leave it as is
   // subcomponent is not changed, the DrawXXXX will just leave it as is
   // and not waste cycles to redraw it.
   // and not waste cycles to redraw it.
 
 
-  FGaugeBitmap.Fill(BGRA(0, 0, 0, 0));
   FGaugeBitmap.SetSize(Width, Height);
   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;
   gaugeCenX := FGaugeBitmap.Width div 2;
   gaugeCenY := FGaugeBitmap.Height div 2;
   gaugeCenY := FGaugeBitmap.Height div 2;
 
 
@@ -1042,11 +1052,17 @@ end;
 procedure TSGCustomSuperGauge.DrawFace;
 procedure TSGCustomSuperGauge.DrawFace;
 var
 var
   OriginFace: TSGOrigin;
   OriginFace: TSGOrigin;
-  r: integer;
-  image: TBGRABitmap;
+  r, d: integer;
+  xb, yb: integer;
+  d2, h: single;
+  Center: TPointF;
+  v: TPointF;
+  p: PBGRAPixel;
+  Image: TBGRABitmap;
+  Mask: TBGRABitmap;
+  Map: TBGRABitmap;
 
 
 begin
 begin
-
   if not FaceSettings.Dirty then
   if not FaceSettings.Dirty then
     Exit;
     Exit;
 
 
@@ -1058,15 +1074,72 @@ begin
 
 
   r := round(OriginFace.Radius * 0.95) - 5;
   r := round(OriginFace.Radius * 0.95) - 5;
 
 
+  // Fill types : fsNone, fsGradient, fsFlat, fsPhong
+
   case FFaceSettings.FillStyle of
   case FFaceSettings.FillStyle of
     fsGradient:
     fsGradient:
-      FFaceBitmap.FillEllipseLinearColorAntialias(OriginFace.CenterPoint.x,
-        OriginFace.CenterPoint.y, r, r, FFaceSettings.OuterColor,
-        FFaceSettings.InnerColor);
+      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;
 
 
-    fsNone:
-      FFaceBitmap.FillEllipseAntialias(OriginFace.CenterPoint.x, OriginFace.CenterPoint.y,
-        r, r, FFaceSettings.OuterColor);
+    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;
   end;
 
 
   // see if valid size and enabled, draw if so!
   // see if valid size and enabled, draw if so!
@@ -1074,13 +1147,13 @@ begin
   if ((FaceSettings.Picture.Width > 0) or (FaceSettings.Picture.Height > 0)) and (FFaceSettings.PictureEnabled) then
   if ((FaceSettings.Picture.Width > 0) or (FaceSettings.Picture.Height > 0)) and (FFaceSettings.PictureEnabled) then
   begin
   begin
 
 
-    image := TBGRABitmap.Create(FaceSettings.Picture.Bitmap);
+    Image := TBGRABitmap.Create(FaceSettings.Picture.Bitmap);
     FFaceBitmap.BlendImage(
     FFaceBitmap.BlendImage(
                 OriginFace.CenterPoint.X + FaceSettings.PictureOffsetX,
                 OriginFace.CenterPoint.X + FaceSettings.PictureOffsetX,
                 OriginFace.CenterPoint.y + FaceSettings.PictureOffsetY,
                 OriginFace.CenterPoint.y + FaceSettings.PictureOffsetY,
                 image,
                 image,
                 boLinearBlend);
                 boLinearBlend);
-    image.Free; // needed!
+    Image.Free; // needed!
   end;
   end;
 end;
 end;
 
 
@@ -1672,7 +1745,6 @@ begin
               p := map.ScanLine[yb];
               p := map.ScanLine[yb];
               for xb := 0 to tx - 1 do
               for xb := 0 to tx - 1 do
               begin
               begin
-
                 //compute vector between center and current pixel
                 //compute vector between center and current pixel
 
 
                 v := PointF(xb, yb) - Center;
                 v := PointF(xb, yb) - Center;
@@ -1687,6 +1759,7 @@ begin
                 d2 := v {$if FPC_FULLVERSION < 30203}*{$ELSE}**{$ENDIF} v;
                 d2 := v {$if FPC_FULLVERSION < 30203}*{$ELSE}**{$ENDIF} v;
 
 
                 //interpolate as quadratic curve and apply power function
                 //interpolate as quadratic curve and apply power function
+
                 if d2 > 1 then
                 if d2 > 1 then
                   h := 0
                   h := 0
                 else
                 else
@@ -1703,9 +1776,7 @@ begin
             map.ApplyMask(mask);
             map.ApplyMask(mask);
             Mask.Free;
             Mask.Free;
 
 
-            // now draw on the pointer bitmap, not sure if this is going to work since
-            // it's the pointer not just thje cap, mayh need to do a different
-            // bitmap and overlay, or how the needle will look????
+            // now draw
 
 
             PointerCapSettings.FPhong.Draw(FPointerCapBitmap, Map, 30,
             PointerCapSettings.FPhong.Draw(FPointerCapBitmap, Map, 30,
                     origin.CenterPoint.x - tx div 2, origin.CenterPoint.y - ty div 2,
                     origin.CenterPoint.x - tx div 2, origin.CenterPoint.y - ty div 2,
@@ -1746,8 +1817,6 @@ begin
       end;
       end;
 end;
 end;
 
 
-// Pass in the FRangeLEDSettings with the index or the entire array??
-
 procedure TSGCustomSuperGauge.DrawLed;
 procedure TSGCustomSuperGauge.DrawLed;
 var
 var
   Origin: TSGOrigin;
   Origin: TSGOrigin;

+ 48 - 4
supergaugecommon.pas

@@ -28,16 +28,16 @@ uses
   BGRABitmap, BGRABitmapTypes, BGRAGradients, BCTypes;
   BGRABitmap, BGRABitmapTypes, BGRAGradients, BCTypes;
 
 
 type
 type
-  TSGFillStyle = (fsNone, fsGradient{, fsTexture}); // Add more if needed here
+  TSGFillStyle = (fsNone, fsGradient, fsFlat, fsPhong);   // Add more if needed here
   TSGPointerStyle = (psLine, psLineExt, psArc , psTriangle {, psTriangleLine, psTriangleLineExt}); // Todo : Add others at some point
   TSGPointerStyle = (psLine, psLineExt, psArc , psTriangle {, psTriangleLine, psTriangleLineExt}); // Todo : Add others at some point
   TSGLEDStyle = (lsNone, lsFlat, lsShaded);
   TSGLEDStyle = (lsNone, lsFlat, lsShaded);
   TSGLEDShape = (lshRound, lshSquare, lshTriangle, lshDownTriangle);
   TSGLEDShape = (lshRound, lshSquare, lshTriangle, lshDownTriangle);
   TSGPointerCapPosition = (cpUnder, cpOver);
   TSGPointerCapPosition = (cpUnder, cpOver);
   TSGCapStyle = (csNone, csFlat, csShaded, csPhong);
   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
+  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,
   TSGRangeCheckType = (rcNone, rcGaugeOutOfRange, rcBetween, rcBothInclusive, rcStartInclusive,
                       rcEndInclusive, rcBothBetweenOutside, rcBothInclusiveOutside,
                       rcEndInclusive, rcBothBetweenOutside, rcBothInclusiveOutside,
-                      rcGreaterStart, rcLessEnd); // added for range check led, see code for details
+                      rcGreaterStart, rcLessEnd);   // added for range check led, see code for details
   TSGMarkerStyle = (msCenter, msLeft, msRight);
   TSGMarkerStyle = (msCenter, msLeft, msRight);
 
 
   { TSGOrigin }
   { TSGOrigin }
@@ -279,6 +279,7 @@ type
     FPicture: TPicture;
     FPicture: TPicture;
     FPictureEnabled: boolean;
     FPictureEnabled: boolean;
     FPictureOffsetX, FPictureOffsetY: integer;
     FPictureOffsetX, FPictureOffsetY: integer;
+    FCurveExponent: single;
     FOnChange: TNotifyEvent;
     FOnChange: TNotifyEvent;
     FDirty: boolean;
     FDirty: boolean;
 
 
@@ -289,11 +290,16 @@ type
     procedure SetPictureEnabled(AValue: boolean);
     procedure SetPictureEnabled(AValue: boolean);
     procedure SetPictureOffsetX(AValue: integer);
     procedure SetPictureOffsetX(AValue: integer);
     procedure SetPictureOffsetY(AValue: integer);
     procedure SetPictureOffsetY(AValue: integer);
+    procedure SetLightIntensity(const AValue: integer);
+    function GetLightIntensity: integer;
+    procedure SetCurveExponent(const AValue: single);
 
 
     procedure SetOnChange(AValue: TNotifyEvent);
     procedure SetOnChange(AValue: TNotifyEvent);
     procedure DirtyOnChange;
     procedure DirtyOnChange;
   protected
   protected
   public
   public
+    FPhong: TPhongShading;
+
     constructor Create;
     constructor Create;
     destructor Destroy; override;
     destructor Destroy; override;
     property OnChange: TNotifyEvent read FOnChange write SetOnChange;
     property OnChange: TNotifyEvent read FOnChange write SetOnChange;
@@ -307,6 +313,8 @@ type
     property PictureEnabled: boolean read FPictureEnabled write SetPictureEnabled;
     property PictureEnabled: boolean read FPictureEnabled write SetPictureEnabled;
     property PictureOffsetX: integer read FPictureOffsetX write SetPictureOffsetX default 0;
     property PictureOffsetX: integer read FPictureOffsetX write SetPictureOffsetX default 0;
     property PictureOffsetY: integer read FPictureOffsetY write SetPictureOffsetY 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;
   end;
 
 
   { TSGFrameSettings }
   { TSGFrameSettings }
@@ -612,12 +620,12 @@ begin
   // create a phong shader, will need to delete on clean up
   // create a phong shader, will need to delete on clean up
 
 
   FPhong := TPhongShading.Create;
   FPhong := TPhongShading.Create;
-
   FPhong.LightPositionZ := 100;
   FPhong.LightPositionZ := 100;
   FPhong.LightSourceIntensity := 300;
   FPhong.LightSourceIntensity := 300;
   FPhong.NegativeDiffusionFactor := 0.8;
   FPhong.NegativeDiffusionFactor := 0.8;
   FPhong.AmbientFactor := 0.5;
   FPhong.AmbientFactor := 0.5;
   FPhong.DiffusionFactor := 0.6;
   FPhong.DiffusionFactor := 0.6;
+
   FCurveExponent := 0.05;
   FCurveExponent := 0.05;
   FCapStyle := csPhong;
   FCapStyle := csPhong;
   FCapPosition := cpUnder;
   FCapPosition := cpUnder;
@@ -1127,6 +1135,17 @@ end;
 
 
 constructor TSGFaceSettings.Create;
 constructor TSGFaceSettings.Create;
 begin
 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;
   FOuterColor := clBlack;
   FInnerColor := clGray;
   FInnerColor := clGray;
   FFillStyle := fsGradient;
   FFillStyle := fsGradient;
@@ -1140,7 +1159,9 @@ end;
 
 
 destructor TSGFaceSettings.Destroy;
 destructor TSGFaceSettings.Destroy;
 begin
 begin
+  FPhong.Free;
   FPicture.Free;
   FPicture.Free;
+
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
@@ -1208,6 +1229,29 @@ begin
   DirtyOnChange;
   DirtyOnChange;
 end;
 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);
 procedure TSGFaceSettings.SetOnChange(AValue: TNotifyEvent);
 begin
 begin
   FOnChange := AValue;
   FOnChange := AValue;

+ 2 - 0
test/test_supergauge/about.lfm

@@ -7,6 +7,7 @@ object AboutFrm: TAboutFrm
   Caption = 'About Super Gauge'
   Caption = 'About Super Gauge'
   ClientHeight = 653
   ClientHeight = 653
   ClientWidth = 615
   ClientWidth = 615
+  Color = clSkyBlue
   DesignTimePPI = 144
   DesignTimePPI = 144
   FormStyle = fsStayOnTop
   FormStyle = fsStayOnTop
   Icon.Data = {
   Icon.Data = {
@@ -100,6 +101,7 @@ object AboutFrm: TAboutFrm
     Align = alBottom
     Align = alBottom
     ClientHeight = 53
     ClientHeight = 53
     ClientWidth = 615
     ClientWidth = 615
+    ParentBackground = False
     TabOrder = 1
     TabOrder = 1
     object CloseBtn: TBitBtn
     object CloseBtn: TBitBtn
       Left = 480
       Left = 480

+ 1 - 0
test/test_supergauge/project1.lpi

@@ -82,6 +82,7 @@
     </CodeGeneration>
     </CodeGeneration>
     <Linking>
     <Linking>
       <Debugging>
       <Debugging>
+        <GenerateDebugInfo Value="False"/>
         <DebugInfoType Value="dsDwarf3"/>
         <DebugInfoType Value="dsDwarf3"/>
       </Debugging>
       </Debugging>
       <Options>
       <Options>

+ 141 - 32
test/test_supergauge/sgtest.lfm

@@ -112,6 +112,7 @@ object SGTestFrm: TSGTestFrm
         Caption = 'Size'
         Caption = 'Size'
         ClientHeight = 202
         ClientHeight = 202
         ClientWidth = 244
         ClientWidth = 244
+        ParentBackground = False
         TabOrder = 0
         TabOrder = 0
         object WidthAddBtn: TBitBtn
         object WidthAddBtn: TBitBtn
           Left = 8
           Left = 8
@@ -224,6 +225,7 @@ object SGTestFrm: TSGTestFrm
         Caption = 'Position'
         Caption = 'Position'
         ClientHeight = 202
         ClientHeight = 202
         ClientWidth = 244
         ClientWidth = 244
+        ParentBackground = False
         TabOrder = 1
         TabOrder = 1
         object LeftAddBtn: TBitBtn
         object LeftAddBtn: TBitBtn
           Left = 8
           Left = 8
@@ -332,7 +334,7 @@ object SGTestFrm: TSGTestFrm
         Left = 8
         Left = 8
         Height = 29
         Height = 29
         Hint = 'Enable Auto Scale'#13#10'NOTE :  Only a few items are currently'#13#10'set to react to the AutoScale property.'
         Hint = 'Enable Auto Scale'#13#10'NOTE :  Only a few items are currently'#13#10'set to react to the AutoScale property.'
-        Top = 432
+        Top = 488
         Width = 225
         Width = 225
         Caption = 'Auto Scale (Experimental)'
         Caption = 'Auto Scale (Experimental)'
         TabOrder = 2
         TabOrder = 2
@@ -394,10 +396,10 @@ object SGTestFrm: TSGTestFrm
         TabOrder = 5
         TabOrder = 5
       end
       end
       object Memo2: TMemo
       object Memo2: TMemo
-        Left = 336
-        Height = 520
+        Left = 304
+        Height = 544
         Top = 256
         Top = 256
-        Width = 385
+        Width = 440
         Lines.Strings = (
         Lines.Strings = (
           'Basic Settings'
           'Basic Settings'
           ''
           ''
@@ -409,17 +411,41 @@ object SGTestFrm: TSGTestFrm
           ''
           ''
           'Also an interesting note is to see performance '
           'Also an interesting note is to see performance '
           'IF the gauge overlaps any window controls'
           'IF the gauge overlaps any window controls'
-          'as it will cause a slow refrresh of all the components'
-          'in the tabs. '
+          'as it will cause a slow refrresh of all the '
+          'components in the tabs. '
           ''
           ''
           'Performance test is super simple, but shows '
           'Performance test is super simple, but shows '
           'over 5x improvement over the original''s slow '
           'over 5x improvement over the original''s slow '
           'redraw.'
           'redraw.'
           ''
           ''
+          'Set Color to clNone for transparent background '
+          'around the gauge or any color as needed'
+          ''
           'Auto scale is only minimally implemented!'
           'Auto scale is only minimally implemented!'
         )
         )
         TabOrder = 6
         TabOrder = 6
       end
       end
+      object BackgroundColorCb: TColorBox
+        Left = 123
+        Height = 26
+        Hint = 'Frame Color'
+        Top = 408
+        Width = 171
+        Style = [cbStandardColors, cbExtendedColors, cbIncludeNone, cbCustomColor]
+        ColorDialog = ColorDialog1
+        ItemHeight = 20
+        OnChange = BackgroundColorCbChange
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 7
+      end
+      object BackgroundColorLbl: TLabel
+        Left = 8
+        Height = 25
+        Top = 408
+        Width = 43
+        Caption = 'Color'
+      end
     end
     end
     object FrameTab: TTabSheet
     object FrameTab: TTabSheet
       Caption = 'Frame'
       Caption = 'Frame'
@@ -555,6 +581,8 @@ object SGTestFrm: TSGTestFrm
         Items.Strings = (
         Items.Strings = (
           'fsNone'
           'fsNone'
           'fsGradient'
           'fsGradient'
+          'fsFlat'
+          'fsPhong'
         )
         )
         ParentShowHint = False
         ParentShowHint = False
         ShowHint = True
         ShowHint = True
@@ -566,7 +594,7 @@ object SGTestFrm: TSGTestFrm
         Left = 8
         Left = 8
         Height = 44
         Height = 44
         Hint = 'Reset to Default'
         Hint = 'Reset to Default'
-        Top = 248
+        Top = 328
         Width = 264
         Width = 264
         Caption = 'Reset Picture XY Offset'
         Caption = 'Reset Picture XY Offset'
         Images = ImageList1
         Images = ImageList1
@@ -580,7 +608,7 @@ object SGTestFrm: TSGTestFrm
         Left = 8
         Left = 8
         Height = 33
         Height = 33
         Hint = 'LED X Offset from Center'
         Hint = 'LED X Offset from Center'
-        Top = 208
+        Top = 288
         Width = 97
         Width = 97
         MaxLength = 0
         MaxLength = 0
         ParentShowHint = False
         ParentShowHint = False
@@ -597,7 +625,7 @@ object SGTestFrm: TSGTestFrm
         Left = 169
         Left = 169
         Height = 33
         Height = 33
         Hint = 'LED Y Offset from Center'
         Hint = 'LED Y Offset from Center'
-        Top = 208
+        Top = 288
         Width = 97
         Width = 97
         MaxLength = 0
         MaxLength = 0
         ParentShowHint = False
         ParentShowHint = False
@@ -613,14 +641,14 @@ object SGTestFrm: TSGTestFrm
       object FacePictureOffsetYLbl: TLabel
       object FacePictureOffsetYLbl: TLabel
         Left = 169
         Left = 169
         Height = 25
         Height = 25
-        Top = 184
+        Top = 264
         Width = 122
         Width = 122
         Caption = 'Picture Offset Y'
         Caption = 'Picture Offset Y'
       end
       end
       object FacePictureOffsetXLbl: TLabel
       object FacePictureOffsetXLbl: TLabel
         Left = 9
         Left = 9
         Height = 25
         Height = 25
-        Top = 184
+        Top = 264
         Width = 123
         Width = 123
         Caption = 'Picture Offset X'
         Caption = 'Picture Offset X'
       end
       end
@@ -628,7 +656,7 @@ object SGTestFrm: TSGTestFrm
         Left = 9
         Left = 9
         Height = 44
         Height = 44
         Hint = 'Load Face Image'
         Hint = 'Load Face Image'
-        Top = 296
+        Top = 376
         Width = 257
         Width = 257
         Caption = 'Load Image'
         Caption = 'Load Image'
         Images = ImageList1
         Images = ImageList1
@@ -640,12 +668,81 @@ object SGTestFrm: TSGTestFrm
         Left = 8
         Left = 8
         Height = 29
         Height = 29
         Hint = 'Show or Hide the Face Picture'
         Hint = 'Show or Hide the Face Picture'
-        Top = 144
+        Top = 224
         Width = 135
         Width = 135
         Caption = 'Picture Enable'
         Caption = 'Picture Enable'
         TabOrder = 7
         TabOrder = 7
         OnChange = FacePictureEnabledCbChange
         OnChange = FacePictureEnabledCbChange
       end
       end
+      object FaceCurveExponentSpe: TFloatSpinEditEx
+        Left = 191
+        Height = 33
+        Hint = 'Shader Curve, Typically for Phong shader'
+        Top = 168
+        Width = 97
+        MaxLength = 0
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 8
+        OnChange = FaceCurveExponentSpeChange
+        Increment = 0.01
+        MaxValue = 10
+        MinValue = -10
+        MinRepeatValue = 10
+      end
+      object FaceCurveExponentLbl: TLabel
+        Left = 8
+        Height = 25
+        Top = 176
+        Width = 124
+        Caption = 'Curve Exponent'
+      end
+      object FaceLightIntensitySpe: TSpinEditEx
+        Left = 191
+        Height = 33
+        Hint = 'Light Intensity of the Shader'
+        Top = 128
+        Width = 97
+        MaxLength = 0
+        ParentShowHint = False
+        ShowHint = True
+        TabOrder = 9
+        OnChange = FaceLightIntensitySpeChange
+        MaxValue = 1000
+        MinValue = -1000
+        MinRepeatValue = 10
+        NullValue = 0
+        Value = 0
+      end
+      object FaceLightIntensityLbl: TLabel
+        Left = 8
+        Height = 25
+        Top = 136
+        Width = 111
+        Caption = 'Light Intensity'
+      end
+      object FaceMemo: TMemo
+        Left = 24
+        Height = 368
+        Top = 440
+        Width = 633
+        Lines.Strings = (
+          'Set up various face parameters. '
+          ''
+          'For shading, several options, Phong gives pleasing results.'
+          ''
+          'The Curve Exponent is for the Phong Shader, and can'
+          'give some nice results. This only applies to the Phong '
+          'shader, values less that 1.0 give good results, Light Intensity'
+          'is basically brightness of the shade'
+          ''
+          'For Phong shading, it''s nice to follow the same settings'
+          'as the pointer cap. Also try using inner and outer colors'
+          'as the same with Phong shading as a start, clBlack/clBlack'
+          'to see the effect.'
+        )
+        TabOrder = 10
+      end
     end
     end
     object ScaleTab: TTabSheet
     object ScaleTab: TTabSheet
       Caption = 'Scale'
       Caption = 'Scale'
@@ -1284,11 +1381,11 @@ object SGTestFrm: TSGTestFrm
         OnChange = CapStyleCbChange
         OnChange = CapStyleCbChange
       end
       end
       object CapCurveExponentSpe: TFloatSpinEditEx
       object CapCurveExponentSpe: TFloatSpinEditEx
-        Left = 202
+        Left = 184
         Height = 33
         Height = 33
         Hint = 'Shader Curve, Typically for Phong shader'
         Hint = 'Shader Curve, Typically for Phong shader'
-        Top = 96
-        Width = 89
+        Top = 248
+        Width = 97
         MaxLength = 0
         MaxLength = 0
         ParentShowHint = False
         ParentShowHint = False
         ShowHint = True
         ShowHint = True
@@ -1300,16 +1397,16 @@ object SGTestFrm: TSGTestFrm
         MinRepeatValue = 10
         MinRepeatValue = 10
       end
       end
       object CapCurveExponentLbl: TLabel
       object CapCurveExponentLbl: TLabel
-        Left = 8
+        Left = 9
         Height = 25
         Height = 25
-        Top = 104
+        Top = 256
         Width = 124
         Width = 124
         Caption = 'Curve Exponent'
         Caption = 'Curve Exponent'
       end
       end
       object CapEdgeColorLbl: TLabel
       object CapEdgeColorLbl: TLabel
         Left = 8
         Left = 8
         Height = 25
         Height = 25
-        Top = 144
+        Top = 96
         Width = 88
         Width = 88
         Caption = 'Edge Color'
         Caption = 'Edge Color'
       end
       end
@@ -1317,7 +1414,7 @@ object SGTestFrm: TSGTestFrm
         Left = 120
         Left = 120
         Height = 26
         Height = 26
         Hint = 'Edge Color'
         Hint = 'Edge Color'
-        Top = 144
+        Top = 96
         Width = 171
         Width = 171
         Style = [cbStandardColors, cbExtendedColors, cbCustomColor]
         Style = [cbStandardColors, cbExtendedColors, cbCustomColor]
         ColorDialog = ColorDialog1
         ColorDialog = ColorDialog1
@@ -1330,7 +1427,7 @@ object SGTestFrm: TSGTestFrm
       object CapFillColorLbl: TLabel
       object CapFillColorLbl: TLabel
         Left = 8
         Left = 8
         Height = 25
         Height = 25
-        Top = 184
+        Top = 136
         Width = 69
         Width = 69
         Caption = 'Fill Color'
         Caption = 'Fill Color'
       end
       end
@@ -1338,7 +1435,7 @@ object SGTestFrm: TSGTestFrm
         Left = 120
         Left = 120
         Height = 26
         Height = 26
         Hint = 'Fill Color'
         Hint = 'Fill Color'
-        Top = 183
+        Top = 135
         Width = 171
         Width = 171
         Style = [cbStandardColors, cbExtendedColors, cbCustomColor]
         Style = [cbStandardColors, cbExtendedColors, cbCustomColor]
         ColorDialog = ColorDialog1
         ColorDialog = ColorDialog1
@@ -1349,10 +1446,10 @@ object SGTestFrm: TSGTestFrm
         TabOrder = 4
         TabOrder = 4
       end
       end
       object CapLightIntensitySpe: TSpinEditEx
       object CapLightIntensitySpe: TSpinEditEx
-        Left = 194
+        Left = 184
         Height = 33
         Height = 33
-        Hint = 'X Offset from Center'
-        Top = 216
+        Hint = 'Light Intensity of the Shader'
+        Top = 208
         Width = 97
         Width = 97
         MaxLength = 0
         MaxLength = 0
         ParentShowHint = False
         ParentShowHint = False
@@ -1368,22 +1465,22 @@ object SGTestFrm: TSGTestFrm
       object CapLightIntensityLbl: TLabel
       object CapLightIntensityLbl: TLabel
         Left = 9
         Left = 9
         Height = 25
         Height = 25
-        Top = 224
+        Top = 216
         Width = 111
         Width = 111
         Caption = 'Light Intensity'
         Caption = 'Light Intensity'
       end
       end
       object CapRadiusLbl: TLabel
       object CapRadiusLbl: TLabel
         Left = 9
         Left = 9
         Height = 25
         Height = 25
-        Top = 264
+        Top = 176
         Width = 53
         Width = 53
         Caption = 'Radius'
         Caption = 'Radius'
       end
       end
       object CapRadiusSpe: TSpinEditEx
       object CapRadiusSpe: TSpinEditEx
-        Left = 194
+        Left = 184
         Height = 33
         Height = 33
         Hint = 'X Offset from Center'
         Hint = 'X Offset from Center'
-        Top = 256
+        Top = 168
         Width = 97
         Width = 97
         MaxLength = 0
         MaxLength = 0
         ParentShowHint = False
         ParentShowHint = False
@@ -1413,7 +1510,8 @@ object SGTestFrm: TSGTestFrm
           ''
           ''
           'The Curve Exponent is for the Phong Shader, and can'
           'The Curve Exponent is for the Phong Shader, and can'
           'give some nice results. This only applies to the Phong '
           'give some nice results. This only applies to the Phong '
-          'shader, values less that 1.0 give good results.'
+          'shader, values less that 1.0 give good results, Light Intensity'
+          'is basically brightness of the shade'
           ''
           ''
           'Again, play and experiment!'
           'Again, play and experiment!'
         )
         )
@@ -1432,6 +1530,7 @@ object SGTestFrm: TSGTestFrm
         Caption = 'Text 1'
         Caption = 'Text 1'
         ClientHeight = 258
         ClientHeight = 258
         ClientWidth = 290
         ClientWidth = 290
+        ParentBackground = False
         TabOrder = 0
         TabOrder = 0
         object Text1EnabledCb: TCheckBox
         object Text1EnabledCb: TCheckBox
           Left = 8
           Left = 8
@@ -1960,6 +2059,7 @@ object SGTestFrm: TSGTestFrm
         Caption = 'Band 1'
         Caption = 'Band 1'
         ClientHeight = 338
         ClientHeight = 338
         ClientWidth = 292
         ClientWidth = 292
+        ParentBackground = False
         TabOrder = 0
         TabOrder = 0
         object Band1EnabledCb: TCheckBox
         object Band1EnabledCb: TCheckBox
           Left = 11
           Left = 11
@@ -2229,6 +2329,7 @@ object SGTestFrm: TSGTestFrm
         Caption = 'Band 2'
         Caption = 'Band 2'
         ClientHeight = 338
         ClientHeight = 338
         ClientWidth = 292
         ClientWidth = 292
+        ParentBackground = False
         TabOrder = 1
         TabOrder = 1
         object Band2EnabledCb: TCheckBox
         object Band2EnabledCb: TCheckBox
           Left = 11
           Left = 11
@@ -3196,6 +3297,7 @@ object SGTestFrm: TSGTestFrm
         Caption = 'Active RangeLed Properties'
         Caption = 'Active RangeLed Properties'
         ClientHeight = 397
         ClientHeight = 397
         ClientWidth = 428
         ClientWidth = 428
+        ParentBackground = False
         TabOrder = 6
         TabOrder = 6
         object RangeLEDFillStyleLbl: TLabel
         object RangeLEDFillStyleLbl: TLabel
           Left = 106
           Left = 106
@@ -3672,6 +3774,7 @@ object SGTestFrm: TSGTestFrm
         Caption = 'Marker 1'
         Caption = 'Marker 1'
         ClientHeight = 250
         ClientHeight = 250
         ClientWidth = 292
         ClientWidth = 292
+        ParentBackground = False
         TabOrder = 0
         TabOrder = 0
         object Marker1EnabledCb: TCheckBox
         object Marker1EnabledCb: TCheckBox
           Left = 11
           Left = 11
@@ -3844,6 +3947,7 @@ object SGTestFrm: TSGTestFrm
         Caption = 'Marker 2'
         Caption = 'Marker 2'
         ClientHeight = 250
         ClientHeight = 250
         ClientWidth = 292
         ClientWidth = 292
+        ParentBackground = False
         TabOrder = 1
         TabOrder = 1
         object Marker2EnabledCb: TCheckBox
         object Marker2EnabledCb: TCheckBox
           Left = 11
           Left = 11
@@ -4016,6 +4120,7 @@ object SGTestFrm: TSGTestFrm
         Caption = 'Marker 3'
         Caption = 'Marker 3'
         ClientHeight = 250
         ClientHeight = 250
         ClientWidth = 292
         ClientWidth = 292
+        ParentBackground = False
         TabOrder = 2
         TabOrder = 2
         object Marker3EnabledCb: TCheckBox
         object Marker3EnabledCb: TCheckBox
           Left = 11
           Left = 11
@@ -4256,6 +4361,7 @@ object SGTestFrm: TSGTestFrm
     Caption = 'Set Gauge Value'
     Caption = 'Set Gauge Value'
     ClientHeight = 338
     ClientHeight = 338
     ClientWidth = 536
     ClientWidth = 536
+    ParentBackground = False
     TabOrder = 1
     TabOrder = 1
     object BGRAKnob: TBGRAKnob
     object BGRAKnob: TBGRAKnob
       Left = 32
       Left = 32
@@ -4274,8 +4380,11 @@ object SGTestFrm: TSGTestFrm
       Left = 232
       Left = 232
       Height = 25
       Height = 25
       Top = 56
       Top = 56
-      Width = 93
+      Width = 102
       Caption = 'GaugeValue'
       Caption = 'GaugeValue'
+      Font.Style = [fsBold]
+      ParentColor = False
+      ParentFont = False
     end
     end
     object KnobValLbl: TLabel
     object KnobValLbl: TLabel
       Left = 232
       Left = 232
@@ -4563,7 +4672,7 @@ object SGTestFrm: TSGTestFrm
   object SuperGauge: TSuperGauge
   object SuperGauge: TSuperGauge
     Left = 40
     Left = 40
     Height = 360
     Height = 360
-    Top = 25
+    Top = 24
     Width = 360
     Width = 360
     FaceSettings.FillStyle = fsGradient
     FaceSettings.FillStyle = fsGradient
     FaceSettings.InnerColor = clGray
     FaceSettings.InnerColor = clGray

+ 47 - 4
test/test_supergauge/sgtest.pas

@@ -25,15 +25,22 @@ uses
   BGRAShape, BGRAImageList, SuperGaugeCommon, SuperGauge,about;
   BGRAShape, BGRAImageList, SuperGaugeCommon, SuperGauge,about;
 
 
 const
 const
-  VERSIONSTR = '1.01';            // SG TEST version, Should ALWAYS show as a delta when merging!
+  VERSIONSTR = '1.02';            // SG TEST version, Should ALWAYS show as a delta when merging!
 
 
 type
 type
   { TSGTestFrm }
   { TSGTestFrm }
 
 
   TSGTestFrm = class(TForm)
   TSGTestFrm = class(TForm)
     BGRAKnob: TBGRAKnob;
     BGRAKnob: TBGRAKnob;
+    FaceCurveExponentLbl: TLabel;
+    FaceCurveExponentSpe: TFloatSpinEditEx;
+    FaceLightIntensityLbl: TLabel;
+    FaceLightIntensitySpe: TSpinEditEx;
     DisableAllMarkersBtn: TBitBtn;
     DisableAllMarkersBtn: TBitBtn;
     CapMemo: TMemo;
     CapMemo: TMemo;
+    FaceMemo: TMemo;
+    BackgroundColorCb: TColorBox;
+    BackgroundColorLbl: TLabel;
     PointerMemo: TMemo;
     PointerMemo: TMemo;
     SuperGauge: TSuperGauge;
     SuperGauge: TSuperGauge;
     EnableAllMarkersBtn: TBitBtn;
     EnableAllMarkersBtn: TBitBtn;
@@ -444,6 +451,7 @@ type
 
 
     procedure AboutSubMenuClick(Sender: TObject);
     procedure AboutSubMenuClick(Sender: TObject);
     procedure AutoScaleCbChange(Sender: TObject);
     procedure AutoScaleCbChange(Sender: TObject);
+    procedure BackgroundColorCbChange(Sender: TObject);
     procedure Band1ColorCbChange(Sender: TObject);
     procedure Band1ColorCbChange(Sender: TObject);
     procedure Band1EndValueSpeChange(Sender: TObject);
     procedure Band1EndValueSpeChange(Sender: TObject);
     procedure Band1SetFontBtnClick(Sender: TObject);
     procedure Band1SetFontBtnClick(Sender: TObject);
@@ -499,6 +507,8 @@ type
     procedure DisableAllMarkersBtnClick(Sender: TObject);
     procedure DisableAllMarkersBtnClick(Sender: TObject);
     procedure EnableAllMarkersBtnClick(Sender: TObject);
     procedure EnableAllMarkersBtnClick(Sender: TObject);
     procedure ExitSubMenuClick(Sender: TObject);
     procedure ExitSubMenuClick(Sender: TObject);
+    procedure FaceCurveExponentSpeChange(Sender: TObject);
+    procedure FaceLightIntensitySpeChange(Sender: TObject);
     procedure RoundBtnClick(Sender: TObject);
     procedure RoundBtnClick(Sender: TObject);
     procedure LoadImageBtnClick(Sender: TObject);
     procedure LoadImageBtnClick(Sender: TObject);
     procedure MarkerZeroAllBtnClick(Sender: TObject);
     procedure MarkerZeroAllBtnClick(Sender: TObject);
@@ -650,6 +660,7 @@ type
     ResetTics : integer;
     ResetTics : integer;
     ResetLoTics : integer;
     ResetLoTics : integer;
     ResetHiTics : integer;
     ResetHiTics : integer;
+    procedure UpdateBasicStats;
     procedure UpdateWHStats;
     procedure UpdateWHStats;
     procedure UpdateMinMaxStats;
     procedure UpdateMinMaxStats;
     procedure UpdateLTStats;
     procedure UpdateLTStats;
@@ -684,6 +695,7 @@ begin
       ResetLoTics := 0;
       ResetLoTics := 0;
       ResetHiTics := 0;
       ResetHiTics := 0;
 
 
+      UpdateBasicStats;
       UpdateWHStats;
       UpdateWHStats;
       UpdateMinMaxStats;
       UpdateMinMaxStats;
       UpdateLTStats;
       UpdateLTStats;
@@ -700,8 +712,6 @@ begin
 
 
       // hack to sync combo boxes
       // hack to sync combo boxes
       RangeLEDRangeTypeCbChange(Nil); // force a quick call so can update
       RangeLEDRangeTypeCbChange(Nil); // force a quick call so can update
-
-
 end;
 end;
 
 
 procedure TSGTestFrm.PerfTestBtnClick(Sender: TObject);
 procedure TSGTestFrm.PerfTestBtnClick(Sender: TObject);
@@ -732,6 +742,12 @@ begin
   MaxValueSpe.Value := SuperGauge.MaxValue;
   MaxValueSpe.Value := SuperGauge.MaxValue;
 end;
 end;
 
 
+procedure TSGTestFrm.UpdateBasicStats;
+begin
+  // could consolidate WHStats and MinMaxStats here
+  BackgroundColorCb.Selected := SuperGauge.Color;
+end;
+
 procedure TSGTestFrm.UpdateLTStats;
 procedure TSGTestFrm.UpdateLTStats;
 begin
 begin
     LeftValLbl.Caption := IntToStr(SuperGauge.Left);
     LeftValLbl.Caption := IntToStr(SuperGauge.Left);
@@ -1068,6 +1084,8 @@ begin
   FacePictureEnabledCb.Checked := SuperGauge.FaceSettings.PictureEnabled;
   FacePictureEnabledCb.Checked := SuperGauge.FaceSettings.PictureEnabled;
   FacePictureOffsetXSpe.Value := SuperGauge.FaceSettings.PictureOffsetX;
   FacePictureOffsetXSpe.Value := SuperGauge.FaceSettings.PictureOffsetX;
   FacePictureOffsetYSpe.Value := SuperGauge.FaceSettings.PictureOffsetY;
   FacePictureOffsetYSpe.Value := SuperGauge.FaceSettings.PictureOffsetY;
+  FaceCurveExponentSpe.Value := SuperGauge.FaceSettings.CurveExponent;
+  FaceLightIntensitySpe.Value := SuperGauge.FaceSettings.LightIntensity;
 end;
 end;
 
 
 procedure TSGTestFrm.UpdateFrameStats;
 procedure TSGTestFrm.UpdateFrameStats;
@@ -1368,6 +1386,11 @@ begin
   SuperGauge.AutoScale := AutoScaleCb.checked;
   SuperGauge.AutoScale := AutoScaleCb.checked;
 end;
 end;
 
 
+procedure TSGTestFrm.BackgroundColorCbChange(Sender: TObject);
+begin
+  SuperGauge.Color := BackgroundColorCb.Selected;
+end;
+
 procedure TSGTestFrm.AboutSubMenuClick(Sender: TObject);
 procedure TSGTestFrm.AboutSubMenuClick(Sender: TObject);
 begin
 begin
   AboutFrm.show;
   AboutFrm.show;
@@ -1803,6 +1826,18 @@ begin
   Close;
   Close;
 end;
 end;
 
 
+procedure TSGTestFrm.FaceCurveExponentSpeChange(Sender: TObject);
+begin
+  SuperGauge.FaceSettings.CurveExponent := FaceCurveExponentSpe.Value;
+  UpdateFaceStats;
+end;
+
+procedure TSGTestFrm.FaceLightIntensitySpeChange(Sender: TObject);
+begin
+  SuperGauge.FaceSettings.LightIntensity := FaceLightIntensitySpe.Value;
+  UpdateFaceStats;
+end;
+
 procedure TSGTestFrm.RoundBtnClick(Sender: TObject);
 procedure TSGTestFrm.RoundBtnClick(Sender: TObject);
 begin
 begin
   // try to round floating point, not always possible
   // try to round floating point, not always possible
@@ -1992,7 +2027,7 @@ end;
 procedure TSGTestFrm.FaceFillStyleCbChange(Sender: TObject);
 procedure TSGTestFrm.FaceFillStyleCbChange(Sender: TObject);
 begin
 begin
   // update Face fill style
   // update Face fill style
-  // fsNone = 0, fsGradient = 1
+  // fsNone = 0, fsGradient = 1, fsFlat = 2, fsPhong = 3
 
 
   case FaceFillStyleCb.ItemIndex of
   case FaceFillStyleCb.ItemIndex of
     0 : {fsNone}
     0 : {fsNone}
@@ -2003,6 +2038,14 @@ begin
         begin
         begin
           SuperGauge.FaceSettings.FillStyle := fsGradient;
           SuperGauge.FaceSettings.FillStyle := fsGradient;
         end;
         end;
+    2: {fsFlat}
+        begin
+          SuperGauge.FaceSettings.FillStyle := fsFlat;
+        end;
+    3: {fsPhong}
+        begin
+          SuperGauge.FaceSettings.FillStyle := fsPhong;
+        end
   else
   else
     // Unknown type, warn somewhere...
     // Unknown type, warn somewhere...
   end;
   end;