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

Question

• 所以，我有一个应用程序加载不同的插件并创建一个每个 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
• 双缓冲:=真
• LockWindowUpdate(是的，尽管我知道这是非常错误的)
• Transparent := False(甚至覆盖 create 来编辑 ControlState)

有什么想法吗？

Answer 1

我发现唯一有效的方法是使用 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;

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

完整代码

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% 无闪烁，但我花了很多年的时间进行实验才将其全部到位。希望其他人可以在这里找到有用的东西。