{...}
type
TModuleEntry =
class(TObject)
public
FileName:
String;
hModule : Cardinal;
ModuleName:
String;
ModuleIcon: TBitmap32;
end;
TfrmMain =
class(TForm)
{...}
private
function GetActiveMDIChild: TModularForm;
procedure AddChild(Kind:
String);
{...}
end;
var
ModuleList: TList;
//Hier kommen Objekte vom Typ TModuleEntry rein
procedure LoadModules;
function GetModule(aFile:
String): TModuleEntry;
implementation
function GetModule(aFile:
String): TModuleEntry;
var StatusStr: PChar;
GetModuleName:
Function: PChar;
DrawModuleIcon:
procedure(TargetBMP: TBitmap32);
InitModule:
function (GlobalApplication: TApplication; GlobalScreen: TScreen;
var StatusStr: PChar): Boolean;
begin
Result :=
nil;
try
Result := TModuleEntry.Create;
Result.FileName := aFile;
Result.hModule := LoadPackage(Result.FileName);
@InitModule := GetProcAddress(Result.hModule, '
InitModule');
If @InitModule =
nil then raise Exception.Create('
Funktion "InitModule" nicht gefunden.');
If not InitModule(Application, Screen, StatusStr)
then
begin
MessageBox(
Handle,
PChar('
Das Modul "' + aFile + '
" konnte nicht geladen werden.' + #13#10#13#10
+ StatusStr),
'
Fehler beim laden des Moduls',
MB_OK
or MB_ICONERROR
or MB_APPLMODAL);
Application.Terminate;
exit;
end;
@GetModuleName := GetProcAddress(Result.hModule, '
GetModuleName');
If @GetModuleName =
nil then raise Exception.Create('
Funktion "GetModuleName" nicht gefunden.');
@DrawModuleIcon := GetProcAddress(Result.hModule, '
DrawModuleIcon');
If @DrawModuleIcon =
nil then raise Exception.Create('
Funktion "DrawModuleIcon" nicht gefunden.');
Result.ModuleName := GetModuleName;
Result.ModuleIcon := TBitmap32.Create;
Result.ModuleIcon.Width := 32;
Result.ModuleIcon.Height := 32;
DrawModuleIcon(Result.ModuleIcon);
except
If Assigned(Result)
then FreeAndNil(Result);
raise;
end;
end;
procedure LoadModules;
var R: TSearchRec;
FoundCount: Integer;
ModuleEntry: TModuleEntry;
begin
FoundCount := 0;
If FindFirst(RootDir + '
Modules\*.bpl', faAnyFile-faDirectory, R) = 0
then
Repeat
try
ModuleEntry := GetModule(RootDir + '
Modules\' + R.
Name);
ModuleList.Add(ModuleEntry);
inc(FoundCount);
except
on E:
Exception do
MessageBox(0,
PChar('
Das Modul "' + R.
Name +'
" konnte nicht geladen werden.' + #13#10 +
'
Ursache: ' + E.
Message),
'
Fehler',
MB_OK
or MB_ICONERROR);
end;
Until FindNext(R) <> 0;
FindClose(R);
Case FoundCount
of
0: frmMain.StatusBar1.Panels[1].Text := '
Keine Module geladen...';
1: frmMain.StatusBar1.Panels[1].Text := '
1 Modul geladen...';
else frmMain.StatusBar1.Panels[1].Text := IntToStr(FoundCount) + '
Module geladen...';
end;
end;
function TfrmMain.GetActiveMDIChild: TModularForm;
var i: Integer;
begin
Result :=
nil;
for i:=0
to MDIChildCount-1
do
If MDIChildren[i].Active
then
begin
Result := TModularForm(MDIChildren[i]);
exit;
end;
end;
procedure TfrmMain.AddChild(Kind:
String);
var NewForm: TModularForm;
CreateNewChild:
Function(aOwner: TComponent; LinkedStatusBar: TStatusBar): TModularForm;
ModuleEntry: TModuleEntry;
i: Integer;
ModuleFound: Boolean;
begin
ModuleFound := false;
for i:=0
to ModuleList.Count-1
do
begin
ModuleEntry := TModuleEntry(ModuleList[i]);
If ModuleEntry.ModuleName = Kind
then
begin
@CreateNewChild := GetProcAddress(ModuleEntry.hModule, '
CreateNewChild');
If @CreateNewChild =
nil then raise Exception.Create('
Die Funktion CreateNewChild wurde im Modul "' + ModuleEntry.ModuleName + '
" nicht gefunden');
NewForm := CreateNewChild(Application, StatusBar1);
NewForm.Property1 := '
TestTest';
NewForm.OnClose := MDIChildClose;
NewForm.WindowState := wsMaximized;
ModuleFound := true;
end;
end;
end;