TLabel 和 TGroupbox 标题在调整大小时闪烁

2023-12-08

  • 所以,我有一个应用程序加载不同的插件并创建一个 每个 TPageControl 上都有一个新选项卡。
  • 每个 DLL 都有一个与其关联的 TForm。
  • 创建表单时将其父级 hWnd 作为新的 TTabSheet。
  • 由于就 VCL 而言,TTabSheets 不是表单的父级(不想使用动态 RTL,以及用其他语言制作的插件)我必须手动处理调整大小。我这样做如下:

    var
      ChildHandle : DWORD;
    begin
      If Assigned(pcMain.ActivePage) Then
        begin
        ChildHandle := FindWindowEx(pcMain.ActivePage.Handle, 0, 'TfrmPluginForm', nil);
        If ChildHandle > 0 Then
          begin
          SetWindowPos(ChildHandle, 0, 0, 0, pcMain.ActivePage.Width, pcMain.ActivePage.Height, SWP_NOZORDER + SWP_NOACTIVATE + SWP_NOCOPYBITS);
        end;
      end;
    

现在,我的问题是,当调整应用程序大小时,所有 TGroupBox 和 TGroupBox 内的 TLabels 都会闪烁。不在 TGroupboxes 内的 TLabels 很好并且不会闪烁。

我尝试过的事情:

  • WM_SETREDRAW 后跟 RedrawWindow
  • TGroupBoxes 和 TLabels 上的 ParentBackground 设置为 False
  • 双缓冲 := 真
  • 锁定窗口更新(是的,尽管我知道这是非常非常错误的)
  • 透明 := 假 (甚至重写 create 来编辑 ControlState)

有任何想法吗?


我发现唯一有效的方法是使用WS_EX_COMPOSITED窗口样式。这是一个性能消耗大户,所以我只在调整大小循环时启用它。根据我的经验,使用内置控件,在我的应用程序中,仅在调整表单大小时才会发生闪烁。

您应该首先执行快速测试,看看这种方法是否对您有帮助,只需添加WS_EX_COMPOSITED所有窗口控件的窗口样式。如果这有效,您可以考虑以下更高级的方法:

快速破解

procedure EnableComposited(WinControl: TWinControl);
var
  i: Integer;
  NewExStyle: DWORD;
begin
  NewExStyle := GetWindowLong(WinControl.Handle, GWL_EXSTYLE) or WS_EX_COMPOSITED;
  SetWindowLong(WinControl.Handle, GWL_EXSTYLE, NewExStyle);

  for i := 0 to WinControl.ControlCount-1 do
    if WinControl.Controls[i] is TWinControl then
      EnableComposited(TWinControl(WinControl.Controls[i]));
end;

例如,在OnShow为您TForm,传递表单实例。如果这有帮助,那么你真的应该更明智地实施它。我为您提供了我的代码的相关摘录,以说明我是如何做到这一点的。

完整代码

procedure TMyForm.WMEnterSizeMove(var Message: TMessage);
begin
  inherited;
  BeginSizing;
end;

procedure TMyForm.WMExitSizeMove(var Message: TMessage);
begin
  EndSizing;
  inherited;
end;

procedure SetComposited(WinControl: TWinControl; Value: Boolean);
var
  ExStyle, NewExStyle: DWORD;
begin
  ExStyle := GetWindowLong(WinControl.Handle, GWL_EXSTYLE);
  if Value then begin
    NewExStyle := ExStyle or WS_EX_COMPOSITED;
  end else begin
    NewExStyle := ExStyle and not WS_EX_COMPOSITED;
  end;
  if NewExStyle<>ExStyle then begin
    SetWindowLong(WinControl.Handle, GWL_EXSTYLE, NewExStyle);
  end;
end;

function TMyForm.SizingCompositionIsPerformed: Boolean;
begin
  //see The Old New Thing, Taxes: Remote Desktop Connection and painting
  Result := not InRemoteSession;
end;
procedure TMyForm.BeginSizing;
var
  UseCompositedWindowStyleExclusively: Boolean;
  Control: TControl;
  WinControl: TWinControl;
begin
  if SizingCompositionIsPerformed then begin
    UseCompositedWindowStyleExclusively := Win32MajorVersion>=6;//XP can't handle too many windows with WS_EX_COMPOSITED
    for Control in ControlEnumerator(TWinControl) do begin
      WinControl := TWinControl(Control);
      if UseCompositedWindowStyleExclusively then begin
        SetComposited(WinControl, True);
      end else begin
        if WinControl is TPanel then begin
          TPanel(WinControl).FullRepaint := False;
        end;
        if (WinControl is TCustomGroupBox) or (WinControl is TCustomRadioGroup) or (WinControl is TCustomGrid) then begin
          //can't find another way to make these awkward customers stop flickering
          SetComposited(WinControl, True);
        end else if ControlSupportsDoubleBuffered(WinControl) then begin
          WinControl.DoubleBuffered := True;
        end;
      end;
    end;
  end;
end;

procedure TMyForm.EndSizing;
var
  Control: TControl;
  WinControl: TWinControl;
begin
  if SizingCompositionIsPerformed then begin
    for Control in ControlEnumerator(TWinControl) do begin
      WinControl := TWinControl(Control);
      if WinControl is TPanel then begin
        TPanel(WinControl).FullRepaint := True;
      end;
      UpdateDoubleBuffered(WinControl);
      SetComposited(WinControl, False);
    end;
  end;
end;

function TMyForm.ControlSupportsDoubleBuffered(Control: TWinControl): Boolean;
const
  NotSupportedClasses: array [0..1] of TControlClass = (
    TCustomForm,//general policy is not to double buffer forms
    TCustomRichEdit//simply fails to draw if double buffered
  );
var
  i: Integer;
begin
  for i := low(NotSupportedClasses) to high(NotSupportedClasses) do begin
    if Control is NotSupportedClasses[i] then begin
      Result := False;
      exit;
    end;
  end;
  Result := True;
end;

procedure TMyForm.UpdateDoubleBuffered(Control: TWinControl);

  function ControlIsDoubleBuffered: Boolean;
  const
    DoubleBufferedClasses: array [0..2] of TControlClass = (
      TMyCustomGrid,//flickers when updating
      TCustomListView,//flickers when updating
      TCustomStatusBar//drawing infidelities , e.g. my main form status bar during file loading
    );
  var
    i: Integer;
  begin
    if not InRemoteSession then begin
      //see The Old New Thing, Taxes: Remote Desktop Connection and painting
      for i := low(DoubleBufferedClasses) to high(DoubleBufferedClasses) do begin
        if Control is DoubleBufferedClasses[i] then begin
          Result := True;
          exit;
        end;
      end;
    end;
    Result := False;
  end;

var
  DoubleBuffered: Boolean;

begin
  if ControlSupportsDoubleBuffered(Control) then begin
    DoubleBuffered := ControlIsDoubleBuffered;
  end else begin
    DoubleBuffered := False;
  end;
  Control.DoubleBuffered := DoubleBuffered;
end;

procedure TMyForm.UpdateDoubleBuffered;
var
  Control: TControl;
begin
  for Control in ControlEnumerator(TWinControl) do begin
    UpdateDoubleBuffered(TWinControl(Control));
  end;
end;

这不会为您编译,但它应该包含一些有用的想法。ControlEnumerator我的实用程序是将子控件的递归遍历变成平面for环形。请注意,我还使用了一个自定义拆分器,该拆分器在激活时调用 BeginSizing/EndSizing。

另一个有用的技巧是使用TStaticText代替TLabel当页面控件和面板有深层嵌套时,您有时需要执行此操作。

我使用这段代码使我的应用程序 100% 无闪烁,但我花了很多年的时间进行实验才将其全部到位。希望其他人可以在这里找到有用的东西。

本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

TLabel 和 TGroupbox 标题在调整大小时闪烁 的相关文章

  • 对于大型简单数据库,SQLite 和 DISQLite 有何比较?

    两者有什么区别SQLite http www sqlite org and DISQLite http www yunqa de delphi doku php products sqlite3 index为什么我要选择其中一个而不是另一个
  • WinForm - TabStop 不工作

    我有一个带有 3 个组框的 WinForm 其中一个带有组合框 两个带有单选按钮 我将它们及其子控件全部设置为 TabStop false 但是当我使用 TAB 循环时 最后两个组框中当前选定的单选按钮将获得焦点 如果没有办法改变这种行为
  • Delphi XE4 中是否可以更改应用程序短标题而不使其与项目 dpr 名称相同?

    我正在编写我的第一个由 delphi 驱动的 iPhone 应用程序 我已经创建了它 但我希望将其命名为 dpr 文件名称以外的名称 因为 dpr 文件不能包含空格 例如 EXE 名称并不总是与人们可能分配给应用程序的人类可读名称相同 而在
  • 通过“修改日期”确定文件夹中的哪个文件是最新的?

    我需要扫描特定文件夹中的最新文件 基本上检查修改日期以查看哪个是最新的 但请记住这些文件具有随机名称 这是我到目前为止得到的 procedure TForm1 Button1Click Sender TObject begin ftp Ho
  • 从 Delphi 访问 TRAKT API - 承载身份验证问题

    使用 TOauth2Authenticator TRESTClient TRESTRequest TRESTResponseDataSet TRESTResponse TFDmemtable 和 TDataSource 我成功连接到 Tra
  • 如何从窗体单元外部访问delphi控件?

    我试图从如下定义的过程中调用计时器的 Enabled 属性 procedure Slide Form TForm Show Boolean 并且没有固定的形式名称 例如 Form2 Timer 将表单的单位放入使用列表后 这可以工作 For
  • 如何检查文件是否有备用数据流?

    Delphi 有没有办法检查文件是否有任何备用数据流 看一下 Win32 APIFindFirstStreamW https msdn microsoft com en us library windows desktop aa364424
  • 从不同的形式调用过程

    我正在使用 Lazarus 我有一个名为TForm1单元名称为 Unit 1 在这里我有一个名为mergeDATfile a shortint 这会产生一些东西 顺便说一句 我必须创建另一个名为TForm2里面有按钮 Button1 当它被
  • Firebird 或 NexusDB

    我知道有很多与 Delphi 数据库相关的问题 但我只考虑这两个数据库 我需要查询大约 100 000 条记录 根据您的经验 哪个更快 作为嵌入式 as C S Thanks 我还没用过 Nexus tbh 但我经常使用 Firebird
  • 如何使用 IdTCPClient 等待来自服务器的字符串?

    我的 IdTelnet indy 10 1 有问题 我无法以 Unicode 模式从服务器读取数据 现在我想用 IdTCPClient 编写 telnet 终端 服务器有时发送一行 有时发送越来越多的行 但发送之间没有固定的时间 现在我的问
  • IE 中的 jQuery 鼠标闪烁

    当我在 IE 中执行 fadeIn fadeOut slideUp slideDown toggle 等 jQuery 函数时 鼠标总是闪烁 沙漏在光标旁边的视图中快速闪烁 我尝试了不同的方法来在动画进行时完全隐藏鼠标 但没有效果 而且在大
  • 指针^ 与 s[1]

    在读取数据的函数中 数据含义只字符串 从磁盘 我应该更喜欢哪个 哪个更好 A DiskStream Read Pointer s Count or B DiskStream Read s 1 Count Note 我知道两者都有相同的结果
  • 在 tlistbox 中绘制缩略图

    在 DelphiXE 中 我使用 tFileOpenDialog 选择一个文件夹 然后在 tListBox 中列出该文件夹中的所有 jpg 文件 我允许将列表项拖放到列表中进行自定义排序 以便稍后按顺序显示它们 我希望能够在文件名旁边绘制图
  • iphone jquery 移动闪烁问题

    我在 iPhone 上使用使用 jQuery mobile 开发的应用程序时遇到闪烁问题 我尝试了互联网上提供的几种解决方案 包括 CSS 更改 将过渡设置为 无 甚至在 jquerymobile js 中注释代码 但没有运气 我使用的 J
  • 使用 IdTCPClient 和 IdTCPServer 发送和接收 TMemoryStream

    我在 XE2 中找到了 Remy Lebeau 的 IdTCP 组件聊天演示 我想玩一下 可以发现 我想使用这些组件发送图片 最好的方法似乎是使用 TMemoryStream 如果我发送字符串 连接工作正常 字符串传输成功 但是当我将其更改
  • 使用 Inno Setup 中格式化(部分粗体)的文本制作安装程序?

    有人看过 GOG com 游戏安装程序吗 如何制作像这样的欢迎文本字符串 包括单个标题中的路径和需要大小 其中部分内容加粗 以下是修改安装路径后如何更改字符串换行的示例 您可以使用TRichEditViewer http www jrsof
  • 如何在Delphi中实现人工神经网络? [关闭]

    Closed 这个问题需要多问focused help closed questions 目前不接受答案 我想要一个人工神经网络 42 个输入神经元 168 个隐藏神经元 7个输出神经元 这个网络就是玩 连四子 的游戏 每场比赛结束时 网络
  • 当 datasnap 服务器中的用户授权失败时,是否可以更改响应代码?

    当用户授权失败时 是否可以更改 DataSnap Delphi XE3 服务器中的 HTTP 响应代码 目前正在回归HTTP 1 1 500 内部服务器错误 这可能发生在许多其他场景中 并且无助于描述问题 按照同样的想法 是否可以更改默认的
  • Delphi XE 和 OmniXML:使用 SelectNode()?

    我将以下 XML 片段作为一个更大的 XML 文件的一部分 我正在使用最新的 OmniXML 快照进行处理
  • 从命令行增加 Delphi XE 项目版本号

    我有一个 Delphi XE 项目 我试图在使用 MSBuild 构建它之前更改程序的版本号 版本号信息位于 DPROJ 文件中 但如果我更改这些值 版本号不会更改 我认为原因是当您在 IDE 中更改版本号时 Delphi 会将更改保存到

随机推荐

  • 计算输入中的行数、单词数和字符数

    现在我正在阅读一本关于 C 的书 并且在书中遇到了一个我无法开始工作的示例 include
  • Shell 脚本中的十六进制到十进制

    有人可以帮我在 shell 脚本中将十六进制数转换为十进制数吗 例如 我想转换十六进制数bfca3000使用 shell 脚本转换为十进制 我基本上想要两个十六进制数的差 我的代码是 var3 echo ibase 16 var1 bc v
  • 带有额外字段的 Django Rest Framework 用户注册

    我正在尝试使用 DRF 来允许用户通过我的 API 创建新的用户帐户 我有一些可能与正常情况不同的要求 成功创建后 需要使用 DRF 的令牌功能返回用户令牌 所有 POST 字段都需要验证 我希望能够发布将存储在配置文件模型中的用户电话号码
  • 如何用文本文件项填充组合框!

    我有一个文本文件 其中包含以下类型的项目 wett45456 4556 45657 898 tyu5878 4566 7989 55565 现在我有一个 Windows 窗体 该窗体上有一个组合框 现在我想用每行的第一项填充组合框wett4
  • @font-face 和 Header 设置 Access-Control-Allow-Origin "*"

    我使用了以下规则来允许我们的静态域托管字体 但是当启用浏览器缓存时 我遇到了浏览器 firefox safari 不使用字体的问题
  • devise - 无法在 Rails 视图中显示登录或注销

    我现在正在使用 devise 进行基本身份验证 当我去localhost 3000 users sign in我将能够登录 或者如果我登录后前往那里 我将收到相应的消息 您已经登录 然而 user signed in 始终评估为 false
  • Spring xml ioc 相对于 Java 实例化有什么好处? [关闭]

    就目前情况而言 这个问题不太适合我们的问答形式 我们希望答案得到事实 参考资料或专业知识的支持 但这个问题可能会引发辩论 争论 民意调查或扩展讨论 如果您觉得这个问题可以改进并可能重新开放 访问帮助中心以获得指导 好吧 这个问题会得到很多反
  • 将 Pandoc 与 Swift 结合使用

    我正在尝试使用 Pandoc 将 LaTeX 转换为 Markdown 我需要创建一个文件 然后运行 pandoc 终端命令 问题是我创建的文件不在我运行终端命令的同一目录中 我尝试使用 shell cd 但它不会将您移动到用户的文件夹 有
  • Swift - 将协议数组向上转换为超级协议数组会导致错误

    在 Swift 中 我注意到我可以向上转换一个符合名为的协议的对象 比方说SubProtocol到另一个称为SuperProtocol这是一个超级协议SubProtocol 但我不能对协议数组做同样的事情 这是我在 Playground 中
  • 使用 pywin32 Dispatch 在 Excel 中的命名工作表之后移动工作表

    我有大量文件 需要将其中的某个工作表复制到另一个工作簿 需要将它们放置在具有特定名称的工作表之后 同时保留要移动的工作表中的所有格式 我在另一个线程中看到 pywin32 将是可行的方法 但是我很难在指定的工作表 之后 复制此工作表 xl
  • 设计一个指令序列,以便在使用偏移量解码时执行其他操作

    这个问题是后续问题那个问题 要设置此问题的上下文 请考虑无空编程 这是一种将指令序列 shellcode 伪装成字符串的技术 在C编程语言中 字节0标志着字符串的结束 因此指令序列必须设计为不包含任何此类字节 否则它将被滥用的字符串操作函数
  • 文本框出现在单选按钮检查上

    我有以下 table td align center td table
  • pandas - groupby 和重新缩放值

    我想向此数据框添加一个重新缩放的列 I Value A 1 A 4 A 2 A 5 B 1 B 2 B 1 这样新列 我们称之为scale 遵循一个函数value每组的列I 该函数只是每个组范围的标准化 lambda x x min x m
  • 如何在单个 MSI 中部署多个项目?

    我的解决方案中有 3 个要部署的项目 是否有一种快速有效的方法可以使用 Visual Studio 的安装项目来使用一个 MSI 部署所有三个应用程序 并让用户在安装过程中决定要安装哪些应用程序 我有 3 个单独应用程序的设置项目 我还有一
  • Google 表格中的一项功能可处理多个工作表

    在 Google Sheets 中我必须重复一个函数 因为getSheetByName 不接受一系列工作表 它只接受一张工作表 有没有一种方法可以让一个函数循环指定的工作表 不是所有工作表 i e 表 1 表 2 等 function re
  • 蓝牙SPP接收到的一些包帧会丢失还是?

    我使用android示例代码进行修改 只想收到包裹 但是 我的代码只在这里修改 private final Handler mHandler new Handler Override public void handleMessage Me
  • 在 grails 的 jasper 报告中以 pdf 格式显示新安装的字体

    我正在使用 iReport 4 5 0 和 grails 2 1 1 我想对 pdf 格式的报告中的某些文本使用 Canterbury 字体 因此我使用 iReport 设计器将该字体分配给我想要的文本 我还进入 iReport 设计器的工
  • 熟悉 MVC - 如何使用会话逻辑、附加类和后台逻辑

    在编写 PHP 代码时 我决定放弃意大利面条式代码并尝试实现 MVC 为了实现MVC框架 我发泄本文文章给了我一个良好的开端 我成功地创建了我的网站并开发了前端 现在 我正在尝试使用会话和其他会员区功能来实现后端 我的大脑充满了新信息 我的
  • 查找两个字符串数组之间的非公共元素

    有一个问题是如何找到两个字符串数组之间的非公共元素 例如 String a a b c d String b b c O p should be a d 我已经尝试过以下方法 但请告知是否有其他有效的方法来实现相同的目标 String a
  • TLabel 和 TGroupbox 标题在调整大小时闪烁

    所以 我有一个应用程序加载不同的插件并创建一个 每个 TPageControl 上都有一个新选项卡 每个 DLL 都有一个与其关联的 TForm 创建表单时将其父级 hWnd 作为新的 TTabSheet 由于就 VCL 而言 TTabSh