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

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(是的,即使我知道这是非常错的)
• 透明:= 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;

例如,在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%无闪烁,但我花了很多年龄和实验时间来完成所有这些.希望其他人可以在这里找到一些有用的东西.

Answer 2

使用VCL修订包从安德烈亚斯Hausladen.

另外:不指定SWP_NOCOPYBITS标志和DoubleBufferedPageControl的设置:

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;