Load DLL's MdiChildForm and base frame

//***主程序和DLL都帶包編譯， build with runtime packages。
//vcl.bpl  and so on..

****************************  MDIMainForm   ************************************
/////////////////////////////////////////////////////////////////////////////////
The base frame is changed from bpl frame,the frame used MdiForm and MdiChildForm
and user dll files.
/////////////////////////////////////////////////////////////////////////////////

The custtab first tabset is fix,in the here,the tabset text is 'Had opened Module:';

type
  TFmMain = class(TForm)
  ...
  private
    bActived: Boolean;
    procedure ShowLogin;
    procedure DrawMenuBar;
  public
    procedure DoMenuItem(MenuItem: TMenuItem);
    procedure WMCustDo(var WMMSG: TMessage); message WMFmCust;
    procedure WMCloseDo(var WMMSG: TMessage); message WMFmClose;
    procedure WMActive(var WMMSG: TMessage); message WMFmActive;
    procedure WM_Close(var WMMSG: TWMCLOSE); message WM_CLOSE;
  end;

procedure TfmMain.FormActivate(Sender: TObject);
begin
  if not bActived then
    ShowLogin;
end;

procedure TfmMain.FormCreate(Sender: TObject);
begin
  bActived := False;
  DrawMenuBar;
end;

procedure TfmMain.ShowLogin;
var
  bResult: Boolean;
begin
  bResult := ShowLoginForm; //Unit FrmLogin Function
  //Set MenuBar Property
  bActived := True;
end;

procedure TfmMain.mnLoginClick(Sender: TObject);
begin
  bActived := False;
  ShowLogin;
end;

procedure TfmMain.Close(Sender: TObject);
var
  PModule: PAModule;
  AModule: TAModule;
begin
  if CustTabSet.Tabs.Count = 1 then
  begin
    Close;
    Exit;
  end;
  if CustTabSet.TabIndex = 0 then Exit;
  PModule := PAModule(CustTabSet.Tabs.Objects[CustTabSet.TabIndex]);
  AModule.Form := PModule^.Form;
  (AModule.Form as TForm).Close;
end;

procedure TfmMain.DoMenuItem(MenuItem: TMenuItem);
var
  PModule: PAModule;
  AModule: TAModule;
begin
  if MenuItem.Tag = 0 then
  begin
    New(PModule);
    AModule := LoadDllForm(MenuItem.Name, Application, dmDataConn.adoConn, [doAdd]);
    if AModule.bLoadOK then
    begin
      LockWindowUpdate(GetDesktopWindow);
      AModule.Form.Show;
      LockWindowUpdate(0);
      MenuItem.Tag := 1;
      PModule^.AMenuItem := MenuItem;
      PModule^.ClassName := AModule.ClassName;
      PModule^.Caption := AModule.Caption;
      PModule^.Form := AModule.Form;
      PModule^.Handle := AModule.Handle;
      PModule^.bLoadOK := AModule.bLoadOK;
      CustTabSet.Tabs.AddObject(AModule.Caption, TObject(PModule));
      CustTabSet.TabIndex := CustTabSet.Tabs.Count - 1;
      ((AModule.Form) as TForm).WindowState := wsMaximized;
    end else
    begin
      Dispose(PModule);
    end;
  end;
end;

procedure TfmMain.WM_Close(var WMMSG: TWMCLOSE);
var
  PModule: PAModule;
  AModule: TAModule;
begin
  if CustTabSet.Tabs.Count = 1 then
  begin
    Close;
    Exit;
  end;
  if CustTabSet.TabIndex = 0 then Exit;
  PModule := PAModule(CustTabSet.Tabs.Objects[CustTabSet.TabIndex]);
  AModule.Form := PModule^.Form;
  (AModule.Form as TForm).Close;
end;

procedure TfmMain.WMActive(var WMMSG: TMessage);
var
  PModule: PAModule;
  AModule: TAModule;
  i: Integer;
begin
  if WMMSG.Msg = WMFmActive then
  begin
    if CustTabSet.Tabs.Count = 1 then Exit;
    if CustTabSet.TabIndex = 0 then Exit;
    CustTabSet.OnClick := nil;
    for i := 1 to CustTabSet.Tabs.Count - 1 do
    begin
      PModule := PAModule(CustTabSet.Tabs.Objects[i]);
      AModule.Form := PModule^.Form;
      if AModule.Form.Name = ActiveMDIChild.Name then
      begin
        CustTabSet.TabIndex := i;
        Break;
      end;
    end;
    CustTabSet.OnClick := CustTabSetClick;
  end;
end;

procedure TfmMain.WMCloseDo(var WMMSG: TMessage);
begin
  if WMMSG.Msg = WMFmClose then
  begin
    CustTabSetDblClick(nil);
  end;
end;

procedure TfmMain.WMCustDo(var WMMSG: TMessage);
var
  PModule: PAModule;
  AModule: TAModule;
begin
  if WMMSG.Msg = WMFmCust then
  begin
    if CustTabSet.Tabs.Count = 1 then Exit;
    if CustTabSet.TabIndex = 0 then
    begin
      for iTab := CustTabSet.Tabs.Count - 1 downto 1 do
      begin
        PModule := PAModule(CustTabSet.Tabs.Objects[iTab]);
        AModule.Form := PModule^.Form;
        if AModule.Form.Handle = WMMSG.WParam then
        begin
          AModule.AMenuItem := PModule^.AMenuItem;
          (AModule.AMenuItem as TMenuItem).Tag := 0;
          FreeLibrary(AModule.Handle);
          CustTabSet.Tabs.Delete(iTab);
          Dispose(PModule);
        end;
      end;
      Exit;
    end;
    PModule := PAModule(CustTabSet.Tabs.Objects[CustTabSet.TabIndex]);
    AModule.Form := PModule^.Form;
    AModule.AMenuItem := PModule^.AMenuItem;
    (AModule.AMenuItem as TMenuItem).Tag := 0;
    FreeLibrary(AModule.Handle);
    CustTabSet.Tabs.Delete(CustTabSet.TabIndex);
    Dispose(PModule);
  end;
end;

//Load Menu Item function here...

DoMenuItem(Sender as TMenuItem);

procedure TfmMain.CustTabSetDblClick(Sender: TObject);
var
  PModule: PAModule;
  AModule: TAModule;
begin
  if CustTabSet.Tabs.Count = 1 then Exit;
  if CustTabSet.TabIndex = 0 then Exit;
  PModule := PAModule(CustTabSet.Tabs.Objects[CustTabSet.TabIndex]);
  AModule.Form := PModule^.Form;
  (AModule.Form as TForm).Close;
end;

procedure TfmMain.CustTabSetClick(Sender: TObject);
var
  PModule: PAModule;
  AModule: TAModule;
begin
  if CustTabSet.Tabs.Count = 1 then Exit;
  if CustTabSet.TabIndex = 0 then Exit;
  PModule := PAModule(CustTabSet.Tabs.Objects[CustTabSet.TabIndex]);
  AModule.Form := PModule^.Form;
  LockWindowUpdate(GetDesktopWindow);
  ShowWindow((AModule.Form as TForm).Handle, SW_RESTORE);
  ShowWindow((AModule.Form as TForm).Handle, SW_SHOWMAXIMIZED);
  LockWindowUpdate(0);
end;

procedure TfmMain.DrawMenuBar;
begin
  //Acording to user role,to custom draw menu items
  //and set the menu item function name is domenuitem(...)
  //the menu item name is the Dll File Name,It's must set right...
end;

/////////////////////////////////////////////////////////////////////////////////
Public common types
/////////////////////////////////////////////////////////////////////////////////

const
  WMFmCust = WM_USER + $100;
  WMFmClose = WM_USER + $110;
  WMFmActive = WM_USER + $120;

type
  PAModule = ^TAModule;
  TAModule = record
    AMenuItem: TMenuItem;
    ClassName: pchar;
    Caption: pchar;
    Form: TForm;
    bLoadOK: Boolean;
    Handle: THandle;
  end;

type
  TUserInfo = record
    UserName: string;
    UserAcc: string;
    UserPwd: string;
    LoginDate: TDateTime;
    bDbConn: Boolean;
  end;

  TStatus = (doAdd, doEdit, doDelete, doExecute, doQuery);
  TStatusSet = set of TStatus;

/////////////////////////////////////////////////////////////////////////////////
Load Dll File,Every Dll file entry function is <LoadFormUnit>,
So that here <LoadDllForm> function to load all dll public entry
/////////////////////////////////////////////////////////////////////////////////

function LoadDllForm(InDllName: string; InApp: TApplication; dbConn: TAdoConnection; PowerSet: TStatusSet): TAModule;
function LoadFormUnit(InApp: TApplication; dbConn: TAdoConnection; PowerSet: TStatusSet): TAModule;

var
  DllPath: string = '';
  DllName: string = '';

implementation

function LoadDllForm(InDllName: string; InApp: TApplication; dbConn: TAdoConnection; PowerSet: TStatusSet): TAModule;
begin
  DllName := InDllName + '.Dll';
  DllPath := ExtractFilePath(Application.ExeName) + DllName;
  Result := LoadFormUnit(InApp, dbConn, PowerSet);
end;

function LoadFormUnit(InApp: TApplication; dbConn: TAdoConnection; PowerSet: TStatusSet): TAModule;
type
  TLoadFormUnit = function(InApp: TApplication; dbConn: TAdoConnection; PowerSet: TStatusSet): TAModule;
var
  TheHandle: THandle;
  LoadForm: TLoadFormUnit;
begin
  if FileExists(DllPath) then
    TheHandle := LoadLibrary(PChar(DllPath))
  else
    TheHandle := 0;

  if TheHandle = 0 then
  begin
    MessageBox(InApp.Handle, Pchar('調用 ' + DllName + ' 失敗!'), '提示', MB_OK);
    Result.Form := nil;
    Result.bLoadOK := False;
    Exit;
  end;

  @LoadForm := GetProcAddress(TheHandle, 'LoadFormUnit');
  if @LoadForm = nil then
  begin
    MessageBox(InApp.Handle, Pchar('調用的函數地址錯誤!'), '提示', MB_OK);
    FreeLibrary(TheHandle);
    Result.Form := nil;
    Result.bLoadOK := False;
    Exit;
  end;

  Result := LoadForm(InApp, dbConn, PowerSet);
  Result.Handle := TheHandle;
end;

****************************  MDIChild Dll  ************************************
/////////////////////////////////////////////////////////////////////////////////
DLL Project:
/////////////////////////////////////////////////////////////////////////////////

var
  DllApplication: TApplication;
  DllScreen: TScreen;

{$R *.res}

function LoadFormUnit(InApp: TApplication; dbConn: TAdoConnection; PowerSet: TStatusSet): TAModule;
var
  StrName, StrCaption: string;
begin
  Application := InApp;
  FmTest:= TFmTest.Create(InApp);
  FmTest.adoConn.ConnectionObject := dbConn.ConnectionObject;  //Don't Set as==>> adoConn=dbConn
  FmTest.PowerSets := FmTest.PowerSets + PowerSet;
  FmTest.FormInitialize;

  StrName := FmTest.Name;
  StrCaption := FmTest.Caption;

  Result.Form := FmTest;
  Result.bLoadOK := True;
  Result.ClassName := StrNew(Pchar(StrName));
  Result.Caption := StrNew(Pchar(StrCaption));
  Result.AMenuItem := nil;
  Result.Handle := 0;
end;

procedure DllEntry(Reason: Integer);
begin
  if Reason = DLL_PROCESS_DETACH then
  begin
    Screen := DllScreen;
    Application := DllApplication;
  end;
end;

exports
  LoadFormUnit;

begin
  DllApplication := Application;
  DllScreen := Screen;
  DllProc := @DllEntry;
end.

/////////////////////////////////////////////////////////////////////////////////
Dll Form Sample,Include in DLL Project
/////////////////////////////////////////////////////////////////////////////////

type
  TFmTest= class(TForm)
    ToolBar1: TToolBar;
    btnAdd: TToolButton;
    btnDelete: TToolButton;
    btnCancel: TToolButton;
    btnSave: TToolButton;
    Panel1: TPanel;
    imgList: TImageList;
    btnFirst: TToolButton;
    btnLast: TToolButton;
    btnPrior: TToolButton;
    btnNext: TToolButton;
    adoConn: TADOConnection;
    btnClose: TToolButton;
    btnEdit: TToolButton;
    procedure FormActivate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btnCloseClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);

    procedure btnDeleteClick(Sender: TObject);
    procedure btnFirstClick(Sender: TObject);
    procedure btnPriorClick(Sender: TObject);
    procedure btnNextClick(Sender: TObject);
    procedure btnLastClick(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnEditClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
  private
    CurStatus: TStatus;
  public
    PowerSets: TStatusSet;
    procedure SetFormStatus(PosStatus: TStatus);
    procedure FormInitialize;
  end;

var
  FmTest:TFmTest;

implementation

{$R *.dfm}

procedure TFmTest.FormActivate(Sender: TObject);
begin
  SendMessage(Application.MainForm.Handle, WMFmActive, 0, 0);
end;

procedure TFmTest.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := ShowBox('退出 [' + Caption + ']?') = IDYES;
  if CanClose then
  begin
    SendMessage(Application.MainForm.Handle, WMFmCust, Self.Handle, 0);
  end;
end;

procedure TFmTest.btnCloseClick(Sender: TObject);
begin
  SendMessage(Application.MainForm.Handle, WMFmClose, 0, 0);
end;

procedure TFmTest.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TFmTest.FormDestroy(Sender: TObject);
begin
  FmBom := nil;
end;

procedure TFmTest.btnDeleteClick(Sender: TObject);
begin
  //Todo...
end;

procedure TFmTest.btnFirstClick(Sender: TObject);
begin
  //Todo...
end;

procedure TFmTest.btnPriorClick(Sender: TObject);
begin
  //Todo...
end;

procedure TFmTest.btnNextClick(Sender: TObject);
begin
  //Todo...
end;

procedure TFmTest.btnLastClick(Sender: TObject);
begin
  //Todo...
end;

procedure TFmTest.SetFormStatus(PosStatus: TStatus);
begin
  CurStatus := PosStatus;

  if doAdd in PowerSets then
  begin
    btnAdd.Enabled := PosStatus in [doQuery];
  end else
    btnAdd.Enabled := False;

  if doEdit in  PowerSets then
  begin
    btnEdit.Enabled := PosStatus in [doQuery];
  end else
    btnEdit.Enabled := False;

  if doDelete in  PowerSets then
  begin
    btnDelete.Enabled := PosStatus in [doQuery];
  end else
    btnDelete.Enabled := False;

  //Others controls here ....
 
  btnCancel.Enabled := PosStatus in [doAdd, doEdit];
  btnSave.Enabled := PosStatus in [doAdd, doEdit];
  btnFirst.Enabled := not (PosStatus in [doAdd, doEdit]);
  btnLast.Enabled := not (PosStatus in [doAdd, doEdit]);
  btnPrior.Enabled := not (PosStatus in [doAdd, doEdit]);
  btnNext.Enabled := not (PosStatus in [doAdd, doEdit]);
end;

procedure TFmTest.btnAddClick(Sender: TObject);
begin
  SetFormStatus(doAdd);
end;

procedure TFmTest.btnEditClick(Sender: TObject);
begin
  SetFormStatus(doEdit);
end;

procedure TFmTest.btnCancelClick(Sender: TObject);
begin
  SetFormStatus(doQuery);
end;

procedure TFmTest.btnSaveClick(Sender: TObject);
begin
  SetFormStatus(doQuery);
end;

procedure TFmTest.FormInitialize;
begin
  SetFormStatus(doQuery);

end;

end.