By ThievingSix


2011-11-08 23:59:19 8 Comments

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

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.

Things I've tried:

  • 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)

Any ideas?

4 comments

@Codebeat 2015-09-17 17:23:16

Put above your form (interface) or put it all in a new last unit to include:

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

Put this in implementation part

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

repeat this step for TGroupBox

@kidbro 2018-05-14 14:53:47

To avoid flickering on TGroupbox i set it's 'ParentBackground' property to false and 'DoubleBuffer' prop to true.

@Codebeat 2018-05-14 22:00:00

'repeat this step for TGroupBox', is in the answer,

@truthseeker 2015-08-13 14:07:49

This is solution I use with success in my project in a number of forms. Its a little bit dirty because it uses winapi functions. In comparison with David answer it doesnt includes performance penalty. The point is to overwrite message handler for WM_ERASEBKGND message for form and all of its child windows.

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);
}

Important note: DoubleBufferd property for form must be set on if you dont want to see black stripes on sides !

@David Heffernan 2011-11-09 05:18:38

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.

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:

Quick hack

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;

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.

Full code

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;

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.

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.

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.

@LU RD 2011-11-09 07:29:58

+1, TStaticText saves your day when using panels and page controls instead of TLabel.

@Marjan Venema 2011-11-09 07:31:56

Oh yes, I most certainly can find something useful in here :-) Thanks and +1

@truthseeker 2013-11-14 11:27:24

Unfortunately this solution does not function when Aero visual interface is enabled in Window Vista and later OS.

@David Heffernan 2013-11-14 11:30:38

@truthseeker Nope. Works fine on all Windows versions. Did you note the behaviour switch in the code? XP is a special case.

@NGLN 2011-11-09 03:21:13

Use the VCL Fix Pack from Andreas Hausladen.

Additionally: do not specify the SWP_NOCOPYBITS flag, and set DoubleBuffered of the PageControl:

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;

@ThievingSix 2011-11-09 20:33:31

I haven't heard of the VCL Fix Pack, I will try it out.

@kidbro 2018-05-14 14:38:26

Does not apply to d2010

Related Questions

Sponsored Content

12 Answered Questions

[SOLVED] How to fix the flickering in User controls

1 Answered Questions

[SOLVED] Flickering when TPageControl has many tabs

1 Answered Questions

C++ Builder - Multiple changes to main menu

1 Answered Questions

[SOLVED] Stop Label Caption Flickering

1 Answered Questions

[SOLVED] Delphi TSplitter flickering issue

2 Answered Questions

[SOLVED] Transparent background color in TGroupBox - DELPHI

  • 2012-11-09 09:58:16
  • stacker
  • 2848 View
  • 3 Score
  • 2 Answer
  • Tags:   delphi groupbox

1 Answered Questions

[SOLVED] Adding non-VCL window into VCL align queue

2 Answered Questions

[SOLVED] How can I reduce PageControl flicker in Delphi?

Sponsored Content