用dll封裝mdi窗口

***********************
main (mdi) form
***********************

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls;

type
  TShowFrm = procedure(App: TApplication; Scr:TScreen); stdcall;

type
  TForm1 = class(TForm)
  Button2: TButton;
  procedure FormCreate(Sender: TObject);
  procedure FormClose(Sender: TObject; var Action: TCloseAction);
  procedure Button2Click(Sender: TObject);
private
  hInstance: THandle;
 { Private declarations }
public
 { Public declarations }
end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  try
    hInstance := SafeLoadLibrary(‘Mydll.dll‘, SEM_NOOPENFILEERRORBOX);
   {load the library on form create as will need to know what forms are available, so they can be listed for creation.}
  except
     on e: exception do
        ShowMessage(e.Message);
   end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 try
   if Form1.MDIChildCount = 1 then
   begin
     MDIChildren[0].Close;
   end;
   {This example only uses 1 form in a single dll. In reality would cycle through all open children, closing as go}

   FreeLibrary(hInstance);
     {destroy reference to dll}
  except
    on e: exception do
      ShowMessage(e.Message);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 AFunc: Pointer;
begin
  try
     Pointer(AFunc) := GetProcAddress(hInstance, PChar (‘ShowFrm‘));
     TShowFrm(AFunc)(Application, Screen);
    {Open the child form}
  except
     on e: exception do
       ShowMessage(e.Message);
  end;
end;

end.

 

***********************
dll file
***********************

library Mydll;

uses
  SysUtils,Classes,Forms,Windows,Dialogs,
  MyForm in ‘MyForm.pas‘ {Form2};

{$R *.res}

var
  AppDLL: TApplication;
  ScrDLL: TScreen;

procedure MyDLLProc(Reason: Integer);
begin
  try
    if Reason = DLL_PROCESS_DETACH then
    begin
      Application := AppDLL;
      Screen := ScrDLL;
    end;
  except
     on e: exception do

        ShowMessage(e.Message);
  end;
end;

 

procedure ShowFrm(App:TApplication; Scr: TScreen); stdcall;
begin
   Application := App;
   Screen := Scr;
   App.CreateForm(TForm2, Form2);
   Form2.Show;
end;

exports
  ShowFrm;

 

begin
  try
    AppDLL := Application;
    ScrDLL := Screen;
    DLLProc := @MyDLLProc;
  except
    on e: exception do

       ShowMessage(e.Message);
  end;
end.

***********************
mdi-child form
***********************

unit MyForm;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
  TForm2 = class(TForm)
  procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
   { Private declarations }
  public
   { Public declarations }
end;
var
  Form2: TForm2;

implementation

{$R *.dfm}
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  try
    Action := caFree;
  except
    on e: exception do

       ShowMessage(e.Message);
  end;
end;
end.