是VclStyle Bug吗TProgressBar.Style：= pbstMarQuee不起作用 [英] Is VclStyle Bug ? TProgressBar.Style := pbstMarQuee Does not work

问题描述

是否VclStyle Bug？ T ^ TI试图找到BugFix列表（http://edn.embarcadero.com/article/42090/），但我不能

1. 文件>新建> VCL应用程序


2. TProgressBar放主窗体> TProgressBar.Style：= pbstMarQuee


3. 项目选项> Appearence>设置自定义样式>设置默认样式


4. Ctrl + F9

ProgressBar不工作

对不起，我的英语不好：（

解决方案

这是在TProgressBarStyleHook 。不幸的是，Windows不会向进度条控件发送任何消息，以指示在选框模式，所以你必须实现自己的一个机制要模拟PBS_MARQUEE样式，可以轻松完成创建新样式挂钩并使用 TTimer

检查Style钩子的基本实现

 使用
 Vcl.Styles，
 Vcl.Themes，
 Winapi.CommCtrl; 
 
 {$ R * .dfm} 
 
 type 
 TProgressBarStyleHookMarquee = class（TProgressBarStyleHook）
 private 
定时器：TTimer; 
 FStep：整数; 
 procedure TimerAction（Sender：TObject）; 
 protected 
 procedure PaintBar（Canvas：TCanvas）;覆盖
 public 
构造函数创建（AControl：TWinControl）;覆盖
析构函数覆盖
结束
 
 
构造函数TProgressBarStyleHookMarquee.Create（AControl：TWinControl）; 
开始
继承; 
 FStep：= 0; 
定时器：= TTimer.Create（nil）; 
 Timer.Interval：= 100; // TProgressBar（Control）.MarqueeInterval; 
 Timer.OnTimer：= TimerAction; 
 Timer.Enabled：= TProgressBar（Control）.Style = pbstMarquee; 
结束
 
析构函数TProgressBarStyleHookMarquee.Destroy; 
 begin 
 Timer.Free; 
继承; 
结束
 
程序TProgressBarStyleHookMarquee.PaintBar（Canvas：TCanvas）; 
 var 
 FillR，R：TRect; 
 W，Pos：Integer; 
详细信息：TThemedElementDetails; 
 begin 
 if（TProgressBar（Control）.Style = pbstMarquee）和StyleServices.Available然后
 begin 
 R：= BarRect; 
 InflateRect（R，-1，-1）; 
如果Orientation = pbHorizo​​ntal然后
 W：= R.Width 
 else 
 W：= R.Height; 
 
 Pos：= Round（W * 0.1）; 
 FillR：= R; 
 if Orientation = pbHorizo​​ntal then 
 begin 
 FillR.Right：= FillR.Left + Pos; 
详细信息：= StyleServices.GetElementDetails（tpChunk）; 
 end 
 else 
 begin 
 FillR.Top：= FillR.Bottom  -  Pos; 
详细信息：= StyleServices.GetElementDetails（tpChunkVert）; 
结束
 
 FillR.SetLocation（FStep * FillR.Width，FillR.Top）; 
 StyleServices.DrawElement（Canvas.Handle，Details，FillR）; 
 Inc（FStep，1）; 
如果FStep mod 10 = 0然后
 FStep：= 0; 
 end 
 else 
继承; 
结束
 
 procedure TProgressBarStyleHookMarquee.TimerAction（Sender：TObject）; 
 var 
画布：TCanvas; 
 begin 
如果StyleServices.Available和（TProgressBar（Control）.Style = pbstMarquee）和Control.Visible然后
 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 
 else 
 Timer.Enabled：= False; 
结束
 
初始化
 
 TStyleManager.Engine.RegisterStyleHook（TProgressBar，TProgressBarStyleHookMarquee）; 
 
结束。 
  

您可以检查此样式钩子的演示这里

Is VclStyle Bug ? T^T I tried to find BugFix list(http://edn.embarcadero.com/article/42090/) but I can't

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

ProgressBar does not work

Sorry. My english is bad :(

解决方案

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

这篇关于是VclStyle Bug吗TProgressBar.Style：= pbstMarQuee不起作用的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！