Модули гружу в память LoadPackage() и выгружаю UnloadPackage() по мере использования.
В исходниках Lazarus этих процедур не обнаружил.
Что посоветуете?
PS: Ниже исходник дельфого модуля. TBaseForm это базовый клас от которого порождены все формы проекта.
- Код: Выделить всё
unit Dispatcher;
interface
uses Windows, Controls, Messages, Classes, Base;
const
InnerDatabaseName = 'DB';
CM_LOAD_OBJECT = WM_USER + 100;
CM_UNLOAD_OBJECT = WM_USER + 101;
oiSysQuery = 0;
type
TObjectType = (otStartupForm, otForm, otComponentSet);
TBaseFormClass = class of TBaseForm;
function LoadObject(aModuleName, aClassName: string; Params: TStrings): TBaseForm;
procedure UnloadObject(aModuleName: string);
procedure CallDispatcher(ObjectID: Integer; ObjectParams: TStrings; Container: TWinControl);
function GetAppPath: string;
var
LoadedObjectList: TStringList;
implementation
uses DBTables, SysUtils, Forms, StdCtrls, Dialogs, Variants, ObjectParamsViewer;
function LoadObject(aModuleName, aClassName: string; Params: TStrings): TBaseForm;
var
Handle: Integer;
begin
Result := nil;
Handle := LoadPackage(aModuleName);
LoadedObjectList.Values[aModuleName] := IntToStr(Handle);
if Assigned(Params) then Params.Values[aModuleName] := IntToStr(Handle);
if LoadedObjectList.Values[aModuleName] <> '' then begin
Result := TBaseFormClass(FindClass(aClassName)).Create(Application);
if Assigned(Result) then
if Result.InitParams(Params) then
Result.FormStyle := TFormStyle(StrToIntDef(Params.Values['FORM_STYLE'], 0))
else
Result.Free
else
UnloadObject(aModuleName);
end;
end;
procedure UnloadObject(aModuleName: string);
begin
with LoadedObjectList do begin
UnloadPackage(StrToInt(Values[aModuleName]));
Delete(IndexOfName(aModuleName));
end;
end;
procedure CallDispatcher(ObjectID: Integer; ObjectParams: TStrings; Container: TWinControl);
var
BaseForm: TBaseForm;
I: Integer;
Temp: TControl;
begin
if not Assigned(ObjectParams) then ObjectParams := TStringList.Create;
if ObjectParams.Strings[0]<>'[ClassParams]=' then
ObjectParams.Insert(0,'[ClassParams]=');
ObjectParams.Values['[ObjParams]']:=' ';
with TQuery.Create(nil) do
try
DatabaseName := InnerDatabaseName;
SQL.Add('select * from get_object_params(:p_object_id)');
ParamByName('p_object_id').asInteger := ObjectID;
Open;
while not EOF do begin
ObjectParams.Values[FieldByName('name').asString] := FieldByName('param_value').asString;
Next;
end;
Close;
finally
Free;
end;
if (GetAsyncKeyState(VK_LSHIFT) and $80000000) = $80000000 then begin
with TParamViewerForm.Create(Application) do begin
ObjParams.AddStrings(ObjectParams);
if ShowModal=mrOK then begin
ObjectParams.Clear;
ObjectParams.AddStrings(ObjParams);
ObjParams.Free;
end;
// Application.MessageBox(PChar(ObjectParams.Text), PChar(Application.Title), MB_ICONINFORMATION + MB_OK);
free;
end;
end;
with ObjectParams do begin
BaseForm := LoadObject(Values['MODULE_NAME'], Values['CLASS_NAME'], ObjectParams);
if BaseForm <> nil then begin
with BaseForm do
case TObjectType(StrToInt(Values['OBJECT_CLASS'])) of
otStartupForm, otForm:
case FormStyle of
fsNormal: begin
if Assigned(Container) and (Container is TBaseForm) then
TBaseForm(Container).OnCall(BaseForm);
if Values['FORM_SHOW'] <> '0' then ShowModal;
end;
fsStayOnTop: Show;
end;
otComponentSet: begin
if Container <> nil then
for I := ControlCount - 1 downto 0 do begin
Temp := Controls[i];
RemoveControl(Temp);
Container.InsertControl(Temp);
end;
end;
end;
PostMessage(Application.Handle, CM_LOAD_OBJECT, 0, Integer(BaseForm));
end;
end;
end;
function GetAppPath: string;
begin
Result := ExtractFileDir(Application.ExeName);
end;
initialization
LoadedObjectList := TStringList.Create;
end.
