當 TPageControl 有很多選項卡時閃爍
[英]Flickering when TPageControl has many tabs
問題描述
我的問題是我有一個TPageControl ，它包含動態創建的多個選項卡，每個選項卡包含一個 ( alClient ) TMemo 。 當這個選項卡數量超過控件的寬度並且滾動箭頭出現在選項卡標題上時，我的所有（以及大量）控件開始大量閃爍。 僅當您滾動出它停止的TPageControl的視圖時TPageControl可見時才會發生此閃爍。 當頁面控件調整大小以便不再需要滾動箭頭來查看所有選項卡時，閃爍停止。
我相當確信問題是由滾動箭頭引起的，導致一些繪畫發生，因為當我將TPageControl.MultiLine設置為 true 時，沒有閃爍。 理想情況下，我不想使用 MultiLine 選項卡，希望有人能提供解決方案。
有關表單布局的信息
我有一個（個人詳細信息）表單，其中包含許多TSpeedButtons 、 TLabels 、 TEdits 、 TImage等。 其中許多元素都在TScrollBox內，並使用TPanels分組到多個部分中。 面板在滾動框中設置為alTop並且將 autosize 設置為 true 但它們的高度永遠不會改變。
我已經嘗試將所有控件設置為在可能的情況下將DoubleBuffered設置為 true 並且ParentBackground/Color = false但遺憾的是沒有任何效果。
我在添加 PageControls 之前遇到了閃爍問題，並在此處使用 David 的快速 hack 答案TLabel 和 TGroupbox Captions Flicker on Resize我能夠在調整表單大小時改善閃爍。 按照其他地方的建議，通過擴展 TLabel 並從 Paint 過程中移除背景清除，我能夠在滾動 ScrollBox 時移除 99% 的標簽閃爍，但現在我遇到了一個新的閃爍問題。
---編輯---
這是指向我的表單的精簡版本的鏈接，其中包含閃爍發生的閃爍示例
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
1 個解決方案
解決方案1
2 已采納 2016-05-27 03:26:00
我發現問題是由David 在調整大小時回答TLabel 和 TGroupbox Captions Flicker 時的快速 hack引起的，在我刪除了TPageControl選項卡滾動按鈕可見時的瘋狂閃爍消失后。 所以現在我必須看看他更深入的解決方案，看看這是否有助於解決我之前看到的一些閃爍問題。
如何將TPageControl選項卡分解為Delphi中的單獨文件？
[英]How to break up TPageControl tabs into seperate files in Delphi?
如何修復Tab作為TPageControl上的第一個選項卡，並在選項卡上導航時保持顯示？
[英]How to fix a Tab as first tab on TPageControl and keep it showing while navigating on tabs?
將表單停靠在選項卡上時，所有者繪制的TPageControl OnMouse事件無法觸發
[英]Owner Drawn TPageControl OnMouse events fail to fire when docking a form as a tab
聲明:本站的技術帖子網頁，遵循CC BY-SA 4.0協議，如果您需要轉載，請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.
相關問題
Delphi TPageControl不響應選項卡上的單擊
使用tpagecontrol時的所有權原則
如何將TPageControl選項卡分解為Delphi中的單獨文件？
如何修復Tab作為TPageControl上的第一個選項卡，並在選項卡上導航時保持顯示？
TNotebook或TPageControl
將表單停靠在選項卡上時，所有者繪制的TPageControl OnMouse事件無法觸發
Delphi 2006中的TPageControl組件
TPageControl上的TLinkLabel背景
動態創建Tpagecontrol實例
在 Delphi 7 中制作 TPageControl 平面
相關標簽