Search code examples
delphidelphi-xe2vcl-styles

With VCL Styles TProgressBar.Style := pbstMarquee does not work


When I use pbstMarquee on progress bar control with VCL Styles, marquee animation does not work.

Steps to reproduce:

  1. File > New > VCL Application
  2. Put TProgressBar on main form > TProgressBar.Style := pbstMarquee
  3. Project Option > Appearence > set Custom Style > set Default Style
  4. Ctrl + F9

How to solve this problem and show animation with VCL Styles?


Solution

  • 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