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

Question

• 我的应用程序加载不同的插件，并为每个插件创建一个新的选项卡(Tab)。
• 每个DLL文件都有一个关联的TForm表单。
• 这些表单会以新的TTabSheet作为其父级hWnd创建。

• 由于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;

现在我的问题是，当应用程序被调整大小时，所有的TGroupBoxes和里面的TLabels都会闪烁。那些不在TGroupBoxes内的TLabels则正常且不会闪烁。

我尝试过以下方法：

- WM_SETREDRAW后跟RedrawWindow - TGroupBoxes和TLabels的ParentBackground设置为False - DoubleBuffer := True - LockWindowUpdate（是的，即使我知道这是非常非常错误的） - Transparent := False（甚至重写create以编辑ControlState）

有什么想法吗？

- ThievingSix

---

这个问题在回答和评论中有一些额外的想法：https://dev59.com/UFHTa4cB1Zd3GeqPRW-O - Argalatyr

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>。 我使用这段代码使我的应用程序完全无闪烁，但我花费了很长时间进行试验才得以实现。希望其他人能从中找到有用的东西。

- David Heffernan

---

在使用面板和页面控件而非标签控件时，TStaticText可以帮助你解决问题。+1 - LU RD

哦，是的，我肯定可以在这里找到一些有用的东西 :-) 谢谢和+1 - Marjan Venema

很遗憾，当Aero视觉界面在Windows Vista及更高版本的操作系统中启用时，此解决方案无法正常工作。 - truthseeker

@truthseeker 不对。在所有的Windows版本上都可以正常工作。你有注意到代码中的行为开关吗？XP是一个特殊情况。 - David Heffernan

Answer 2

使用 Andreas Hausladen 的 VCL Fix Pack。

此外：不要指定SWP_NOCOPYBITS标志，并设置PageControl的DoubleBuffered属性:

uses
  VCLFixPack;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PageControl1.DoubleBuffered := True;

  //Setup test conditions:
  FForm2 := TForm2.Create(Self);
  FForm2.BorderStyle := bsNone;
  FForm2.BoundsRect := TabSheet1.ClientRect;
  Windows.SetParent(FForm2.Handle, TabSheet1.Handle);
  FForm2.Show;
  PageControl1.Anchors := [akLeft, akTop, akRight, akBottom];
  PageControl1.OnResize := PageControl1Resize;
end;

procedure TForm1.PageControl1Resize(Sender: TObject);
begin
  SetWindowPos(FForm2.Handle, 0, 0, 0, TabSheet1.ClientWidth,
    TabSheet1.ClientHeight, SWP_NOZORDER + SWP_NOACTIVATE);
end;

- NGLN

---

我还没有听说过VCL Fix Pack，我会试一下。 - ThievingSix

不适用于d2010 - john_who_is_doe

Answer 3

这是我在项目中使用过的成功解决方案，适用于多种表单。它有点不太优雅，因为它使用了WinAPI函数。与David的答案相比，它不会降低性能。关键在于覆盖表单及其所有子窗口的WM_ERASEBKGND消息处理程序，防止重复绘制同一区域，导致闪烁。

typedef LRESULT CALLBACK(*PWndProc)(HWND, UINT, WPARAM, LPARAM);

void SetNonFlickeringWndProc(TWinControl &control, std::map<HWND,PWndProc> &list, PWndProc new_proc)
{
   if (control.Handle == 0)
   {
      return;
   }

   PWndProc oldWndProc = (PWndProc)SetWindowLong(control.Handle, GWL_WNDPROC, (LONG)new_proc);
   list[control.Handle] = oldWndProc;

   int count = control.ControlCount;
   for (int i = 0; i < count; i++)
   {
      TControl *child_control = control.Controls[i];
      TWinControl *child_wnd_control = dynamic_cast<TWinControl*>(child_control);
      if (child_wnd_control == NULL)
      {
         continue;
      }

      SetNonFlickeringWndProc(*child_wnd_control, list, new_proc);
   }
}

void RestoreWndProc(std::map<HWND,PWndProc> &old_wnd_proc)
{
   std::map<HWND,PWndProc>::iterator it;
   for (it = old_wnd_proc.begin(); it != old_wnd_proc.end(); it++)
   {
      LONG res = SetWindowLong(it->first, GWL_WNDPROC, (LONG)it->second);
   }
   old_wnd_proc.clear();
}

std::map<HWND,PWndProc> oldwndproc;   // addresses for window procedures for all components in form

LRESULT CALLBACK NonFlickeringWndProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam)
{
    if (uMsg == WM_ERASEBKGND)
    {
        return 1;
    }
    return ((PWndProc)oldwndproc[hwnd])(hwnd, uMsg, wParam, lParam);
}

void __fastcall TForm1::FormShow(TObject *Sender)
{
   oldwndproc.clear();
   SetNonFlickeringWndProc(*this, oldwndproc, &NonFlickeringWndProc);
}

void __fastcall TForm1::FormClose(TObject* Sender, TCloseAction& Action)
{
   RestoreWndProc(oldwndproc_etype);
}

重要提示：如果您不想在两侧看到黑色条纹，则必须设置表单的 DoubleBuffered 属性！

- truthseeker

Answer 4

将表单（界面）置于其上方，或将其全部放入新的最后一个单元中以进行包含：

TLabel = class( stdCtrls.TLabel )
  protected
   procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
  end;

把这个放在实现部分。

procedure TLabel.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
 Message.Result:=1; // Fake erase
end;

重复此步骤以获取 TGroupBox。

- Codebeat

---

为了避免TGroupbox上的闪烁，我将其 'ParentBackground' 属性设置为false，同时将 'DoubleBuffer' 属性设置为true。 - john_who_is_doe

在编程中，将“repeat this step for TGroupBox”这一步骤重复执行即可。 - Codebeat