Flickering when TPageControl has many tabs - delphi

Question

My problem is that I have a TPageControl which contains a dynamically created number of tabs each containing a single (alClient) TMemo. When this number of tabs exceeds the width of the control and the scroll arrows appear on the tab header, all (well a large number) of my controls start to flicker a lot. This flicker only occurs when the pagecontrol is visible once you scroll out of view of the TPageControl it stops. When the pagecontrol is resized so that the scroll arrows are no longer required to see all of the tabs then the flickering stops.
I'm fairly confident that the problem is caused by the scroll arrows causing some painting to occur because when I set the TPageControl.MultiLine to true then there is no flickering. Ideally I wouldn't want to use MultiLine tabs and hope someone can provide a solution.
Information about form layout
I have a (Personal Details) form which contains a number of TSpeedButtons, TLabels, TEdits, a TImage and so on. Many of these elements are inside of a TScrollBox and are grouped into sections using TPanels. The panels are set to alTop in the scrollbox and have autosize set to true but their height never changes.
I have tried setting all controls to have DoubleBuffered set to true where possible and ParentBackground/Color = false but sadly nothing works.
I had flickering issues before adding the PageControls and using David's quick hack answer here TLabel and TGroupbox Captions Flicker on Resize I was able to improve the flickering when resizing the form. By extending TLabel and removing the background clearing from the Paint procedure, as recommended somewhere else, I was able to 99% remove the labels flickering when scrolling the ScrollBox but now I have a new flickering problem.
---EDIT---
Here is a link to a stripped down version of my form with the flickering occurring flickering example
Personnel.DetailsForm.pas
unit Personnel.DetailsForm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, System.Actions,
Vcl.ActnList, Vcl.Buttons, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.WinXCtrls, Vcl.Imaging.jpeg;
type
TPersonnelDetailsForm = class(TForm)
ScrollBox_Content: TScrollBox;
panel_AddressDetails: TPanel;
gpanel_Address: TGridPanel;
edit_HomeMobilePhone: TEdit;
edit_HomeTown: TEdit;
edit_HomeStreet: TEdit;
edit_HomePhone: TEdit;
lbl_HomeStreet: TLabel;
lbl_HomePhone: TLabel;
lbl_MobilePhone: TLabel;
lbl_HomeTown: TLabel;
edit_HomeState: TEdit;
edit_HomeEmail: TEdit;
edit_HomeCountry: TEdit;
edit_HomeFax: TEdit;
lbl_HomeState: TLabel;
lbl_Fax: TLabel;
lbl_Email: TLabel;
lbl_HomeCountry: TLabel;
edit_HomePostCode: TEdit;
lbl_HomePostCode: TLabel;
panel_HomeAddressTitle: TPanel;
panel_GeneralNotesDetails: TPanel;
gpanel_GeneralNotesDetails_: TGridPanel;
pageControl_GeneralNotes: TPageControl;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
PersonnelDetailsForm: TPersonnelDetailsForm;
implementation
{$R *.dfm}
uses
System.Math,
System.DateUtils,
System.Threading,
System.RegularExpressions,
System.StrUtils,
System.Contnrs,
System.UITypes,
System.Types,
Winapi.Shellapi,
Vcl.ExtDlgs;
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;
procedure TPersonnelDetailsForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Close the form and make sure it frees itself
Action := caFree; // Should allow it to free itself on close
self.Release; // Sends a Release message to itself as backup
end;
procedure TPersonnelDetailsForm.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
var Handled: Boolean);
var
LTopLeft, LTopRight, LBottomLeft, LBottomRight: Integer;
LPoint: TPoint;
begin
Handled := true;
// First you have to get the position of the control on screen
// as MousePos coordinates are based on the screen positions.
LPoint := self.ScrollBox_Content.ClientToScreen(Point(0, 0));
LTopLeft := LPoint.X;
LTopRight := LTopLeft + self.ScrollBox_Content.Width;
LBottomLeft := LPoint.Y;
LBottomRight := LBottomLeft + self.ScrollBox_Content.Width;
if (MousePos.X >= LTopLeft) and (MousePos.X <= LTopRight) and (MousePos.Y >= LBottomLeft) and (MousePos.Y <= LBottomRight) then
begin
// If the mouse is inside the scrollbox coordinates,
// scroll it by setting .VertScrollBar.Position.
self.ScrollBox_Content.VertScrollBar.Position := self.ScrollBox_Content.VertScrollBar.Position - WheelDelta;
Handled := true;
end;
if FindVCLWindow(MousePos) is TComboBox then
Handled := true;
end;
procedure TPersonnelDetailsForm.FormShow(Sender: TObject);
var
memo: TMemo;
tabsheet: TTabSheet;
ii: Integer;
begin
for ii := 0 to 7 do
begin
memo := TMemo.Create(self);
memo.Align := TAlign.alClient;
memo.ReadOnly := true;
memo.ScrollBars := TScrollStyle.ssVertical;
memo.ParentColor := false;
tabsheet := TTabSheet.Create(self);
tabsheet.InsertControl(memo);
tabsheet.PageControl := self.pageControl_GeneralNotes;
tabsheet.Caption := 'A New TabSheet ' + IntToStr(ii);
tabsheet.Tag := ii;
memo.Text := 'A New Memo ' + IntToStr(ii);
end;
EnableComposited(self);
self.ScrollBox_Content.ScrollInView(self.panel_AddressDetails);
self.Invalidate;
end;
end.
Personnel.DetailsForm.dfm
object PersonnelDetailsForm: TPersonnelDetailsForm
Left = 0
Top = 0
Caption = 'Personnel Details Form'
ClientHeight = 371
ClientWidth = 800
Color = clBtnFace
DoubleBuffered = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnMouseWheel = FormMouseWheel
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 17
object ScrollBox_Content: TScrollBox
Left = 0
Top = 0
Width = 800
Height = 371
VertScrollBar.Smooth = True
VertScrollBar.Tracking = True
Align = alClient
TabOrder = 0
object panel_AddressDetails: TPanel
Tag = 101
Left = 0
Top = 0
Width = 796
Height = 174
Align = alTop
Padding.Left = 5
Padding.Top = 5
Padding.Right = 5
Padding.Bottom = 5
ParentBackground = False
TabOrder = 0
object gpanel_Address: TGridPanel
Left = 6
Top = 30
Width = 784
Height = 138
Align = alClient
BevelOuter = bvNone
ColumnCollection = <
item
SizeStyle = ssAbsolute
Value = 105.000000000000000000
end
item
Value = 50.000762951094850000
end
item
SizeStyle = ssAbsolute
Value = 105.000000000000000000
end
item
Value = 49.999237048905160000
end>
ControlCollection = <
item
Column = 3
Control = edit_HomeMobilePhone
Row = 1
end
item
Column = 1
Control = edit_HomeTown
Row = 1
end
item
Column = 1
Control = edit_HomeStreet
Row = 0
end
item
Column = 3
Control = edit_HomePhone
Row = 0
end
item
Column = 0
Control = lbl_HomeStreet
Row = 0
end
item
Column = 2
Control = lbl_HomePhone
Row = 0
end
item
Column = 2
Control = lbl_MobilePhone
Row = 1
end
item
Column = 0
Control = lbl_HomeTown
Row = 1
end
item
Column = 1
Control = edit_HomeState
Row = 2
end
item
Column = 3
Control = edit_HomeEmail
Row = 2
end
item
Column = 1
Control = edit_HomeCountry
Row = 3
end
item
Column = 3
Control = edit_HomeFax
Row = 3
end
item
Column = 0
Control = lbl_HomeState
Row = 2
end
item
Column = 2
Control = lbl_Fax
Row = 3
end
item
Column = 2
Control = lbl_Email
Row = 2
end
item
Column = 0
Control = lbl_HomeCountry
Row = 3
end
item
Column = 1
Control = edit_HomePostCode
Row = 4
end
item
Column = 0
Control = lbl_HomePostCode
Row = 4
end>
Padding.Left = 1
Padding.Top = 1
Padding.Right = 1
Padding.Bottom = 1
RowCollection = <
item
SizeStyle = ssAbsolute
Value = 27.000000000000000000
end
item
SizeStyle = ssAbsolute
Value = 27.000000000000000000
end
item
SizeStyle = ssAbsolute
Value = 27.000000000000000000
end
item
SizeStyle = ssAbsolute
Value = 27.000000000000000000
end
item
SizeStyle = ssAbsolute
Value = 27.000000000000000000
end>
TabOrder = 0
object edit_HomeMobilePhone: TEdit
Left = 498
Top = 29
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 6
Text = 'Mobile Phone'
end
object edit_HomeTown: TEdit
Left = 107
Top = 29
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 1
Text = 'Home Town'
end
object edit_HomeStreet: TEdit
Left = 107
Top = 2
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 0
Text = 'Home Street'
end
object edit_HomePhone: TEdit
Left = 498
Top = 2
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 5
Text = 'Home Phone'
end
object lbl_HomeStreet: TLabel
Left = 2
Top = 2
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'Street: '
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
Transparent = True
Layout = tlCenter
ExplicitLeft = 61
ExplicitWidth = 44
ExplicitHeight = 17
end
object lbl_HomePhone: TLabel
Left = 393
Top = 2
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'Home Phone: '
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentFont = False
Layout = tlCenter
ExplicitLeft = 408
ExplicitWidth = 88
ExplicitHeight = 17
end
object lbl_MobilePhone: TLabel
Left = 393
Top = 29
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'Mobile Phone: '
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentFont = False
Layout = tlCenter
ExplicitLeft = 402
ExplicitWidth = 94
ExplicitHeight = 17
end
object lbl_HomeTown: TLabel
Left = 2
Top = 29
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'Town: '
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
Transparent = True
Layout = tlCenter
ExplicitLeft = 64
ExplicitWidth = 41
ExplicitHeight = 17
end
object edit_HomeState: TEdit
Left = 107
Top = 56
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 2
Text = 'Home State'
end
object edit_HomeEmail: TEdit
Left = 498
Top = 56
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 7
Text = 'Home Email'
end
object edit_HomeCountry: TEdit
Left = 107
Top = 83
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 3
Text = 'Home Country'
end
object edit_HomeFax: TEdit
Left = 498
Top = 83
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 8
Text = 'Home Fax'
end
object lbl_HomeState: TLabel
Left = 2
Top = 56
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'State: '
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
Transparent = True
Layout = tlCenter
ExplicitLeft = 66
ExplicitWidth = 39
ExplicitHeight = 17
end
object lbl_Fax: TLabel
Left = 393
Top = 83
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'Fax: '
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentFont = False
Layout = tlCenter
ExplicitLeft = 467
ExplicitWidth = 29
ExplicitHeight = 17
end
object lbl_Email: TLabel
Left = 393
Top = 56
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'Email: '
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentFont = False
Layout = tlCenter
ExplicitLeft = 454
ExplicitWidth = 42
ExplicitHeight = 17
end
object lbl_HomeCountry: TLabel
Left = 2
Top = 83
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'Country: '
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
Transparent = True
Layout = tlCenter
ExplicitLeft = 47
ExplicitWidth = 58
ExplicitHeight = 17
end
object edit_HomePostCode: TEdit
Left = 107
Top = 110
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 4
Text = 'Home Post Code'
end
object lbl_HomePostCode: TLabel
Left = 2
Top = 110
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'Post Code: '
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
Transparent = True
Layout = tlCenter
ExplicitLeft = 35
ExplicitWidth = 70
ExplicitHeight = 17
end
end
object panel_HomeAddressTitle: TPanel
Left = 6
Top = 6
Width = 784
Height = 24
Align = alTop
Alignment = taLeftJustify
BevelOuter = bvNone
Caption = ' Home Address '
Color = clMedGray
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold, fsUnderline]
ParentBackground = False
ParentFont = False
TabOrder = 1
end
end
object panel_GeneralNotesDetails: TPanel
Tag = 303
Left = 0
Top = 174
Width = 796
Height = 172
Align = alTop
AutoSize = True
Padding.Left = 5
Padding.Top = 5
Padding.Right = 5
Padding.Bottom = 5
ParentBackground = False
TabOrder = 1
object gpanel_GeneralNotesDetails_: TGridPanel
Left = 6
Top = 6
Width = 784
Height = 160
Align = alTop
BevelOuter = bvNone
ColumnCollection = <
item
Value = 100.000000000000000000
end>
ControlCollection = <
item
Column = 0
Control = pageControl_GeneralNotes
Row = 0
end>
Padding.Left = 1
Padding.Top = 1
Padding.Right = 1
Padding.Bottom = 1
RowCollection = <
item
SizeStyle = ssAbsolute
Value = 160.000000000000000000
end>
TabOrder = 0
object pageControl_GeneralNotes: TPageControl
Left = 2
Top = 2
Width = 780
Height = 158
Align = alClient
TabOrder = 0
end
end
end
end
end

Answer 1

I figured out that the problem was caused by the quick hack David answered to TLabel and TGroupbox Captions Flicker on Resize after I removed that the mad flickering when the TPageControl tab scroll buttons were visible went away. So now I'll have to look at his more in-depth solution and see if that can help with some of the flickering I was seeing before.