Является ли VclStyle Bug?TProgressBar.Style: = pbstMarQuee не работает - PullRequest
Новая
       106

Является ли VclStyle Bug?TProgressBar.Style: = pbstMarQuee не работает

7 голосов
/ 25 марта 2012

Является ли VclStyle Bug? Я попытался найти список ошибок (http://edn.embarcadero.com/article/42090/), но не могу

  1. Файл> Создать> Приложение VCL
  2. TProgressBar положить основную форму> TProgressBar.Style: = pbstMarQuee
  3. Параметры проекта> Внешний вид> Задать пользовательский стиль> Задать стиль по умолчанию
  4. Ctrl + F9

ProgressBar не работает

К сожалению. Мой английский плохой: (* ​​1016 *

1 Ответ

13 голосов
/ 25 марта 2012

Эта функция не реализована в TProgressBarStyleHook .К сожалению, Windows не отправляет никакого сообщения элементу управления индикатором выполнения, чтобы указать, изменяется ли положение индикатора, когда он находится в режиме выделения , поэтому вы должны реализовать свой механизм для имитации стиля PBS_MARQUEE, это может бытьлегко создать новый хук стиля и использовать TTimer внутри хука стиля.

Проверить эту базовую реализацию хука стиля 

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.

Вы можете проверитьдемо этого стиля крючок здесь

...