TLabel和TGroupbox Captions Flicker on Resize [英] TLabel and TGroupbox Captions Flicker on Resize

问题描述

• 所以，我有一个应用程序加载不同的插件，并在每一个TPageControl上创建一个
  的新标签。


• 每个DLL都有一个与它相关联的TForm。


• 表单是以其父级hWnd作为新的TTabSheet创建的。



• 由于TTabSheets不是表单的父母就VCL而言（不想使用动态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;

现在，我的问题是，当应用程序调整大小，TGroupBox中的所有TGroupBox和TLabels闪烁。不在TGroupbox内的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


• 设置为False的TGroupBoxes和TLabel上的ParentBackground
  
• DoubleBuffer：= True


• LockWindowUpdate（是的，即使我知道这是非常错误的）


• 透明：= False（甚至覆盖创建来编辑ControlState ）

• WM_SETREDRAW followed by a RedrawWindow
• ParentBackground on the TGroupBoxes and TLabels set to False
• DoubleBuffer := True
• LockWindowUpdate (Yes, even though I know it's very very wrong)
• Transparent := False (even overriding create to edit 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;

例如，在 OnShow 为您的 TForm ，传递表单实例。如果这有帮助，那么你真的应该更明智地实施它。我给我提供了相关的摘录，以说明我是如何做到的。

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 是我的实用程序，用于将子控件的递归步调转换为循环的平面。注意，我还使用一个自定义分割器，当它处于活动状态时调用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 而不是 c> 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 Captions Flicker on Resize的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！