129 lines
3.0 KiB
ObjectPascal
129 lines
3.0 KiB
ObjectPascal
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.
|