(09/2015) 我刚从 D6 跳到 XE8。有很多问题。包括这个 TProgressBar 的东西。摆了一会儿。今晚遇到了这个(Erik Knowles)修复。极好的。除了:我遇到的第一个场景的最大值为 9,770,880。而且它(Erik Knowles 的“原始”修复)确实增加了这个过程所花费的时间(以及 ProgressBar 的所有额外实际更新)。
因此,我扩展了他的课程以减少 ProgressBar 实际重绘自身的次数。但仅当“原始”最大值大于 MIN_TO_REWORK_PCTS 时(我在这里定为 5000)。
如果是这样,ProgressBar 只会更新自身 HUNDO 次(这里我从 100 开始并几乎确定了,因此是“HUNDO”名称)。
我还考虑了 Max 值的一些古怪之处:
if Abs(FOriginalMax - value) <= 1 then
pct := HUNDO
我用我原来的 9.8m Max 对此进行了测试。并且,使用这个独立的测试应用程序:
:
uses
:
ProgressBarFix;
const
PROGRESS_PTS = 500001;
type
TForm1 = class(TForm)
Label1: TLabel;
PB: TProgressBar;
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
x: integer;
begin
PB.Min := 0;
PB.Max := PROGRESS_PTS;
PB.Position := 0;
for x := 1 to PROGRESS_PTS do
begin
//let's do something
//
Label1.Caption := Format('%d of %d',[x,PROGRESS_PTS]);
Update;
PB.Position := x;
end;
PB.Position := 0;
end;
end.
PROGRESS_PTS 值为:10 100 1,000 10,000 100,000 1,000,000
对于所有这些值来说,它都是平滑且“准确的”——不会真正减慢任何速度。
在测试中,我能够切换我的编译器指令 DEF_USE_MY_PROGRESS_BAR 来测试两种方式(这个 TProgressBar 替换与原始版本)。
请注意,您可能希望取消注释对 Application.ProcessMessages 的调用。
这是(我的“增强”)ProgressBarFix 源:
unit ProgressBarFix;
interface
uses
Vcl.ComCtrls;
type
TProgressBar = class(Vcl.ComCtrls.TProgressBar)
const
HUNDO = 100;
MIN_TO_REWORK_PCTS = 5000;
private
function GetMax: integer;
procedure SetMax(value: integer);
function GetPosition: integer;
procedure SetPosition(value: integer);
published
property Max: integer read GetMax write SetMax default 100;
property Position: integer read GetPosition write SetPosition default 0;
private
FReworkingPcts: boolean;
FOriginalMax: integer;
FLastPct: integer;
end;
implementation
function TProgressBar.GetMax: integer;
begin
result := inherited Max;
end;
procedure TProgressBar.SetMax(value: integer);
begin
FOriginalMax := value;
FLastPct := 0;
FReworkingPcts := FOriginalMax > MIN_TO_REWORK_PCTS;
if FReworkingPcts then
inherited Max := HUNDO
else
inherited Max := value;
end;
function TProgressBar.GetPosition: integer;
begin
result := inherited Position;
end;
procedure TProgressBar.SetPosition(value: integer);
var
pct: integer;
begin
//Application.ProcessMessages;
if value = inherited Position then
exit;
if FReworkingPcts then
begin
if Abs(FOriginalMax - value) <= 1 then
pct := HUNDO
else
pct := Trunc((value / FOriginalMax) * HUNDO);
if pct = FLastPct then
exit;
FLastPct := pct;
value := pct;
end;
if value < Max then
begin
inherited Position := Succ(value);
inherited Position := value;
end
else
begin
Max := Succ(Max);
inherited Position := Max;
inherited Position := value;
Max := Pred(Max);
end;
end;
end.