首页 > 解决方案 > 避免在启用运行时主题时在透明控件中闪烁

问题描述

我的控件是一个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;

有什么解决办法吗?

标签: delphivclflicker

解决方案


方法有误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


推荐阅读