BGRAFlashProgressBar Added use of Font.Color

bgraflashprogressbar.pas

@@ -22,6 +22,7 @@
              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;
 
@@ -29,8 +30,6 @@ unit BGRAFlashProgressBar;
 
 interface
 
-//{$define TESTS}
-
 uses
   Classes, {$IFDEF BGRABITMAP_USE_MSEGUI} mclasses, {$ENDIF}
   SysUtils, Types, Forms, Controls, Graphics,
@@ -161,11 +160,6 @@ type
     procedure TimerOnTimer(Sender: TObject);
 
   public
-    {$ifdef TESTS}
-    p1, p2:TPointF;
-    pT: TGradientType;
-    {$endif}
-
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
 
@@ -967,23 +961,17 @@ var
 
   procedure DrawBarAnimation;
   begin
-    {$ifdef TESTS}
-      ABitmap.GradientFill(4, content.Top, 4+36, content.Bottom,
-                           BGRA(255, 255, 255, 64), BGRA(255, 255, 255, 2), pT,
-                           p1, p2,
-                           dmLinearBlend);
-    {$else}
     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);
-    {$endif}
   end;
 
   procedure DrawText(ACaption: String; AAlign: TAlignment);
   var
      fx: TBGRATextEffect;
+     lColB: TBGRAPixel;
 
   begin
     try
@@ -991,20 +979,24 @@ var
        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, BGRAWhite, 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, BGRAWhite, 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, BGRAWhite, taCenter);
+           fx.Draw(ABitmap, ABitmap.Width div 2, y, lColB, taCenter);
          end;
        end;
 
@@ -1045,7 +1037,10 @@ var
 
   begin
     lCol := FBarColor;
-    lColB:= ApplyLightness(lCol, 37000);
+
+    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;

test/test_progressbar/test_progressbar.lpi

@@ -9,8 +9,12 @@
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <Title Value="test_progressbar"/>
+      <Scaled Value="True"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
     </General>
     <i18n>
       <EnableI18N LFM="False"/>

test/test_progressbar/test_progressbar.lpr

@@ -14,6 +14,7 @@ uses
 
 begin
   RequireDerivedFormResource := True;
+  Application.Scaled:=True;
   Application.Initialize;
   Application.CreateForm(TForm1, Form1);
   Application.Run;

test/test_progressbar/umain.pas

@@ -4,8 +4,6 @@ unit umain;
 
 interface
 
-//{$define TESTS}
-
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls, ExtCtrls, StdCtrls, Spin, EditBtn,
   ColorBox, BGRAFlashProgressBar, BCTrackbarUpdown, BGRASpeedButton, ColorSpeedButton, BGRABitmap, BGRABitmapTypes;
@@ -16,6 +14,7 @@ type
 
   TForm1 = class(TForm)
     btBackgroundColor: TColorSpeedButton;
+    btFontColor: TColorSpeedButton;
     btBarColorM: TColorSpeedButton;
     btGraphAddValue: TBGRASpeedButton;
     btGraphTest: TBGRASpeedButton;
@@ -75,7 +74,7 @@ type
     Label20: TLabel;
     Label21: TLabel;
     Label22: TLabel;
-    Label23: TLabel;
+    Label24: TLabel;
     Label3: TLabel;
     Label4: TLabel;
     Label5: TLabel;
@@ -90,11 +89,6 @@ type
     rgCaptionAlignM: TRadioGroup;
     rgMarqueeDirection: TRadioGroup;
     rgMarqueeSpeed: TRadioGroup;
-    p1x: TSpinEdit;
-    p2x: TSpinEdit;
-    p1y: TSpinEdit;
-    p2y: TSpinEdit;
-    pType: TSpinEdit;
     TabNormal: TTabSheet;
     TabMarquee: TTabSheet;
     TabMultiProgress: TTabSheet;
@@ -135,7 +129,6 @@ type
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
     procedure FormCreate(Sender: TObject);
     procedure FormShow(Sender: TObject);
-    procedure p1xChange(Sender: TObject);
     procedure PageControl1Change(Sender: TObject);
     procedure rgCaptionAlignClick(Sender: TObject);
     procedure rgCaptionAlignMClick(Sender: TObject);
@@ -327,9 +320,6 @@ end;
 procedure TForm1.FormCreate(Sender: TObject);
 begin
   Closing:= False;
-  {$ifdef TESTS}
-  p1xChange(nil);
-  {$endif}
 end;
 
 procedure TForm1.FormShow(Sender: TObject);
@@ -337,16 +327,6 @@ begin
   PageControl1.ActivePage:= TabNormal;
 end;
 
-procedure TForm1.p1xChange(Sender: TObject);
-begin
-  {$ifdef TESTS}
-  BGRAMaxMProgress.pT:= TGradientType(pType.Value);
-  BGRAMaxMProgress.p1:=PointF(p1x.Value, p1y.Value);
-  BGRAMaxMProgress.p2:=PointF(p2x.Value, p2y.Value);
-  BGRAMaxMProgress.Invalidate;
-  {$endif}
-end;
-
 procedure TForm1.PageControl1Change(Sender: TObject);
 begin
   if (PageControl1.ActivePage.Tag = 4)
@@ -401,13 +381,13 @@ procedure TForm1.btBarColorClick(Sender: TObject);
 begin
   if ColorDialog1.Execute then
   begin
-    if Sender=btBarColor
-    then BGRAMaxMProgress.BarColor:=ColorDialog1.Color
+    if Sender=btBarColor then BGRAMaxMProgress.BarColor:=ColorDialog1.Color
     else
     if Sender=btBarColorM then BGRAMaxMProgress.BarColorSub:=ColorDialog1.Color
     else
-    if Sender=btBackgroundColor then BGRAMaxMProgress.BackgroundColor:=ColorDialog1.Color;
-
+    if Sender=btBackgroundColor then BGRAMaxMProgress.BackgroundColor:=ColorDialog1.Color
+    else
+    if Sender=btFontColor then BGRAMaxMProgress.Font.Color:=ColorDialog1.Color;
 
     TColorSpeedButton(Sender).StateNormal.Color:=ColorDialog1.Color;
   end;