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 标题在调整大小时闪烁 的相关文章

  • 如何以编程方式安排任务

    如何使用 delphi 7 像 Google updater 一样安排任务 我没有使用注册表 因为它被卡巴斯基防病毒软件检测为误报 我在注册表中作为启动项添加的任何内容都会被检测为特洛伊木马 因此我决定使用任务计划 下面的代码展示了如何删除
  • 如何在 OSX 上的应用程序名称下创建子项菜单?

    如何在下面添加TMenuItemProject1以上Quit在下面的屏幕截图上 我创建了一个 TMenuBar 并选中了 UseOSMenu 属性 我添加的第一个 TMenuItem 是主栏中的第二个 TMenuItem 您可以通过将 II
  • 加载 Jpg/Gif/Bitmap 并转换为 Bitmap

    我必须从 XML 文件加载图像 XML 文件中没有关于图像是否为 JPG GIF BMP 的信息 加载图像后 我需要将其转换为位图 有谁知道如何在不知道实际文件格式的情况下将图像转换为位图 我正在使用 Delphi 2007 2009 谢谢
  • Delphi线程死锁

    我有时会在销毁某些线程时遇到死锁问题 我尝试过调试该问题 但在 IDE 中调试时似乎从未存在死锁 可能是因为 IDE 中的事件速度较低 问题 当应用程序启动时 主线程会创建多个线程 线程始终处于活动状态并与主线程同步 完全没有问题 当应用程
  • Delphi TImageList 位图更改

    我正在使用 Delphi XE2 Update 3 Update 4 与我们的一些第 3 方组件不兼容 因此我们尚未更新 我在我的应用程序中使用 TImageList 我注意到很多时候当它从源视图切换到表单视图 F12 时 突然之前未修改的
  • 我可以让我的 Delphi 应用程序在特定时间(例如上午 12:00)启动,而不运行应用程序吗?

    我看到一个已安装的应用程序 它从供应商的网站提供一些 XML 数据并将其显示在主窗体窗口中 我想这很简单 但我注意到 即使我关闭系统托盘中的应用程序 明天早上 上午 12 00 正好 它也会再次弹出 这太酷了 我不确定它是用 Delphi
  • 开源 Delphi 包可使用哪些项目选项?

    我写了一些 Delphi 代码 想在 GitHub 上分享 所有代码都根据需要包含在运行时和设计时包中 每个项目有许多项目选项需要设置 输出目录 搜索路径 编译选项等 我设法找到了一些适合我的情况的默认选项 但阅读此处的其他问答很明显有多个
  • 使用 OLE 和 Delphi 提高 Word 文档中搜索替换的性能

    经过一些实验 我最终得到了以下代码来在 MSWord 中执行搜索和替换 此代码在页眉和页脚中也能完美运行 包括首页或奇数 偶数页的页眉和 或页脚不同的情况 问题是我需要打电话MSWordSearchAndReplaceInAllDocume
  • 带位图的简单组合框

    如何将位图放入组合框中并将样式设置为简单 例如 Google Chrome 的右侧有星号 Firefox 的右侧有箭头 我尝试了这段代码 procedure TForm2 ComboBox1DrawItem Control TWinCont
  • 如何仅使用 TADOQuery 组件将图像插入数据库

    我有一个简单的基本问题 我正在尝试使用将图像插入数据库Insert与其他列值的语句也使用TADOQuery成分 由于代码已经由某人编写 因此我想在此处放置一些虚拟示例代码 以供您澄清相应的步骤 请注意 这可以正常工作TQuery组件 因为我
  • 如何遍历任意给定集合中的枚举?

    我有很多枚举类型 它们与相应的集合相结合 例如 type TMyEnum meOne meTwo meThree TMyEnums set of TMyEnum 我正在尝试提出一组可以运行的函数any枚举集 而不是为每个枚举编写单独的函数
  • 有人用CrossKylix进行真正的跨平台开发吗?

    新版本克罗斯凯利克斯 http crosskylix untergrund net 两周前更新过 即使 Kylix 已经停产很久了 但它似乎仍然被一些 Delphi 开发人员使用 有人在 Windows 和 Linux 的跨平台开发中成功使
  • 如何在Delphi中下载一个非常简单的HTTPS页面?

    我尝试了在这里看到的代码 但它不适用于 HTTPS 我需要将此页面作为字符串下载 并在其上添加一些换行符 以便将信息按顺序放入 TMemo 中 怎么做 我尝试使用 Indy 但由于 SSL 问题而失败 我尝试了此页面的解决方案 如何将网页下
  • Delphi 返回 TList 时出错

    我做了一个非常简单的应用程序 但我有一个我真的无法理解的问题 看一下这个基本代码 unit Unit1 interface uses Winapi Windows Winapi Messages System SysUtils System
  • Word 2010 自动化:“转到书签”

    我有一个用 Delphi 7 编写的程序 它打开一个基于模板的新 Word 文档 文档打开后 系统会自动跳转到书签 在模板中预定义 并在其中添加一些文本 以下代码在 Word 2003 中工作正常 但会导致invalid variant o
  • delphi中如何实现多重继承?

    我正在对一个旧库进行完全重写 我不确定如何处理这种情况 为了便于理解 大家都欢呼自行车类比 我有以下课程 TBike 自行车本身 TBikeWheel 自行车的一个轮子 TBikeWheelFront and TBikeWheelBack
  • Delphi IDE导致CPU过热

    我正在使用 Delphi 7 但我已经尝试过 Delphi 2005 2010 版本 在所有这些新版本中 当 Delphi IDE 在屏幕上可见时 我的 CPU 利用率为 50 一个核心为 100 另一个核心为 宽松 当 IDE 最小化时
  • Delphi 5 中的 Oracle 数据库连接

    我正在使用 Delphi 5 版本 我想连接到 Oracle 数据库 我有 TDatabase 组件 我不知道如何通过 Delphi 连接到数据库 请提供连接数据库的步骤 谢谢 The TDatabase http docwiki emba
  • 任意通用列表的通配符

    我有一个类 MyClass 它不是通用的 包含任意 TList 并对其执行某些操作 我希望用通用 TList 替换 TList 但 MyClass 必须保持非通用 由于 Delphi 是不变的 这样的事情是行不通的 list1 TList
  • delphi THashSHA2 在大文件上返回错误的 SHA256

    Data Cloud CloudAPI pas has class function TCloudSHA256Authentication GetStreamToHashSHA256Hex const Content TStream str

随机推荐

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

    现在我正在阅读一本关于 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