Редизайн интерфейса приложения. #9

Минитест на знание VCL

Я решил отнести данный пост к рубрике Редизайн Интерфейса, как наглядный пример того, что заменяя один компонент на другой, пусть и очень похожий функционально, не всегда получается “машинально” обновлять код, используя различные варианты автозамены и прочие ухищрения. Иногда приходится осуществлять полноценный рефакторинг.

Вчера попался мне примерно такой код (я его немного упростил):

procedure TfTest.Button2Click(Sender: TObject);
var
  i: integer;
begin
  i := 0;
  while PageControl1.PageCount > 1 do
  begin
    if PageControl1.ActivePageIndex = i then
    begin
      Inc(i);
      Continue;
    end;

    PageControl1.Pages[i].Free;
  end;
end;

Задача вполне тривиальная. Необходимо удалить все страницы PageControl’а кроме активной. Понятно, что реализация не самая элегантная, но на первый взгляд код вполне рабочий. Найдёте ошибку не заглядывая под кат?

Да, код не рабочий. Создайте три страницы для PageControl, сделайте активной последнюю и попробуйте воспроизвести код.  Останется одна страница, но не последняя, а вторая. Даже если преобразовать код как показано ниже, работать он не будет.

procedure TfMainVCL.Button2Click(Sender: TObject);
var
  i: integer;
begin
  for i := PageControl1.PageCount - 1 downto 0 do
  begin
    if PageControl1.ActivePageIndex = i then
      Continue;
    PageControl1.Pages[i].Free;
  end;

end;

Для того, что бы убедиться в этом попробуйте сделать активной вторую страницу. После выполнения кода, вопреки ожиданиям, останется не вторая, а первая страница. Всё объясняется очень просто. При удалении страницы активной становится следующая за удаляемой. Если же удаляется последняя страница, то активной становится первая. Я не поленился и посмотрел код компонента TPageControl. Там я обнаружил следующий protected метод

procedure TPageControl.RemovePage(Page: TTabSheet);
var
  NextSheet: TTabSheet;
begin
  NextSheet := FindNextPage(Page, True, not (csDesigning in ComponentState));
  if NextSheet = Page then NextSheet := nil;
  Page.SetTabShowing(False);
  Page.FPageControl := nil;
  FPages.Remove(Page);
  SetActivePage(NextSheet);
end;

Таким образом, практически всё становится на свои места.

Если говорить о решении данной задачи, то навскидку мне пришел в голову такой вариант:

procedure TfMainVCL.Button3Click(Sender: TObject);
var
  i: integer;
  ap: TTabSheet;
begin

  ap := PageControl1.ActivePage;
  ap.PageControl := nil;

  for i := PageControl1.PageCount - 1 downto 0 do
    PageControl1.Pages[i].Free;

  ap.PageControl := PageControl1;
end;

Кстати, в случае с TTabControl в FireMonkey всё работает иначе. После выполнения кода

TabControl1.Tabs[1].Free;

активной остаётся всё таже вкладка.