TBCMaterialProgressBarMarquee

bcmaterialprogressbarmarquee.pas

@@ -0,0 +1,106 @@
+unit BCMaterialProgressBarMarquee;
+
+{$mode delphi}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, BGRAGraphicControl,
+  ExtCtrls, BGRABitmap, BGRABitmapTypes;
+
+type
+
+  { TBCMaterialProgressBarMarquee }
+
+  TBCMaterialProgressBarMarquee = class(TBGRAGraphicControl)
+  private
+    FBarColor: TColor;
+    progressbasr_cx, progressbar_cw: integer;
+    progressbar_x, progressbar_w: integer;
+    progressbar_increase: boolean;
+    FTimer: TTimer;
+    procedure SetBarColor(AValue: TColor);
+    procedure TimerOnTimer(Sender: TObject);
+  protected
+
+  public
+    procedure DiscardBitmap;
+    procedure RedrawBitmapContent; override;
+    constructor Create(AOwner: TComponent); override;
+  published
+    property BarColor: TColor read FBarColor write SetBarColor;
+    property Visible;
+  end;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  RegisterComponents('BGRA Controls', [TBCMaterialProgressBarMarquee]);
+end;
+
+{ TBCMaterialProgressBarMarquee }
+
+procedure TBCMaterialProgressBarMarquee.TimerOnTimer(Sender: TObject);
+begin
+  if progressbar_increase then
+  begin
+    progressbar_w := progressbar_w + progressbar_cw;
+    if (progressbar_w >= Width - 5) then
+    begin
+      progressbar_increase := False;
+    end;
+  end
+  else
+  begin
+    progressbar_w := progressbar_w - progressbar_cw;
+    if (progressbar_w <= progressbar_cw) then
+    begin
+      progressbar_increase := True;
+    end;
+  end;
+  progressbar_x := progressbar_x + progressbasr_cx;
+  if (progressbar_x >= Width) then
+    progressbar_x := -progressbar_w;
+  DiscardBitmap;
+end;
+
+procedure TBCMaterialProgressBarMarquee.SetBarColor(AValue: TColor);
+begin
+  if FBarColor = AValue then
+    Exit;
+  FBarColor := AValue;
+  DiscardBitmap;
+end;
+
+procedure TBCMaterialProgressBarMarquee.DiscardBitmap;
+begin
+  inherited DiscardBitmap;
+  progressbar_cw := Width div 50;
+  progressbasr_cx := progressbar_cw * 2;
+end;
+
+procedure TBCMaterialProgressBarMarquee.RedrawBitmapContent;
+begin
+  Bitmap.Fill(Color);
+  Bitmap.Rectangle(Rect(progressbar_x, 0, progressbar_x + progressbar_w, Bitmap.Height),
+    BarColor, BarColor);
+end;
+
+constructor TBCMaterialProgressBarMarquee.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  progressbar_w := Width;
+  progressbar_x := -progressbar_w;
+  progressbar_increase := False;
+  FTimer := TTimer.Create(Self);
+  FTimer.Interval := 15;
+  FTimer.OnTimer := TimerOnTimer;
+  FTimer.Enabled := True;
+  Color := clWhite;
+  BarColor := $00E2A366;
+end;
+
+end.

bgracontrols.lpk

@@ -29,7 +29,7 @@
     <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="7" Minor="4"/>
-    <Files Count="66">
+    <Files Count="67">
       <Item1>
         <Filename Value="atshapelinebgra.pas"/>
         <HasRegisterProc Value="True"/>
@@ -338,18 +338,23 @@
       <Item64>
         <Filename Value="bcmaterialedit.pas"/>
         <HasRegisterProc Value="True"/>
-        <UnitName Value="POSBerryLiteMaterialEdit"/>
+        <UnitName Value="BCMaterialEdit"/>
       </Item64>
       <Item65>
         <Filename Value="bcmaterialfloatspinedit.pas"/>
         <HasRegisterProc Value="True"/>
-        <UnitName Value="POSBerryLiteMaterialFloatSpinEdit"/>
+        <UnitName Value="BCMaterialFloatSpinEdit"/>
       </Item65>
       <Item66>
         <Filename Value="bcmaterialspinedit.pas"/>
         <HasRegisterProc Value="True"/>
-        <UnitName Value="POSBerryLiteMaterialSpinEdit"/>
+        <UnitName Value="BCMaterialSpinEdit"/>
       </Item66>
+      <Item67>
+        <Filename Value="bcmaterialprogressbarmarquee.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="BCMaterialProgressBarMarquee"/>
+      </Item67>
     </Files>
     <LazDoc Paths="fpdoc"/>
     <RequiredPkgs Count="2">

bgracontrols.pas

@@ -20,8 +20,9 @@ interface
   BGRAThemeCheckBox, BGRAThemeRadioButton, BGRAVirtualScreen, 
   ColorSpeedButton, DTAnalogClock, DTAnalogCommon, DTAnalogGauge, 
   dtthemedclock, dtthemedgauge, MaterialColors, BCListBoxEx, BGRASVGTheme, 
-  BGRASVGImageList, bgrasvgimagelistform, bcmaterialedit, 
-  bcmaterialfloatspinedit, bcmaterialspinedit, LazarusPackageIntf;
+  BGRASVGImageList, bgrasvgimagelistform, BCMaterialEdit, 
+  BCMaterialFloatSpinEdit, BCMaterialSpinEdit, BCMaterialProgressBarMarquee, 
+  LazarusPackageIntf;
 
 implementation
 
@@ -69,9 +70,11 @@ procedure Register;
   RegisterUnit('dtthemedgauge', @dtthemedgauge.Register);
   RegisterUnit('BGRASVGTheme', @BGRASVGTheme.Register);
   RegisterUnit('BGRASVGImageList', @BGRASVGImageList.Register);
-  RegisterUnit('bcmaterialedit', @bcmaterialedit.Register);
-  RegisterUnit('bcmaterialfloatspinedit', @bcmaterialfloatspinedit.Register);
-  RegisterUnit('bcmaterialspinedit', @bcmaterialspinedit.Register);
+  RegisterUnit('BCMaterialEdit', @BCMaterialEdit.Register);
+  RegisterUnit('BCMaterialFloatSpinEdit', @BCMaterialFloatSpinEdit.Register);
+  RegisterUnit('BCMaterialSpinEdit', @BCMaterialSpinEdit.Register);
+  RegisterUnit('BCMaterialProgressBarMarquee', 
+    @BCMaterialProgressBarMarquee.Register);
 end;
 
 initialization