Dynamisch erzeugte modulare Forms wie managen?

[Dani]

Hallo allerseits

Ich möchte (immer noch ) MDI-Child-Forms in
Packages speichern und aus einer seperaten Anwendung
heraus die compilierten BPL Dateien so laden, dass die
Anwendung dynamisch MDI-Children erstellen und
verwalten kann. Dabei sollen alle Vorzüge der VCL
erhalten bleiben.

Bisher löse ich das so:

Eine "Über-"Formklasse ableiten:

Delphi-Quellcode:

type
 TModularForm = class(TForm)
  private
    FProperty1: String;
    FProperty2: TStatusBar;
  public
    Edited: Boolean;
    procedure Foo1; virtual; abstract;
    procedure Foo2(aParam: String); virtual; abstract;
    function  Foo3: String; virtual; abstract;
  published
    property Property1: String read FProperty1 write FProperty1;
    property Property2: String read FProperty2 write FProperty2;
  end;

Im Package: Exportierte Funktionen zur Initialisierung, Erzeugung von Forms usw.

Delphi-Quellcode:

unit uMyModularForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls {...};


type
  TMyModularForm = class(TModularForm)
   {....}
  private
    SomeInt: Integer; 
  public
    procedure Foo1; override;
    procedure Foo2(aParam: String); override;
    function  Foo3: String; virtual; override;
 {...}
  end;

var
 BPLApplication: TApplication;
 BPLScreen: TScreen;

procedure DrawModuleIcon(TargetBMP: TBitmap32);
function  GetModuleName: PChar;
function  CreateNewChild(aOwner: TComponent; LinkedStatusBar: TStatusBar): TModularForm;
function  InitModule(GlobalApplication: TApplication; GlobalScreen: TScreen;
               var StatusStr: PChar): Boolean;

implementation

{...}

uses uAnotherForm;

function InitModule(GlobalApplication: TApplication; GlobalScreen: TScreen;
               var StatusStr: PChar): Boolean;
begin
 Result := true;
 try
  RegisterClass(TMyModularForm);
  RegisterClass(TAnotherForm);
 except
  Result := false;
  StatusStr := 'Ursache: Dieses Modul wurde bereits geladen. Das Programm wird nun terminiert.';
  exit;
 end;
 try
  BPLApplication := Application;
  Application := GlobalApplication;
  Application.Initialize;
 except
  Result := false;
  StatusStr := 'Ursache: Fehler bei der Übergabe des Application-Objekts. Das Programm wird nun terminiert.';
  exit;
 end;
 try
  BPLScreen := Screen;
  Screen := GlobalScreen;
 except
  Result := false;
  StatusStr := 'Ursache: Fehler bei der Übergabe des Screen-Objekts. Das Programm wird nun terminiert.';
  exit;
 end;
end;

procedure DrawModuleIcon(TargetBMP: TBitmap32);
begin
 {...}
end;

function GetModuleName: PChar;
begin
 Result := MODULENAME;
end;

function CreateNewChild(aOwner: TComponent; LinkedStatusBar: TStatusBar): TModularForm;
begin
 Result := TMyModularForm.Create(Application);
 Result.Property2 := LinkedStatusBar;
end;

exports
 DrawModuleIcon,
 GetModuleName,
 CreateNewChild,
 InitModule;

{...}

finalization
begin
 Application := BPLApplication;
 Screen := BPLScreen;
 UnRegisterClass(TMyModularForm);
 UnRegisterClass(TAnotherForm);
end;

Im Hauptprogramm ein neues Formular aus einem Modul erzeugen:

Delphi-Quellcode:

{...}
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;

Zur Erklärung: Die Application, und Screen -Variablen der Module müssen beim initialisieren überschrieben werden, damit die Erstellung von MDI-Children und die zugehörige Variable MDIChildCount funktionieren.
Nun meine eigentliche Frage: Ist dies wirklich der "einzig wahre" Weg, um MDI-Child-Forms in Packages auszulagern, oder mache ich hier etwas falsch? Tausend Dank schonmal fürs lesen

[Dani]

Hmm, ich werd mal ein Testprojekt schreiben, vielleicht ist das ja irgendwie nützlich...

[Dani]

Okay, hier das Beispielprojekt...selbst bei dieser einfachen Anwendung kommt es zu sehr.... interessanten Fehlern

Edit: Der Quelltext aus dem ersten Post ist übrigens nicht mehr aktuell, bitte ignorieren.

[Dani]

Ich bleib mal optimistisch