调用更新过程时，TStatusBar 闪烁。轻松解决此问题的方法

Question

所以，这是我刚刚阅读的讨论： http://www.mail-archive.com/delphi@delphi.org.nz/msg02315.html

BeginUpdate 和 EndUpdate 不是我需要的程序...

覆盖 API 调用？我试图从 ComCtrls 单元获取更新程序代码，没有找到 nut...

也许你可以在这里发布一个代码来修复状态栏组件的闪烁，如果其中唯一的文本发生变化？我的意思是 - 类似 TextUpdate 或某种 TCanvas 方法或 PanelsRepaint ...？

闪烁是由这段代码引起的：

Repeat
   BlockRead(Fp, BuffArrayDebug[LineIndex], DataCapac, TestByteBuff); // DataCapac = SizeOf(DWORD)
   ProgressBar1.StepIt;
   if RAWFastMode.Checked then begin       // checks for fast mode and modifyies progressbar
    if BuffArrayDebug[LineIndex] = 0 then begin ProgressBar2.Max := FileSize(Fp) - DataCapac; ProgressBar2.Position := (LineIndex + 1) * DataCapac; LineDecr := True; end;
   end else begin ProgressBar2.Max := FileSize(Fp); ProgressBar2.Position := LineIndex * DataCapac end;
   if PreviewOpn.Caption = '<' then begin  // starts data copying to preview area if expanded
    Memo1.Lines.BeginUpdate;
    if (LineIndex mod DataCapac) > 0 then HexMerge := HexMerge + ByteToHex(BuffArrayDebug[LineIndex]) else
     begin
      Memo1.Lines.Add(HexMerge); HexMerge := '';
     end;
    Memo1.Lines.EndUpdate;
   end;
   StatusBar1.Panels[0].Text := 'Line: ' + Format('%.7d',[LineIndex]) + ' | Data: ' + Format('%.3d',[BuffArrayDebug[LineIndex]]) + ' | Time: ' + TimeToStr(Time - TimeVarStart); StatusBar1.Update;
    if FindCMDLineSwitch(ParamStr(1)) then begin
     TrayIcon.BalloonTitle := 'Processing ' + ExtractFileName(RAWOpenDialog.FileName) + ' and reading ...';
     TrayIcon.BalloonHint :=  'Current Line: ' + inttostr(LineIndex) + #10#13 + ' Byte Data: ' + inttostr(TestByteBuff) + #10#13 + ' Hex Data: ' + ByteToHex(TestByteBuff);
     TrayIcon.ShowBalloonHint;
    end;
  Inc(LineIndex);
 Until EOF(Fp);

有什么想法吗？

---

此链接 (http://www.stevetrefethen.com/blog/UsingTheWSEXCOMPOSITEWindowStyleToEliminateFlickerOnWindowsXP.aspx) 有评论，并且有有效的程序（无论如何都不会闪烁），但它是 VVVVVVVEEEEEERRRRYYYYYY 慢！

 1 type
 2   TMyForm = class(TForm)
 3   protected
 4     procedure CreateParams(var Params: TCreateParams); override;
 5   end;
 6 
 7 ...
 8 
 9 procedure TMyForm.CreateParams(var Params: TCreateParams);
10 begin
11   inherited;
12   // This only works on Windows XP and above
13   if CheckWin32Version(5, 1) then
14     Params.ExStyle := Params.ExStyle or WS_EX_COMPOSITED;
15 end;
16 

另外——目标不是表单，而是StatusBar ...如何将此方法分配给statusbar？

Answer 1

我能给你的最重要的建议是将状态栏更新的次数限制为每秒 10 或 20 次。更多只会导致不必要的闪烁，对用户没有任何好处 - 他们无论如何都无法快速处理信息。

好的，顺便说一句：如果你想为状态栏使用WS_EX_COMPOSITED 扩展样式，你基本上有三个选择：

• 创建一个覆盖CreateParams() 方法的后代类，然后将其安装到您的IDE 中，或者（如果您不想在IDE 中将其作为自己的组件）在运行时创建状态栏。

• 在另一个单元中创建一个同名TStatusBar 的后代类，覆盖CreateParams() 方法，并在ComCtrls 之后使用状态栏控件将这个单元添加到表单单元中。这将创建您自己的TStatusBar 类的实例，而不是ComCtrls 中的实例。有关该技术的另一个示例，请参阅 this answer，希望它足够清楚。

• 使用原版TStatusBar 类并在运行时设置WS_EX_COMPOSITED 扩展样式。

我更喜欢第三个选项，因为它是最容易试验的选项，所以这里是示例代码：

procedure TForm1.FormCreate(Sender: TObject);
var
  SBHandle: HWND;
begin
  // This only works on Windows XP and above
  if CheckWin32Version(5, 1) then begin
    // NOTE: the following call will create all necessary window handles
    SBHandle := StatusBar1.Handle;
    SetWindowLong(SBHandle, GWL_EXSTYLE,
      GetWindowLong(SBHandle, GWL_EXSTYLE) or WS_EX_COMPOSITED);
  end;
end;

编辑：

如果您希望您的代码正确支持最新的 Windows 版本和视觉样式，您甚至不应该考虑自己处理 WM_ERASEBKGND - 通常的技术涉及该方法的空处理程序，并在 WM_PAINT 处理程序中绘制背景.这对于像TStatusBar 这样的标准控件实际上并不适用，因为必须在某处 绘制背景。如果您只是跳过 WM_ERASEBKGND 处理程序中的背景绘制，您将需要使用跨越所有状态栏的所有者绘制的面板，否则根本不会绘制背景，并且下面的窗口会发光。此外，自绘面板的代码可能会非常复杂。

同样，更好的做法是解开您发布的代码中的混乱，正确地将工作人员与显示代码分开，并将状态栏文本的更新速度降低到合理的程度。超过每秒监视器更新的数量根本没有任何意义，即使这仅适用于游戏和类似的可视化。

Answer 2

您应该检查将 TStatusBar 组件的 TWinControl.DoubleBuffered 属性设置为 True 是否可以使其工作。您也可以尝试将此属性启用到状态栏的父组件（可能是 TForm）。这是一个盲目的镜头 - 无法从这里访问编译器。另一个想法是在不调用 inherited 的情况下覆盖 WM_ERASEBKGND 消息。用google找到的第一个例子：here.

-----作者评论后更新

我终于可以使用编译器了，现在它可以工作了。我们可以使用 WS_EX_COMPOSITED 解决方案。您只需要基于 TCustomStatusBar 创建您自己的自定义组件，或者只是创建一个类包装器并在运行时创建您的状态栏实例。像这样：

TMyStatusBar = class( TCustomStatusBar )
protected

  { Flickering work-around }
  procedure CreateParams( var Params : TCreateParams ) ; override ;

end ;

TForm1 = class( TForm )
  // (...)
private

  FStatusBar : TMyStatusBar ;

  // (...)

end ;

-------------

procedure TMyStatusBar.CreateParams( var Params : TCreateParams ) ;
begin
  inherited ;

  if CheckWin32Version( 5,1 ) then
    Params.ExStyle := Params.ExStyle or WS_EX_COMPOSITED ;
end ;

-------------

{ Creating component in runtime }    
procedure TForm1.FormCreate( Sender : TObject ) ;
begin
  FStatusBar := TMyStatusBar.Create( Self ) ;
  FStatusBar.Parent := Self ;
  FStatusBar.Panels.Add ;
end ;

它对我有用。祝你好运！