创建 TFrames 并将其分配给父控件时如何避免显示 "flicker"
How to avoid display "flicker" when creating and assigning TFrames to a parent control
例如:我有一个 TFrame(称为 TPageFrame),它有许多控件,例如TreeView 左对齐,拆分器和主客户区由编辑和 RichEdit 组成,如下图所示:
代码看起来像这样:
type
TPageFrame = class(TFrame)
Panel1: TPanel;
Splitter1: TSplitter;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Edit1: TEdit;
RichEdit1: TRichEdit;
TreeView1: TTreeView;
private
{ Private declarations }
public
end;
在主窗体中,我有一个带有几个选项卡的 RzTabControl。当我移动到一个新选项卡时,将创建一个新框架(存储在一个框架数组中)并且它的父级设置为 RzTabControl。
type
TForm1 = class(TForm)
RzTabControl1: TRzTabControl;
procedure RzTabControl1Change(Sender: TObject);
private
{ Private declarations }
FFrameArr: array[0..5] of TPageFrame;
public
{ Public declarations }
end;
procedure TForm1.RzTabControl1Change(Sender: TObject);
var
Index: Integer;
PageFrame: TPageFrame;
begin
Index := RzTabControl1.TabIndex;
Self.Caption := Index.ToString;
if FFrameArr[Index] = nil then
begin
PageFrame := TPageFrame.Create(Self);
PageFrame.Name := 'PageFrame' + Index.ToString;
PageFrame.Parent := RzTabControl1;
PageFrame.Align := alClient;
PageFrame.Visible := True;
FFrameArr[Index] := PageFrame;
end;
end;
问题:在创建框架并设置其父级时,有很多 "Display noise":
查看编辑控件如何在 2 个位置绘制两次。 (用视频演示会更容易...)
如何避免这种闪烁?
感谢@HeartWare,基于How can I disable screen update which updating a lot of controls?
效果非常好:
if FFrameArr[Index] = nil then
begin
Screen.Cursor := crHourGlass;
// Defer updates
SendMessage(Handle, WM_SETREDRAW, WPARAM(False), 0);
try
PageFrame := TPageFrame.Create(Self);
PageFrame.Name := 'PageFrame' + Index.ToString;
PageFrame.Visible := False;
PageFrame.Parent := RzTabControl1;
PageFrame.Align := alClient;
PageFrame.Visible := True;
FFrameArr[Index] := PageFrame;
finally
// Make sure updates are re-enabled
SendMessage(Handle, WM_SETREDRAW, WPARAM(True), 0);
PageFrame.Hide;
PageFrame.Show;
RzTabControl1.Invalidate;
Screen.Cursor := crDefault;
end;
end;
@RaelB 的代码存在一些问题,例如 try/finally 的不正确使用、未处理本地创建的变量可能出现的任何异常等。
正确的 (IMO) 代码应该是:
if not Assigned(FFrameArr[Index]) then begin
Screen.Cursor := crHourGlass;
try
// Defer updates
SendMessage(Handle, WM_SETREDRAW, WPARAM(False), 0);
try
PageFrame := TPageFrame.Create(Self);
try
PageFrame.Name := 'PageFrame' + Index.ToString;
PageFrame.Visible := False;
PageFrame.Parent := RzTabControl1;
PageFrame.Align := alClient;
PageFrame.Visible := True;
FFrameArr[Index] := PageFrame;
except
PageFrame.Free;
raise
end;
finally
// Make sure updates are re-enabled
SendMessage(Handle, WM_SETREDRAW, WPARAM(True), 0);
end;
PageFrame.Hide;
PageFrame.Show;
RzTabControl1.Invalidate;
finally
Screen.Cursor := crDefault;
end;
end;
例如:我有一个 TFrame(称为 TPageFrame),它有许多控件,例如TreeView 左对齐,拆分器和主客户区由编辑和 RichEdit 组成,如下图所示:
代码看起来像这样:
type
TPageFrame = class(TFrame)
Panel1: TPanel;
Splitter1: TSplitter;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Edit1: TEdit;
RichEdit1: TRichEdit;
TreeView1: TTreeView;
private
{ Private declarations }
public
end;
在主窗体中,我有一个带有几个选项卡的 RzTabControl。当我移动到一个新选项卡时,将创建一个新框架(存储在一个框架数组中)并且它的父级设置为 RzTabControl。
type
TForm1 = class(TForm)
RzTabControl1: TRzTabControl;
procedure RzTabControl1Change(Sender: TObject);
private
{ Private declarations }
FFrameArr: array[0..5] of TPageFrame;
public
{ Public declarations }
end;
procedure TForm1.RzTabControl1Change(Sender: TObject);
var
Index: Integer;
PageFrame: TPageFrame;
begin
Index := RzTabControl1.TabIndex;
Self.Caption := Index.ToString;
if FFrameArr[Index] = nil then
begin
PageFrame := TPageFrame.Create(Self);
PageFrame.Name := 'PageFrame' + Index.ToString;
PageFrame.Parent := RzTabControl1;
PageFrame.Align := alClient;
PageFrame.Visible := True;
FFrameArr[Index] := PageFrame;
end;
end;
问题:在创建框架并设置其父级时,有很多 "Display noise":
查看编辑控件如何在 2 个位置绘制两次。 (用视频演示会更容易...)
如何避免这种闪烁?
感谢@HeartWare,基于How can I disable screen update which updating a lot of controls?
效果非常好:
if FFrameArr[Index] = nil then
begin
Screen.Cursor := crHourGlass;
// Defer updates
SendMessage(Handle, WM_SETREDRAW, WPARAM(False), 0);
try
PageFrame := TPageFrame.Create(Self);
PageFrame.Name := 'PageFrame' + Index.ToString;
PageFrame.Visible := False;
PageFrame.Parent := RzTabControl1;
PageFrame.Align := alClient;
PageFrame.Visible := True;
FFrameArr[Index] := PageFrame;
finally
// Make sure updates are re-enabled
SendMessage(Handle, WM_SETREDRAW, WPARAM(True), 0);
PageFrame.Hide;
PageFrame.Show;
RzTabControl1.Invalidate;
Screen.Cursor := crDefault;
end;
end;
@RaelB 的代码存在一些问题,例如 try/finally 的不正确使用、未处理本地创建的变量可能出现的任何异常等。
正确的 (IMO) 代码应该是:
if not Assigned(FFrameArr[Index]) then begin
Screen.Cursor := crHourGlass;
try
// Defer updates
SendMessage(Handle, WM_SETREDRAW, WPARAM(False), 0);
try
PageFrame := TPageFrame.Create(Self);
try
PageFrame.Name := 'PageFrame' + Index.ToString;
PageFrame.Visible := False;
PageFrame.Parent := RzTabControl1;
PageFrame.Align := alClient;
PageFrame.Visible := True;
FFrameArr[Index] := PageFrame;
except
PageFrame.Free;
raise
end;
finally
// Make sure updates are re-enabled
SendMessage(Handle, WM_SETREDRAW, WPARAM(True), 0);
end;
PageFrame.Hide;
PageFrame.Show;
RzTabControl1.Invalidate;
finally
Screen.Cursor := crDefault;
end;
end;