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和TLabel都会闪烁。不在TGroupboxes内的TLabel很好，不会闪烁。

我尝试过的事情：

WM_SETREDRAW后跟RedrawWindow
TGroupBoxes和TLabels上的ParentBackground设置为False
DoubleBuffer：= True
LockWindowUpdate（是的，即使我知道这是非常错误的）
透明：=假（甚至覆盖创建以编辑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;

例如，在您OnShow的{{1}}中调用此方法，并传递表单实例。如果这有帮助那么你真的应该更加挑剔地实施它。我从我的代码中提供了相关摘录，以说明我是如何做到的。

完整代码

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循环。请注意，我还使用自定义拆分器，当它处于活动状态时调用BeginSizing / EndSizing。

另一个有用的技巧是使用for代替TStaticText，当您对页面控件和面板进行深度嵌套时，有时需要这样做。

我已经使用此代码使我的应用程序100％无闪烁，但我花了很多年龄和实验时间来完成所有这些操作。希望其他人可以在这里找到一些有用的东西。

Answer 2

使用VCL Fix Pack中的Andreas Hausladen。

此外：不要指定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;

Answer 3

这是我在项目中以多种形式成功使用的解决方案。它有点脏，因为它使用winapi功能。与大卫回答相比，它不包括性能损失。重点是为表单及其所有子窗口覆盖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);
}

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

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重复此步骤

TLabel和TGroupbox Captions在调整大小时闪烁

4 个答案: