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

时间:2019-04-30 12:17:40

标签: delphi vcl flicker

我的控件是一个TCustomControl后代,其中所有内容都通过覆盖的Paint方法用GDI +绘制。

一切都很好

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;

有什么解决办法吗?

1 个答案:

答案 0 :(得分: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;