When I use pbstMarquee
on progress bar control with VCL Styles, marquee animation does not work.
Steps to reproduce:
TProgressBar
on main form > TProgressBar.Style := pbstMarquee
How to solve this problem and show animation with VCL Styles?
This is a feature not implemented in the TProgressBarStyleHook. Unfortunally Windows does not send any message to the progress bar control to indicate if the position of the bar changes when is in marquee mode, so you must implement your self a mechanism to mimic the PBS_MARQUEE Style, this can be easily done creating a new style hook and using a TTimer inside of the style hook.
Check this basic implementation of the Style hook
uses
Vcl.Styles,
Vcl.Themes,
Winapi.CommCtrl;
{$R *.dfm}
type
TProgressBarStyleHookMarquee=class(TProgressBarStyleHook)
private
Timer : TTimer;
FStep : Integer;
procedure TimerAction(Sender: TObject);
protected
procedure PaintBar(Canvas: TCanvas); override;
public
constructor Create(AControl: TWinControl); override;
destructor Destroy; override;
end;
constructor TProgressBarStyleHookMarquee.Create(AControl: TWinControl);
begin
inherited;
FStep:=0;
Timer := TTimer.Create(nil);
Timer.Interval := 100;//TProgressBar(Control).MarqueeInterval;
Timer.OnTimer := TimerAction;
Timer.Enabled := TProgressBar(Control).Style=pbstMarquee;
end;
destructor TProgressBarStyleHookMarquee.Destroy;
begin
Timer.Free;
inherited;
end;
procedure TProgressBarStyleHookMarquee.PaintBar(Canvas: TCanvas);
var
FillR, R: TRect;
W, Pos: Integer;
Details: TThemedElementDetails;
begin
if (TProgressBar(Control).Style=pbstMarquee) and StyleServices.Available then
begin
R := BarRect;
InflateRect(R, -1, -1);
if Orientation = pbHorizontal then
W := R.Width
else
W := R.Height;
Pos := Round(W * 0.1);
FillR := R;
if Orientation = pbHorizontal then
begin
FillR.Right := FillR.Left + Pos;
Details := StyleServices.GetElementDetails(tpChunk);
end
else
begin
FillR.Top := FillR.Bottom - Pos;
Details := StyleServices.GetElementDetails(tpChunkVert);
end;
FillR.SetLocation(FStep*FillR.Width, FillR.Top);
StyleServices.DrawElement(Canvas.Handle, Details, FillR);
Inc(FStep,1);
if FStep mod 10=0 then
FStep:=0;
end
else
inherited;
end;
procedure TProgressBarStyleHookMarquee.TimerAction(Sender: TObject);
var
Canvas: TCanvas;
begin
if StyleServices.Available and (TProgressBar(Control).Style=pbstMarquee) and Control.Visible then
begin
Canvas := TCanvas.Create;
try
Canvas.Handle := GetWindowDC(Control.Handle);
PaintFrame(Canvas);
PaintBar(Canvas);
finally
ReleaseDC(Handle, Canvas.Handle);
Canvas.Handle := 0;
Canvas.Free;
end;
end
else
Timer.Enabled := False;
end;
initialization
TStyleManager.Engine.RegisterStyleHook(TProgressBar, TProgressBarStyleHookMarquee);
end.
You can check a demo of this style hook here