CODEWITHSUNDEEP
delphidelphi-xe2vcl-styles
JH Jang
JH Jang

Reputation: 157

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?

Upvotes: 7

Views: 2697

Answers (1)

RRUZ
RRUZ

Reputation: 136391

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

Upvotes: 13

Related Questions