delphi - 避免在启用运行时主题时在透明控件中闪烁
问题描述
我的控件是一个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;
有什么解决办法吗?
解决方案
方法有误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
推荐阅读
- javascript - 冒泡排序仅对数组的一部分进行排序
- firebase - Firebase 黑名单是如何执行的?
- c++ - 在 .exe 和 .dll 之间共享变量
- azure-data-factory - 将 csv 文件从 blob 容器复制到 Azure SQL DB 时出现空字符串和空字符串错误
- sql-server - 消息“列名无效。” 使用 check() 时
- reactjs - 涉及 Redux、useContext 和 HOC 的架构有哪些缺陷和性能问题?
- neo4j - 从 CSV 加载时如何创建节点、创建关系和删除属性?
- nlp - Powerbi on Prem 上的 NLP
- paypal - paypal 订单号的有效期是多久?
- android - ExoPlayer 无法播放分辨率为 1080p 的直播流