避免在启用运行时主题时在透明控件中闪烁答案

【问题标题】：Avoid flickering in transparent control while runtime themes are enabled避免在启用运行时主题时在透明控件中闪烁
【发布时间】：2019-09-19 02:36:50
【问题描述】：

我的控件是 TCustomControl 的后代，其中所有内容都使用 GDI+ 在重写的 Paint 方法中绘制。

一切都很好

DoubleBuffered := True;
ParentBackground := False;

然后我在Paint 方法中用

擦除控件的背景

g := TGPGraphics.Create(Canvas.Handle);
g.Clear(MakeColor(70, 70, 70));

现在我想在我不绘画的区域制作透明背景。

所以，我把g.Clear 注释掉了

ParentBackground := True;

在构造函数中。

当运行时主题关闭时，将父控件的DoubleBuffered 设置为True 就足够了，以避免闪烁，但对于运行时主题，这不再有帮助。

以下是TWinControl 代码的摘录，带有导致闪烁的标记行：

procedure TWinControl.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  if StyleServices.Enabled and Assigned(Parent) and (csParentBackground in FControlStyle) then
  begin
    { Get the parent to draw its background into the control's background. }
    if Parent.DoubleBuffered then
      PerformEraseBackground(Self, Message.DC) //It flickers here!!!!!
    else
      StyleServices.DrawParentBackground(Handle, Message.DC, nil, False);
  end
  else
  begin
    { Only erase background if we're not doublebuffering or painting to memory. }
    if not FDoubleBuffered or
{$IF DEFINED(CLR)}
       (Message.OriginalMessage.WParam = Message.OriginalMessage.LParam) then
{$ELSE}
       (TMessage(Message).wParam = WPARAM(TMessage(Message).lParam)) then
{$ENDIF}
      FillRect(Message.DC, ClientRect, FBrush.Handle);
  end;
  Message.Result := 1;
end;

有什么解决办法吗？

【问题讨论】：

为什么将DoubleBuffered 设置为True？
我认为无需将DoubleBuffered 设置为True 就可以解决闪烁问题。这一直是我解决闪烁的 VCL 控件的方法。
@DavidHeffernan：但是状态栏和列表视图控件通常需要双缓冲，否则您会得到可怕的视觉伪像（至少在我见过的大多数瑞典 PC 上）。
@AndreasRejbrand 列表视图和状态栏确实是规则的例外。
所以你可以通过自己处理 WM_ERASEBKGND 来改变行为，不是吗？

标签： delphi vcl flicker

【解决方案1】：

TWinControl.WMEraseBkgnd 方法有错误。当控件不在内存中绘制时，它应该始终跳过擦除双缓冲控件的背景。

您可以在自己的控件中覆盖 WMEraseBkgnd 行为，或修补 TWinControl.WMEraseBkgnd 以对所有控件应用以下修复。

  TMyControl = class(TCustomControl)
  protected
  ...
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
  ...

procedure TMyControl.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
{ Only erase background if we're not doublebuffering or painting to memory. }
  if not FDoubleBuffered or
{$IF DEFINED(CLR)}
    (Message.OriginalMessage.WParam = Message.OriginalMessage.LParam) then
{$ELSE}
    (TMessage(Message).WParam = WParam(TMessage(Message).LParam)) then
{$ENDIF}
    begin
      if StyleServices.Enabled and Assigned(Parent) and (csParentBackground in ControlStyle) then
        begin
          if Parent.DoubleBuffered then
            PerformEraseBackground(Self, Message.DC)
          else
            StyleServices.DrawParentBackground(Handle, Message.DC, nil, False);
        end
      else
        FillRect(Message.DC, ClientRect, Brush.Handle);
    end;
  Message.Result := 1;
end;

问题报告为RSP-24415

【讨论】：