И вот тут в мою больную голову пришла мысль - "Хочу просто добавлять модуль формы в состав приложения, и чтобы все везде прописывалось само.". И ведь можно сделать.
Каждый модуль pascal имеет возможность описать секции инициализации и финализации. А значит, написав единый глобальный класс можно сослаться на него у модулей форм, команд, которые используются как плагины. Например разрабатываются не автором основной программы, а только компилируются как финальный результат.
Ну а в главном модулей приложения идет просто цикл типовой загрузки. Выглядит это все как ниже показано.
Глобальный модуль и класс доступный всем надстройкам.
- Код: Выделить всё
unit u_modules;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Forms, contnrs;
type
{ Data types }
TModuleProcedureEvent = procedure (Sender: TObject);
TModuleCreateFormEvent = procedure (Sender: TObject; var ANewForm:TForm);
TModuleRunCommandEvent = procedure (ARunCmd:ShortString; AParamValue,AParamName:TStringArray; var AResult:integer);
{ Forward Declarartions }
TAppModuleList = class;
TAppModuleItem = class;
{ TAppModuleItem class }
TAppModuleItem = class
private
FActive : Boolean;
FCollectionName : ShortString;
FID : ShortString;
FGroupID : ShortString;
FModuleType : integer;
FIconIndex : Integer;
FPositionIndex : Integer;
FOnInitModules : TModuleProcedureEvent;
FOnDeinitModules : TModuleProcedureEvent;
FOnCreateFormEvent : TModuleCreateFormEvent;
FOnRunCommandEvent : TModuleRunCommandEvent;
published
property Active : Boolean read FActive write FActive;
property ModuleType : Integer read FModuleType write FModuleType;
property ID : ShortString read FID write FID;
property GroupID : ShortString read FGroupID write FGroupID;
property IconIndex : Integer read FIconIndex write FIconIndex;
property PositionIndex : Integer read FPositionIndex write FPositionIndex;
public
property OnInitModules : TModuleProcedureEvent read FOnInitModules write FOnInitModules;
property OnDeinitModules : TModuleProcedureEvent read FOnDeinitModules write FOnDeinitModules;
property OnCreateFormEvent : TModuleCreateFormEvent read FOnCreateFormEvent write FOnCreateFormEvent;
property OnRunCommandEvent : TModuleRunCommandEvent read FOnRunCommandEvent write FOnRunCommandEvent;
procedure InitModules(Sender: TObject);
procedure DeinitModules(Sender: TObject);
procedure CreateForm(Sender: TObject; var ANewForm:TForm);
procedure RunCommand(ARunCmd:ShortString; AParamValue,AParamName:TStringArray; var AResult:integer);
constructor Create;
destructor Destroy; override;
end;
{ TAppModuleList class }
TAppModuleList = class(TObjectList)
private
function GetItem(Index: Integer): TAppModuleItem;
procedure SetItem(Index: Integer; const Value: TAppModuleItem);
public
property Items[Index: Integer]: TAppModuleItem read GetItem
write SetItem; default;
procedure Insert(Index: Integer; Item: TAppModuleItem);
function Add(Item: TAppModuleItem): Integer;
procedure Clear;
//Создание объекта без вставки его в список
function CreateItem: TAppModuleItem; virtual;
constructor Create;
destructor Destroy; override;
end;
const
MODULETYPE_UNKNOW = 0;
MODULETYPE_BASE = 1000;
MODULETYPE_CMD = MODULETYPE_BASE+1;
MODULETYPE_GUI = MODULETYPE_BASE+2;
var
GlobalModulesList : TAppModuleList;
implementation
{ TAppModuleList }
function TAppModuleList.GetItem(Index: Integer): TAppModuleItem;
begin
Result := TAppModuleItem(inherited GetItem(Index));
end;
procedure TAppModuleList.SetItem(Index: Integer;
const Value: TAppModuleItem);
begin
inherited SetItem(Index, Value);
end;
procedure TAppModuleList.Insert(Index:Integer; Item:TAppModuleItem);
begin
inherited Insert(Index, Item);
end;
function TAppModuleList.Add(Item: TAppModuleItem): Integer;
begin
Result := inherited Add(Item);
end;
procedure TAppModuleList.Clear;
var
i: Integer;
item: TAppModuleItem;
begin
for i := Count - 1 downto 0 do
begin
item := Items[i];
item.Free;
Extract(item);
end;
inherited Clear;
end;
function TAppModuleList.CreateItem: TAppModuleItem;
begin
Result := TAppModuleItem.Create;
end;
constructor TAppModuleList.Create;
begin
inherited Create;
end;
destructor TAppModuleList.Destroy;
begin
inherited Destroy;
end;
{ TAppModuleItem }
procedure TAppModuleItem.InitModules(Sender: TObject);
begin
if Assigned(FOnInitModules) then
FOnInitModules(Sender);
end;
procedure TAppModuleItem.DeinitModules(Sender: TObject);
begin
if Assigned(FOnDeInitModules) then
FOnDeInitModules(Sender);
end;
procedure TAppModuleItem.RunCommand(ARunCmd: ShortString; AParamValue,
AParamName: TStringArray; var AResult: integer);
begin
if Assigned(FOnRunCommandEvent) then
FOnRunCommandEvent(ARunCmd,AParamValue,AParamName,AResult)
else
AResult:=0;
end;
procedure TAppModuleItem.CreateForm(Sender: TObject; var ANewForm: TForm);
begin
ANewForm:=nil;
if Assigned(FOnCreateFormEvent) then
FOnCreateFormEvent(Sender, ANewForm);
end;
constructor TAppModuleItem.Create;
begin
inherited Create;
FActive :=True;
FModuleType :=MODULETYPE_UNKNOW;
FID :='';
FGroupID :='';
FIconIndex :=-1;
FPositionIndex :=0;
FOnInitModules :=nil;
FOnDeinitModules :=nil;
FOnCreateFormEvent :=nil;
FOnRunCommandEvent :=nil;
end;
destructor TAppModuleItem.Destroy;
begin
inherited Destroy;
end;
Initialization
GlobalModulesList := TAppModuleList.Create;
finalization
GlobalModulesList.Free;
end.
end.
Помимо него у всех форм должен быть какой то общий класс предок для обработки процедур.
В модуле главной формы делаем обработку глобального списка и создания всех кого нужно по нему.
- Код: Выделить всё
...uses u_modules
procedure TfMain.FormCreate(Sender: TObject);
var
sTemp,
sTempFolder :String;
i :integer;
RootNode,
DataRootNode,
Node :TTreeNode;
FirstPageForm,
NewForm :TCustomModuleForm;
NewTS :TTabSheet;
mdlItem :TAppModuleItem;
begin
***
FModules :=TList.Create;
***
pgcMain.Visible:=False;
//FirstPage
FirstPageForm :=TFModuleFirstPage.Create(Self);
NewForm :=FirstPageForm;
NewForm.ModuleIconIndex :=0;
NewForm.GroupID :=IDMENUGRP_GENERAL;
NewForm.InitForm(TCPClient,FSettings.ActiveConnection);
NewForm.OnDoSetStatus :=@DoSetStatus;
//NewForm.ManualDock(pgcMain);
NewTS :=pgcMain.AddTabSheet;
NewTS.Tag :=FModules.Add(NewForm);
NewTS.Caption :=NewForm.Name;
NewForm.Tag :=NewTS.Tag;
NewForm.ManualDock(NewTS);
NewForm.Align:=alClient;
NewForm.Show;
***
//Users
NewForm :=TFModuleUsersExt.Create(Self);
NewForm.ModuleIconIndex :=1;
NewForm.GroupID :=IDMENUGRP_ADMIN;
NewForm.InitForm(TCPClient,FSettings.ActiveConnection);
NewForm.OnDoSetStatus :=@DoSetStatus;
//NewForm.ManualDock(pgcMain);
NewTS :=pgcMain.AddTabSheet;
NewTS.Tag :=FModules.Add(NewForm);
NewForm.Tag :=NewTS.Tag;
NewTS.Caption :=NewForm.Name;
NewForm.ManualDock(NewTS);
NewForm.Align :=alClient;
NewForm.Show;
{
Все формы в модулях создаются как наследники какого то базового общего класса
TCustomModuleForm = class(TForm)
}
for i:=0 to GlobalModulesList.Count-1 do
begin
mdlItem:=GlobalModulesList.Items[i];
if mdlItem.ModuleType<>MODULETYPE_GUI then
Continue;
mdlItem.CreateForm(Self,TForm(NewForm));
//NewForm:=TCustomModuleForm(NewForm);
if Assigned(NewForm) then
begin
NewForm.ModuleIconIndex :=mdlItem.IconIndex;
NewForm.GroupID :=mdlItem.GroupID;
NewForm.InitForm(TCPClient,FSettings.ActiveConnection);
NewForm.OnDoSetStatus :=@DoSetStatus;
//NewForm.ManualDock(pgcMain);
NewTS :=pgcMain.AddTabSheet;
NewTS.Tag :=FModules.Add(NewForm);
NewForm.Tag :=NewTS.Tag;
NewTS.Caption :=NewForm.Name;
NewForm.ManualDock(NewTS);
NewForm.Align :=alClient;
NewForm.Show;
end;
end;
***
end;
Ну и финалочка. Все разрабатываемые надстройки для автоматического добавления в программу должны в модуле своем иметь только небольшую вставку в конце
Если речь не о формах, а просто командах, то принцип такой же, но обрабатываются связки с прописываемыми процедурами. В u_modules так же предусмотрено.
- Код: Выделить всё
uses u_modules
...
{Интеграция модуля в программу}
procedure CreateFormEvent(Sender: TObject; var ANewForm: TForm);
begin
ANewForm:=TFModuleContracts.Create(TForm(Sender));
end;
procedure SetThisModuleToGlobalList;
const
IDMENUGRP_GENERAL ='IDMENUGRP_GENERAL';
var
item:TAppModuleItem;
begin
item :=GlobalModulesList.CreateItem;
item.Active :=False;
item.ID :='{CONTRACTS}';
item.GroupID :=IDMENUGRP_GENERAL;
item.IconIndex :=5;
item.PositionIndex :=0;
item.ModuleType :=MODULETYPE_GUI;
item.OnInitModules :=nil;
item.OnDeinitModules :=nil;
item.OnCreateFormEvent :=@CreateFormEvent;
GlobalModulesList.Add(item);
end;
Initialization
SetThisModuleToGlobalList;
finalization
end.
Ваши мысли?
- Критика?
- Что не учел и чем это плохо?
- в каких модулях lazarus это уже реализовано до меня, и я изобрел велосипед не перекопав кучу треша из состава IDE?
