Наполняем базовую форму полезным кодом

Предыдущие заметки по теме: номер раз, номер два.

Для начала я наполню базовую форму довольно простыми, но полезными вещами. Это будут обработчики сообщений, а потому нам не нужно будет переустанавливать пакет с визардом. Затем добавлю пару published-свойств, и, переустановив пакет, мы эти свойства увидим в инспекторе объектов.

Решение проблемы с иконкой в Aero

Проблема наблюдается при включённой теме Aero в Windows: если закрыть окно, то видно, как иконка приложения меняется на иконку по умолчанию.

Это заметно как раз в тот момент, когда окно начинает уменьшаться и плавно исчезает с экрана (верхняя часть картинки):

 

А происходит это потому, что в момент уничтожения окна VCL посылает сообщение WM_SETICON со значением HICON = 0.

Проблему я решил таким образом:

..
    procedure WMSetIcon(var Message: TWMSetIcon); message WM_SETICON;
..
procedure TBaseForm.WMSetIcon(var Message: TWMSetIcon);
begin
  // В момент уничтожения окна игнорируем установку иконки (иначе это заметно при анимации в Windows Aero)
  if (csDesigning in ComponentState) or not (csDestroying in ComponentState) then
    inherited;
end;

Решение проблемы при сворачивании модального окна

Если пользователь свернёт модальную форму, то модальная форма свернётся не в панель задач, а в нижнюю часть рабочего стола. Причём родительская форма останется на экране и одновременно не доступной для пользователя. Такое поведение вводит пользователя в недоумение, а в последствии приучает программиста отключать возможность сворачивать окно. Я же предлагаю кнопку [Minimize] в модальных формах не отключать, оставив пользователю возможность свернуть приложение целиком. Для этого отлавливаем сообщение WM_SYSCOMMAND:

..
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
..
procedure TBaseForm.WMSysCommand(var Message: TWMSysCommand);
begin
  // Если окно открыто в модальном режиме, то, вместо сворачивания окна, сворачиваем приложение
  if (Message.CmdType = SC_MINIMIZE) and (fsModal in FormState) then
    Application.Minimize
  else
    inherited;
end;

Однако, при разворачивании приложения из Панели задач VCL (почему-то) устанавливает фокус ввода в главную форму (а не последнюю модальную форму), что может привести к непредсказуемому результату. Поэтому дополнительно обрабатываем сообщение WM_ACTIVATE.

..
    procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;
..
var
  IsRestoringPositions: Boolean;

procedure RestoreFormsPositions;
var
  List: TList;
  i: Integer;
  F: TCustomForm;
begin
  if IsRestoringPositions then
    Exit;
  IsRestoringPositions := True;
  try
    List := TList.Create;
    try
      // сначала сохраняем список окон в том порядке, в хотором они были отображены
      List.Capacity := Screen.CustomFormCount;
      for i := 0 to Screen.CustomFormCount - 1 do
        List.Add(Screen.CustomForms[i]);

      // теперь восстанавливаем этот порядок
      for i := List.Count - 1 downto 0 do
      begin
        F := TCustomForm(List[i]);
        BringWindowToTop(F.Handle);
      end;
    finally
      List.Free;
    end;
  finally
    IsRestoringPositions := False;
  end;
end;
..
procedure TBaseForm.WMActivate(var Message: TWMActivate);
begin
  if not (csDesigning in ComponentState) and (Message.Active > 0) and not IsWindowEnabled(Handle) then
    // здесь: наше окно отключено, но каким-то образом активируется
    // скорее всего есть модальные окна, если такие есть - то надо их показать
    RestoreFormsPositions;
  inherited;
end;

Автоматическое закрытие окна по клавише Escape

Об этом я уже писал ранее. Единственное, для удобства, добавим свойство CloseByEscape, которое по умолчанию выставлено в True.

..
  private
    FCloseByEscape: Boolean;
    procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
  protected
    procedure InitializeNewForm; override;
  published
    property CloseByEscape: Boolean read FCloseByEscape write FCloseByEscape default True;
..
procedure TBaseForm.InitializeNewForm;
begin
  inherited InitializeNewForm;
  FCloseByEscape := True;
end;

procedure TBaseForm.CMDialogKey(var Message: TCMDialogKey);
begin
  // обработка CloseByEscape
  if CloseByEscape then
    with Message do
      if (CharCode = VK_ESCAPE) and (KeyDataToShiftState(KeyData) = []) then
      begin
        // для модального режима - говорим Cancel
        if fsModal in FormState then
        begin
          ModalResult := mrCancel;
          Result := 1;
        end else
          // для обычного - посылаем команду на закрытие
          Result := Integer(PostMessage(Handle, WM_CLOSE, 0, 0));

        if Result <> 0 then
          Exit;
      end;

  inherited;
end;

Автоматическое уничтожение окна при закрытии

Это очень полезно при использовании MDI-стиля приложения – MDIChild-окна, как правило, при закрытии надо сразу уничтожать (иначе, по умолчанию, они просто сворачиваются). Тоже бывает полезно и для не модальных диалогов. По-умолчанию свойство FreeOnClose установлено в False, но Вы можете установить его в True, заменив значение после слова default и добавив инициализацию переменной в методе InitializeNewForm.

..
  private
    FFreeOnClose: Boolean;
  protected
    procedure DoClose(var Action: TCloseAction); override;
  published
    property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose default False;
..
procedure TBaseForm.DoClose(var Action: TCloseAction);
begin
  if FreeOnClose then
    Action := caFree;
  inherited DoClose(Action);  // <- Form.OnClose
end;

Сразу замечу, что на самом деле это свойство работает не как FreeOnClose, а как ReleaseOnClose. Потому что. И на самом деле, это свойство не имеет значения, если у формы в обработчике OnClose переопределяется параметр Action.

Автоматическое уничтожение объектов, созданных в коде модуля формы

Об этом я писал ранее. Единственным отличием, от приведённого ранее кода будет то, что списков для уничтожения объектов будет два: один список будет уничтожать объекты при уничтожении формы (после обработчика OnDestroy), а другой – при её скрытии (после обработчика OnHide). Эти события являются зеркальными к событиям OnCreate и OnShow соответственно.

..
type
  TAutoFreeOnEvent = (afDefault, afHide, afDestroy);
..
  protected
    FAutoFreeOnHide: TObjectList;
    FAutoFreeOnDestroy: TObjectList;
    procedure DoHide; override;
    procedure DoDestroy; override;
  public
    function AutoFree(AObject: TObject; OnEvent: TAutoFreeOnEvent = afDefault): Pointer;
..
procedure TBaseForm.DoHide;
begin
  inherited DoHide;           // <- Form.OnHide
  // destory auto free objects
  FreeAndNil(FAutoFreeOnHide);
end;

procedure TBaseForm.DoDestroy;
begin
  inherited DoDestroy;        // <- Form.OnDestroy
  // destory auto free objects
  FreeAndNil(FAutoFreeOnHide);
  FreeAndNil(FAutoFreeOnDestroy);
end;

function TBaseForm.AutoFree(AObject: TObject; OnEvent: TAutoFreeOnEvent = afDefault): Pointer;
begin
  if OnEvent = afDefault then
    if fsShowing in FormState
      then OnEvent := afHide
      else OnEvent := afDestroy;

  case OnEvent of
    afHide:
      begin
        if not Assigned(FAutoFreeOnHide) then
          FAutoFreeOnHide := TObjectList.Create;
        FAutoFreeOnHide.Add(AObject);
      end;
    afDestroy:
      begin
        if not Assigned(FAutoFreeOnDestroy) then
          FAutoFreeOnDestroy := TObjectList.Create;
        FAutoFreeOnDestroy.Add(AObject);
      end;
  else
    Assert(False);
  end;
  Result := AObject;
end;

Итого

Имея базовую форму мы смогли (без дублирования кода):

• обойти странности VCL (с иконкой и сворачиванием модального окна);
• получили возможность скрывать форму по Escape и уничтожать её, изменяя лишь свойства через инспектор объектов;
• мы научили форму автоматически уничтожать простые объекты (наследники от TObject).

Исходники доступны на этой странице. Ссылка для быстрого скачивания.

Также я добавил тестовый проект, который наглядно демонстрирует новые возможности.