Is VclStyle Bug ? TProgressBar.Style := pbstMarQuee Does not work

守給你的承諾、 提交于 2019-12-04 05:03:37

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

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!