是VclStyle Bug吗？ T ^ T我试图找到BugFix列表(http://edn.embarcadero.com/article/42090/)但我不能
>文件>新> VCL申请
> TProgressBar放置主窗体> TProgressBar.Style：= pbstMarQuee
>项目选项>外观>设置自定义样式>设置默认样式
>按Ctrl F9
ProgressBar不起作用
抱歉.我的英语不好 ：(
解决方法
这是
TProgressBarStyleHook中未实现的功能.不幸的是,Windows不会向进度条控件发送任何消息,以指示条形位置在
marquee mode时是否发生更改,因此您必须实现自己的机制来模拟PBS_MARQUEE样式,这可以很容易地创建一个新的样式钩子并在样式钩子内部使用
TTimer.
检查Style钩子的这个基本实现
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.
您可以查看此样式钩子here的演示