Невизуальное наследование форм в Delphi

Создание класса.
Создадим базовый класс, наследник TForm, от которого в дальнейшем будем наследовать все наши формы. Для этого в новый или существующий пакет, добавим компонент TBaseForm как это показано на рисунке 1.


Рис. 1. Создание нового компонента TBaseForm

Для Delphi 6 в пункте Requires нашего пакета добавляем «Borland Designer IDE Package» (по умолчанию находится в C:\Program_Files\Borland\Delphi6\Lib\designide.dcp). Для Delphi 5 все для нас необходимое содержится в «Borland Visual Component Library» (он включается в пакет автоматически). В раздел uses для Delphi 5 добавляем DsgnIntf, а для Delphi 6 DesignIntf и DesignEditors. Изменим процедуру Register только что созданного компонента, так как это сделано в листинге 1.


procedure Register;
begin
RegisterCustomModule(TBaseForm, TCustomModule);
end;

Листинг 1. Изменение процедуры Register.
Компилируем наш пакет — класс TBaseForm готов к использованию.

Использование класса.
Для того чтобы какая-либо форма проекта была наследником класса TBaseForm, для этого в раздел uses формы нужно включить юнит BaseForm, а объявление класса новой формы class(TForm) переделать на class(TBaseForm). Затем форму нужно закрыть и снова открыть. После этого наша форма станет полноценным наследником класса TBaseForm.

Пример использования.
Пусть перед нами стоит задача: все формы проекта должны содержать информацию о версии формы (что необходимо, когда один и тот же проект подгоняется под разных заказчиков) и отображать информацию о форме каким-либо способом.

Для реализации этих целей изменим класс TBaseForm как это показано в листинге 2. Здесь добавлены соответствующие переменные и свойства для хранения информации о версии формы и создан механизм показа информации о форме посредством системного меню окна — добавлен новый пункт системного меню «О форме».


/////////////////////////////////////////////////////////////
// описание класса базовой формы
// Рощупкин А.В. 2003 г.
/////////////////////////////////////////////////////////////
unit BaseForm;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, Forms,
//DsgnIntf; //при использовании Delphi5
DesignIntf, DesignEditors; //при использовании Delphi6

const
ItmID = $00a0; //идентификатор нового пункта системного меню

type
TBaseForm = class(TForm)
private
FVersion: integer; //версия формы
FMnuItmAbout: MENUITEMINFO; //структура нового пункта меню
FOldWndProc : Pointer; //указатель на старую функцию обработки
//сообщений окна (формы)
FNewWndProc : Pointer; //указатель на новую функцию обработки
//сообщений окна (формы)

// возвращает информацию о форме в виде строки
function GetAboutString: string;

protected
public
//конструктор
constructor Create(AOwner: TComponent); override;
//деструктор
destructor Destroy; override;
//возвращает указатель на старую функцию обработки сообщений окна (формы)
function GetOldWindowProc: Pointer;
//показывает информацию о форме
procedure ShowFormInfo;

published
property Version: integer read FVersion write FVersion default 1;

end;

//новую функцию обработки сообщений окна (формы)
function NewWndProc(wnd: HWND; Msg: UINT; wPrm: WPARAM; lPrm: LPARAM): LRESULT stdcall;
//процедура регистрации класса
procedure Register;

implementation

constructor TBaseForm.Create(AOwner: TComponent);
begin
inherited;

//у наших окон всегда должно быть системное меню!!!
if not ( biSystemMenu in Self.BorderIcons ) then
Self.BorderIcons := Self.BorderIcons + [biSystemMenu];

//создаем новый пункт систменого меню, по выборе которого
//будет показана информация о форме
FMnuItmAbout.cbSize := 44;
FMnuItmAbout.fMask := MIIM_DATA or MIIM_ID or MIIM_STATE or MIIM_TYPE;
FMnuItmAbout.fType := MFT_STRING;
FMnuItmAbout.fState := MFS_ENABLED;
FMnuItmAbout.wID := ItmID;
FMnuItmAbout.hSubMenu := 0;
FMnuItmAbout.hbmpChecked := 0;
FMnuItmAbout.hbmpUnchecked := 0;
FMnuItmAbout.dwTypeData := PChar(‘О форме’);
InsertMenuItem(GetSystemMenu(Self.Handle, False), 0, True, FMnuItmAbout);

//регистрация новой процедуры обработки сообщений окна (формы)
FNewWndProc := Pointer(@NewWndProc);
FOldWndProc := Pointer(GetWindowLong(Self.Handle, GWL_WNDPROC));
SetWindowLong(Self.Handle, GWL_WNDPROC, Longint(FNewWndProc));
end;

destructor TBaseForm.Destroy;
begin
inherited;
end;

function TBaseForm.GetOldWindowProc: Pointer;
begin
Result := FOldWndProc;
end;

procedure TBaseForm.ShowFormInfo;
var
InfStr: string;
begin
InfStr := GetAboutString;
MessageBox(Self.Handle, PChar(InfStr), PChar(‘Сведения о форме’), MB_OK);
end;

function TBaseForm.GetAboutString: string;
begin
Result := ‘Имя класса формы: ‘ + Self.ClassName + #13 +
‘Имя формы: ‘ + Self.Name + ‘ версия ‘ + IntToStr(FVersion);
end;

////////////////////////////////////////////////////////////////
// в данном примере новая процедура обработки сообщений
// окна (формы) создана только для одного сообщения —
// ловить выбор пункта системного меню «О форме»
////////////////////////////////////////////////////////////////
function NewWndProc(wnd: HWND; Msg: UINT; wPrm: WPARAM; lPrm: LPARAM): LRESULT stdcall;
var
FrmHWND: HWND;
wctrl: TWinControl;
BFrm: TBaseForm;
begin
Result := 0;
FrmHWND := wnd;
wctrl := FindControl(FrmHWND);
if ( wctrl = nil ) then Exit;
FrmHWND := GetParentForm(wctrl).Handle;
if ( FrmHWND = 0 ) then Exit;
BFrm := TBaseForm(FindControl(FrmHWND));
if ( BFrm = nil ) then
Exit;
Result := CallWindowProc(BFrm.GetOldWindowProc, wnd, Msg, wPrm, lPrm);
case ( Msg ) of
//выбран пункт системного меню «О форме»
WM_SYSCOMMAND :
begin
if ( LOWORD(wPrm) = ItmID ) then
begin
wctrl := FindControl(wnd);
if ( wctrl nil ) then
if ( wctrl is TBaseForm ) then
TBaseForm(wctrl).ShowFormInfo;
end;
end;
end;
end;

procedure Register;
begin
RegisterCustomModule(TBaseForm, TCustomModule);
end;

end.

Листинг 2.
Теперь, наследуя все формы проекта от класса TBaseForm, мы можем сохранять версию формы и получать информацию о форме через системное меню окна (формы).

Конечно, данным примером не исчерпывается использование данного метода. Из явных применений видятся: 1) сохранение параметров окон, например методом [2]; 2) разграничение прав доступа (если где-нибудь, например, в базе данных, мы храним права доступа к элементам окна, то эти права можно реализовать в конструкторе TBaseForm); 3) табуляция между элементами окна по нажатию клавиши Enter в TEdit (для этого нужно в NewWndProc включить соответствующий обработчик) и т.д.

К недостаткам метода относится то, что в построенном классе TBaseForm крайне сложно будет создавать визуальные компоненты.