bgracontrols/bcmaterialprogressbarmarquee.pas

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
    procedure SetEnabled(Value: Boolean); override;
    procedure SetVisible(Value: Boolean); override;
  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.SetEnabled(Value: Boolean);
begin
  inherited SetEnabled(Value);
  FTimer.Enabled := Value and Visible;
  DiscardBitmap;
end;

procedure TBCMaterialProgressBarMarquee.SetVisible(Value: Boolean);
begin
  inherited SetVisible(Value);
  FTimer.Enabled := Enabled and Value;
  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
  if FTimer.Enabled then
  begin
  Bitmap.Fill(Color);
  Bitmap.Rectangle(Rect(progressbar_x, 0, progressbar_x + progressbar_w, Bitmap.Height),
    BarColor, BarColor);
  end
  else
  begin
    Bitmap.Fill(BarColor);
  end;
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.