Merge pull request #128 from bgrabitmap/dev-bgracontrols

Dev bgracontrols
bgrabitmap · May 30, 2022 · 4dcdb9a · 4dcdb9a
2 parents 90d86dd + 46374ad
commit 4dcdb9a
Show file tree

Hide file tree

Showing 10 changed files with 183 additions and 16 deletions.
diff --git a/bcbuttonfocus.pas b/bcbuttonfocus.pas
@@ -1788,7 +1788,6 @@ constructor TCustomBCButtonFocus.Create(AOwner: TComponent);
   try
     with GetControlClassDefaultSize do
       SetInitialBounds(0, 0, CX, CY);
-    TabStop := True;
     ControlStyle := ControlStyle + [csAcceptsControls];
     FBGRANormal := TBGRABitmapEx.Create(Width, Height, BGRAPixelTransparent);
     FBGRAHover := TBGRABitmapEx.Create(Width, Height, BGRAPixelTransparent);

diff --git a/bcmaterialprogressbarmarquee.pas b/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.
diff --git a/bctrackbarupdown.pas b/bctrackbarupdown.pas
@@ -585,6 +585,7 @@ procedure TCustomBCTrackbarUpdown.MouseDown(Button: TMouseButton;
     SetFocus;
     SelectAll;
   end;
+  inherited MouseDown(Button, Shift, X, Y);
 end;
 
 procedure TCustomBCTrackbarUpdown.MouseMove(Shift: TShiftState; X, Y: Integer);

diff --git a/bgracontrols.lpk b/bgracontrols.lpk
@@ -28,8 +28,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="7" Minor="4"/>
-    <Files Count="66">
+    <Version Major="7" Minor="5"/>
+    <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">

diff --git a/bgracontrols.pas b/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

diff --git a/bgracontrolsinfo.pas b/bgracontrolsinfo.pas
@@ -9,7 +9,7 @@ interface
   Classes, SysUtils;
 
 const
-  BGRAControlsVersion = 7040000;
+  BGRAControlsVersion = 7050000;
 
   function BGRAControlsVersionStr: string;
 

diff --git a/bgrapascalscriptcomponent.lpk b/bgrapascalscriptcomponent.lpk
@@ -11,7 +11,7 @@
         <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
       </SearchPaths>
     </CompilerOptions>
-    <Version Major="7" Minor="4"/>
+    <Version Major="7" Minor="5"/>
     <Files Count="3">
       <Item1>
         <Filename Value="bgrapascalscript.pas"/>

diff --git a/bgraspriteanimation.pas b/bgraspriteanimation.pas
@@ -105,7 +105,7 @@   TBGRASpriteAnimation = class(TBGRAGraphicCtrl)
     { Protected declarations }
     procedure Paint; override;
     procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
-      WithThemeSpace: Boolean); override;
+      {%H-}WithThemeSpace: Boolean); override;
   public
     { Public declarations }
     procedure GifImageToSprite(Gif: TBGRAAnimatedGif);

diff --git a/bgrasvgimagelist.pas b/bgrasvgimagelist.pas
@@ -20,11 +20,14 @@   TBGRASVGImageList = class(TComponent)
     FHorizontalAlignment: TAlignment;
     FItems: TListOfTStringList;
     FReferenceDPI: integer;
+    FTargetRasterImageList: TImageList;
     FUseSVGAlignment: boolean;
     FVerticalAlignment: TTextLayout;
     FWidth: integer;
+    FRasterized: boolean;
     procedure ReadData(Stream: TStream);
     procedure SetHeight(AValue: integer);
+    procedure SetTargetRasterImageList(AValue: TImageList);
     procedure SetWidth(AValue: integer);
     procedure WriteData(Stream: TStream);
   protected
@@ -34,6 +37,9 @@   TBGRASVGImageList = class(TComponent)
     function GetCount: integer;
     // Get SVG string
     function GetSVGString(AIndex: integer): string; overload;
+    procedure Rasterize;
+    procedure RasterizeIfNeeded;
+    procedure QueryRasterize;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -81,6 +87,7 @@   TBGRASVGImageList = class(TComponent)
     property UseSVGAlignment: boolean read FUseSVGAlignment write FUseSVGAlignment default False;
     property HorizontalAlignment: TAlignment read FHorizontalAlignment write FHorizontalAlignment default taCenter;
     property VerticalAlignment: TTextLayout read FVerticalAlignment write FVerticalAlignment default tlCenter;
+    property TargetRasterImageList: TImageList read FTargetRasterImageList write SetTargetRasterImageList default nil;
   end;
 
 procedure Register;
@@ -115,13 +122,23 @@ procedure TBGRASVGImageList.SetHeight(AValue: integer);
   if FHeight = AValue then
     Exit;
   FHeight := AValue;
+  QueryRasterize;
+end;
+
+procedure TBGRASVGImageList.SetTargetRasterImageList(AValue: TImageList);
+begin
+  if FTargetRasterImageList=AValue then Exit;
+  if Assigned(FTargetRasterImageList) then FTargetRasterImageList.Clear;
+  FTargetRasterImageList:=AValue;
+  QueryRasterize;
 end;
 
 procedure TBGRASVGImageList.SetWidth(AValue: integer);
 begin
   if FWidth = AValue then
     Exit;
   FWidth := AValue;
+  QueryRasterize;
 end;
 
 procedure TBGRASVGImageList.WriteData(Stream: TStream);
@@ -197,26 +214,62 @@ function TBGRASVGImageList.Add(ASVG: string): integer;
   list := TStringList.Create;
   list.Text := ASVG;
   Result := FItems.Add(list);
+  QueryRasterize;
 end;
 
 procedure TBGRASVGImageList.Remove(AIndex: integer);
 begin
   FItems.Remove(FItems[AIndex]);
+  QueryRasterize;
 end;
 
 procedure TBGRASVGImageList.Exchange(AIndex1, AIndex2: integer);
 begin
   FItems.Exchange(AIndex1, AIndex2);
+  QueryRasterize;
 end;
 
 function TBGRASVGImageList.GetSVGString(AIndex: integer): string;
 begin
   Result := FItems[AIndex].Text;
 end;
 
+procedure TBGRASVGImageList.Rasterize;
+begin
+  if Assigned(FTargetRasterImageList) then
+  begin
+    FTargetRasterImageList.Clear;
+    FTargetRasterImageList.Width := Width;
+    FTargetRasterImageList.Height := Height;
+    {$IFDEF DARWIN}
+    PopulateImageList(FTargetRasterImageList, [Width, Width*2]);
+    {$ELSE}
+    PopulateImageList(FTargetRasterImageList, [Width]);
+    {$ENDIF}
+  end;
+end;
+
+procedure TBGRASVGImageList.RasterizeIfNeeded;
+begin
+  if not FRasterized then
+  begin
+    Rasterize;
+    FRasterized := true;
+  end;
+end;
+
+procedure TBGRASVGImageList.QueryRasterize;
+var method: TThreadMethod;
+begin
+  FRasterized := false;
+  method := RasterizeIfNeeded;
+  TThread.ForceQueue(nil, method);
+end;
+
 procedure TBGRASVGImageList.Replace(AIndex: integer; ASVG: string);
 begin
   FItems[AIndex].Text := ASVG;
+  QueryRasterize;
 end;
 
 function TBGRASVGImageList.GetCount: integer;

diff --git a/update_bgracontrols_force.json b/update_bgracontrols_force.json
@@ -8,13 +8,13 @@
       "ForceNotify" : true,
       "InternalVersion" : 25,
       "Name" : "bgracontrols.lpk",
-      "Version" : "7.4.0.0"
+      "Version" : "7.5.0.0"
     },
     {
       "ForceNotify" : false,
       "InternalVersion" : 1,
       "Name" : "bgrapascalscriptcomponent.lpk",
-      "Version" : "7.4.0.0"
+      "Version" : "7.5.0.0"
     }
   ]
 }