Как избежать появления «мерцания» при создании и назначении TFrames для родительского элемента управления - PullRequest
1 голос
/ 16 мая 2019

Например: у меня есть TFrame (называемый TPageFrame), который имеет ряд элементов управления, например, TreeView выровненный по левому краю, разделитель и основная клиентская область, состоящая из edit и RichEdit, как на рисунке ниже:

enter image description here

Код выглядит примерно так:

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;

Проблема: во время создания фрейма и егоВ родительском наборе присутствует много «шумов дисплея»:

enter image description here

Посмотрите, как элемент управления редактирования окрашивается дважды в 2 позициях.(Было бы проще продемонстрировать это с помощью видео ...)

Как можно избежать такого мерцания?

Ответы [ 2 ]

3 голосов
/ 16 мая 2019

Есть несколько проблем с кодом @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;
0 голосов
/ 16 мая 2019

Благодаря @HeartWare на основе Как отключить обновление экрана, которое обновляет множество элементов управления?

Это работает замечательно:

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