TLabel 和 TGroupbox 标题在调整大小时闪烁 [英] TLabel and TGroupbox Captions Flicker on Resize

问题描述

• 所以，我有一个应用程序可以加载不同的插件并创建一个每个 TPageControl 上的新选项卡.
• 每个 DLL 都有一个与之关联的 TForm.
• 创建表单时将其父 hWnd 作为新的 TTabSheet.

• 由于就 VCL 而言，TTabSheets 不是表单的父级(不想使用动态 RTL 和其他语言制作的插件)，我必须手柄手动调整大小.我这样做如下:

• So, I have an application that loads different plugins and creates a new tab on a TPageControl for each one.
• Each DLL has a TForm associated with it.
• The forms are created with their parent hWnd as the new TTabSheet.

• Since the TTabSheets aren't a parent of the form as far as VCL is concerned (didn't want to use dynamic RTL, and plugins made in other languages) I have to handle resizes manually. I do this like below:

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;

现在，我的问题是当应用程序调整大小时，所有 TGroupBoxes 和 TGroupBoxes 内的 TLabels 闪烁.不在 TGroupboxes 内的 TLabel 很好，不会闪烁.

Now, my problem is that when the application is resized, all the TGroupBoxes and the TLabels inside the TGroupBoxes flicker. The TLabels that are not inside TGroupboxes are fine and don't flicker.

我尝试过的事情:

• WM_SETREDRAW 后跟一个 RedrawWindow
• TGroupBoxes 和 TLabels 上的 ParentBackground 设置为 False
• DoubleBuffer := 真
• LockWindowUpdate(是的，尽管我知道这是非常非常错误的)
• Transparent := False(甚至覆盖 create 以编辑 ControlState)

有什么想法吗?

推荐答案

我发现唯一有效的方法是使用 WS_EX_COMPOSITED 窗口样式.这是一个性能猪，所以我只在大小循环中启用它.根据我的经验，使用内置控件，在我的应用中，只有在调整表单大小时才会出现闪烁.

The only thing I have found to work well is to use the WS_EX_COMPOSITED window style. This is a performance hog so I only enable it when in a sizing loop. It is my experience that, with the built-in controls, in my app, flickering only occurs when resizing forms.

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

You should first perform a quick test to see if this approach will help you by simply adding the WS_EX_COMPOSITED window style to all your windowed controls. If that works you can consider the more advanced approach below:

快速破解

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;

例如，在 TForm 的 OnShow 中调用它，传递表单实例.如果这有帮助，那么你真的应该更敏锐地实施它.我从我的代码中给你相关的摘录来说明我是如何做到的.

Call this, for example, in the OnShow for your TForm, passing the form instance. If that helps then you really should implement it more discerningly. I give you the relevant extracts from my code to illustrate how I did that.

完整代码

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.

This won't compile for you, but it should contain some useful ideas. ControlEnumerator is my utility to turn a recursive walk of the child controls into a flat for loop. Note that I also use a custom splitter that calls BeginSizing/EndSizing when it is active.

另一个有用的技巧是使用 TStaticText 而不是 TLabel，当您对页面控件和面板进行深度嵌套时，您偶尔需要这样做.

Another useful trick is to use TStaticText instead of TLabel which you occasionally need to do when you have deep nesting of page controls and panels.

我已经使用此代码使我的应用程序 100% 无闪烁，但我花了很长时间进行实验才将其全部落实到位.希望其他人可以在这里找到有用的东西.

I've used this code to make my app 100% flicker free but it took me ages and ages of experimenting to get it all in place. Hopefully others can find something of use in here.

这篇关于TLabel 和 TGroupbox 标题在调整大小时闪烁的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！