フォーラム


ゲスト  

ようこそ ゲスト さん。このフォーラムに投稿するには 登録が必要です。

ページ: [1]
トピック: Vista 以降で TProgressBar が遅い
DEKO
管理者
投稿数: 2649
Vista 以降で TProgressBar が遅い
on: 2013/11/16 09:08 Sat

Vista 以降ではプログレスバーの描画が遅いです。Position の値を変更すると SendMessage() で PBM_SETPOS しますので、SendMessage() が帰ってくるまで待たされます。以下のコードを試してみてください。

var
I : Integer;
st: cardinal;
begin
ProgressBar1.Position := 0;
st := GetTickCount;

for I := 1 to 100000 do
begin
ProgressBar1.Position := Trunc(I / 100000 * 100);
end;

Caption := IntToStr(GetTickCount - st);
end;

 
以下のようにして必要最低限の描画にすれば速くなります。

var
I : Integer;
st: cardinal;
CurrentPosition, OldPosition: Integer;
begin
ProgressBar1.Position := 0;
CurrentPosition := ProgressBar1.Position;
OldPosition := ProgressBar1.Position;
st := GetTickCount;

for I := 1 to 100000 do
begin
CurrentPosition := Trunc(I / 100000 * 100);
if OldPosition <> CurrentPosition then
ProgressBar1.Position := CurrentPosition;
OldPosition := CurrentPosition;
end;

Caption := IntToStr(GetTickCount - st);
end;

 
ですが、これを毎回毎回記述するのは面倒ですので、ComCtrls.pas を書き換えてしまいましょう。ComCtrls.pas をプロジェクトフォルダへコピーしてから書き換えます。まず、定義部に FOPosition というフィールドを定義します。

  TProgressBar = class(TWinControl)
private
F32BitMode: Boolean;
FMin: Integer;
FMax: Integer;
FPosition: Integer;
FStep: Integer;
FOrientation: TProgressBarOrientation;
FSmooth: Boolean;
FOPosition: Integer; // Add
function GetMin: Integer;
function GetMax: Integer;
function GetPosition: Integer;
procedure SetParams(AMin, AMax: Integer);
procedure SetMin(Value: Integer);

...

 
次に、コンストラクタでフィールドの値を初期化します…ここは省略してもかまいません。

constructor TProgressBar.Create(AOwner: TComponent);
begin
F32BitMode := InitCommonControl(ICC_PROGRESS_CLASS);
inherited Create(AOwner);
Width := 150;
Height := GetSystemMetrics(SM_CYVSCROLL);
FMin := 0;
FMax := 100;
FStep := 10;
FOrientation := pbHorizontal;
FOPosition := 0; // Add
end;

 
そして SetPosition() を書き換えます

procedure TProgressBar.SetPosition(Value: Integer);
begin
if FOPosition = Value then // Add
Exit; // Add
if not F32BitMode and ((Value < 0) or (Value > Limit16)) then
ProgressLimitError;
if HandleAllocated then
SendMessage(Handle, PBM_SETPOS, Value, 0)
else
FPosition := Value;
FOPosition := Value; // Add
end;

 
これで完了です。一番最初に挙げたコードで速度をテストしてみてください。なお、この件は Delphi 固有の問題ではありません。プログレスバーは Windows のコモンコントロールですからね。上記修正は Delphi 2007 のソースコードをベースとしていますので、他のバージョンの Delphi では記述が若干異なるかもしれません…まぁ、やる事は同じなので難しい修正ではないでしょう。

…XE 以降の Starter Edition ではこの方法は使えませんので、 TProgressBar クラスを継承するなりしてどうにかするしかないように思えます。

See Also:
[ランタイムテーマ有効時のプログレスバー処理が遅い (Delphi Q&A)]
http://hpcgi1.nifty.com/MADIA/DelphiBBS/wwwlng.cgi?print+201311/13110016.txt

DEKO
管理者
投稿数: 2649
継承するなりしてどうにかする
on: 2013/11/16 09:50 Sat

以下のユニットを用意します。

[uProgressbarFix.pas]
unit uProgressbarFix;

interface

uses
Classes, Windows, StdCtrls, ComCtrls, CommCtrl;

type
TProgressBar = class(ComCtrls.TProgressBar)
private
FPosition: Integer;
procedure SetPosition(const Value: Integer);
function GetPosition: Integer;
public
constructor Create(AOwner: TComponent); override;
property Position: Integer read GetPosition write SetPosition default 0;
end;

implementation

{ TProgressBar }

constructor TProgressBar.Create(AOwner: TComponent);
begin
inherited;
FPosition := 0;
end;

function TProgressBar.GetPosition: Integer;
begin
if HandleAllocated then
Result := SendMessage(Handle, PBM_GETPOS, 0, 0)
else
Result := FPosition;
end;

procedure TProgressBar.SetPosition(const Value: Integer);
begin
if FPosition <> Value then
begin
FPosition := Value;
if HandleAllocated then
SendMessage(Handle, PBM_SETPOS, Value, 0);
end;
end;

end.

 
使い方は ProgressBar を使っているユニットの uses に uProgressbarFix を追加するだけです (ComCtrls よりも後に uses してください)。既存のコードを修正する必要はありません。

ページ: [1]
WP Forum Server by ForumPress | LucidCrew
バージョン: 1.7.5 ; ページロード: 0.032 sec.