Var Module : THandle;
...
Module := LoadPackage('C:\MonPaquet.bpl'); // Chargement
...
UnloadPackage(Module); // Déchargement
					

Type
  EPluginError = Class(Exception);

...

Var MaClasse : TPersistentClass; // Classe de base
    Instance : TPersistent;      // Instance de l'objet a charger
...
MaClasse := GetClass('TMaClasse'); // Chargement de la classe depuis le package
If MaClasse = nil Then // GetClass renvoie nil en cas d'erreur
  Raise EPluginError.CreateFmt('Classe ''%s'' non trouvée', ['TMaClasse']); // Erreur
// Succes :
Instance := MaClasse.Create; // Création de l'objet
					

Var Classe : TPersistentClass; // Classe de base
    Instance : TPersistent;    // Instance de l'objet a charger
...
Classe := GetClass('TMaClasse'); // Chargement de la Classe depuis le package
If Classe = nil Then // GetClass renvoie nil en cas d'erreur
  Raise Exception.Create('Classe non trouvée'); // Erreur
// Succes :
Instance := TComponent(Classe).Create(Form1); // Création de l'objet
					

Var Instance : TPanel;
...
Instance := TPanel(Classe).Create(Form1); // Création de l'objet
					

// Chargement de Classe
If not Classe.InheritsFrom(TPanel) Then
  Raise Exception.Create('Cast impossible');
// Création de l'instance
					

Var MonPanel : TPanel;

Procedure CreatePanel;
Var Classe : TPersistentClass;
    Instance : TPanel;
Begin
  Classe := GetClass('TMaClasse');
  If Classe = nil Then
    Raise Exception.Create('Classe non trouvée');
  If not Classe.InheritsFrom(TPanel) Then
    Raise Exception.Create('Cast impossible');
  MonPanel := TPanel(Classe).Create(Form1); // Création de l'objet
  With MonPanel do
  Begin
    Parent := Form1;
	Color := clPurple;
	Align := alClient;
  End;
End;
					

Unit uMonPanel;

Interface

Uses Sysutils, ExtCtrls, Classes;

Type
  TMonPanel = Class(TPanel)
  Public
    Constructor Create(AOwner : TComponent); Override;
  End;

Implementation

Constructor TMonPanel.Create(Aowner : Tcomponent);
Begin
  Inherited Create(Aowner);
  Self.Color := clPurple;
End;

Initialization
  RegisterClass(TMonPanel);
Finalization
  UnregisterClass(TMonPanel);
End.
					

unit pkgCommon;

interface

Uses SysUtils, Types, Windows, Dialogs, Classes, Controls, Contnrs;

Type
  TPkgManager = Class(TObject)
  Private
    pInstanceList : Array of TObject;
    pPkgHandle : HModule;
    Procedure AddInstance(AObject : TObject);
    Procedure RemoveInstance(Index : Integer);
    Procedure ClearInstanceList;
    Procedure UpdateInstanceList;
  Public
    Destructor Destroy; Override;
    Procedure LoadPkg(APackage : String);
    Procedure UnLoadPkg;
    Function CreateInstanceOf(AClass : String) : TPersistent; Overload;
    Function CreateInstanceOf(AClass : String; AOwner : TComponent) : TControl; Overload;
  end;

implementation

ResourceString
  PKGALREADYCHARGED_ERROR_MSG = 'Un paquet est déjà chargé';
  LOADPKG_ERROR_MSG = 'Impossible de charger le paquet ''%s''';
  GETCLASS_ERROR_MSG = 'Impossible de charger la classe ''%s''';

Type
  TPkgGetClasses = Function : TStringDynArray;

Var
  GetClasses : TPkgGetClasses;

//------------------------------------------------------------------------------

Destructor TPkgManager.Destroy;
Begin
  Self.UnLoadPkg;     // Appel direct car UnLoadPkg est une méthode "Safe"
  Inherited Destroy;
end;

//------------------------------------------------------------------------------

Procedure TPkgManager.LoadPkg(APackage : String);
Begin
  If Self.pPkgHandle <> 0 then
    Raise Exception.Create(PKGALREADYCHARGED_ERROR_MSG);
  Self.pPkgHandle := LoadPackage(APAckage);
  If Self.pPkgHandle = 0 then
    Raise Exception.CreateFmt(LOADPKG_ERROR_MSG, [APackage]);
End;

//------------------------------------------------------------------------------

Procedure TPkgManager.UnLoadPkg;
Begin
  If Self.pPkgHandle <> 0 Then
  Begin
    Self.ClearInstanceList;
	UnLoadPackage(Self.pPkgHandle);
  end;
End;

//------------------------------------------------------------------------------

Function TPkgManager.CreateInstanceOf(AClass : String) : TPersistent;
Var Classe : TPersistentClass;
    Instance : TPersistent;
Begin
  Classe := GetClass(AClass);
  If Classe = Nil Then
    Raise Exception.CreateFmt(GETCLASS_ERROR_MSG, [AClass]);
  Instance := Classe.Create;
  Self.AddInstance(Instance);
  Result := Instance;
End;

//------------------------------------------------------------------------------

Function TPkgManager.CreateInstanceOf(AClass : String; AOwner : TComponent) : TControl;
Var Classe : TPersistentClass;
    Instance : TControl;
Begin
  Classe := GetClass(AClass);
  If Classe = Nil Then
    Raise Exception.CreateFmt(GETCLASS_ERROR_MSG, [AClass]);
  Instance := TControlClass(Classe).Create(AOwner);
  Self.AddInstance(Instance);
  Result := Instance;
End;

//------------------------------------------------------------------------------

Procedure TPkgManager.AddInstance(AObject : TObject);
Var Size : Integer;
Begin
  Size := Length(Self.pInstanceList);
  SetLength(Self.pInstanceList, Size+1);
  Self.pInstanceList[Size] := AObject;
End;

//------------------------------------------------------------------------------

Procedure TPkgMAnager.ClearInstanceList;
Var i : Integer;
Begin
  For i := 0 to Length(Self.pInstanceList)-1 do
    If Assigned(Self.pInstanceList[i]) Then
      FreeAndNil(Self.pInstanceList[i]);
End;

//------------------------------------------------------------------------------

Procedure TPkgManager.RemoveInstance(Index : Integer);
Var Size : Integer;
Begin
  Size := Length(Self.pInstanceList);
  If Index = Size-1 Then
    SetLength(Self.pInstanceList, Size-1)
  Else
  Begin
    Self.pInstanceList[index] := Self.pInstanceList[Size-1];
    SetLength(Self.pInstanceList, Size-1);
  End;
End;

//------------------------------------------------------------------------------

Procedure TPkgManager.UpdateInstanceList;
Var i : Integer;
Begin
  i := 0;
  While i < Length(Self.pInstanceList) do
  Begin
    If Not Assigned(Self.pInstanceList[i]) then
      Self.RemoveInstance(i);
    Inc(i);
  End;
End;

//------------------------------------------------------------------------------

End.
					

Type
  TOperationClass = Class of TOperation;

  TOperation = Class(TControl) // ou inférieur
  Public
    Function Execute(Val1, Val2 : Integer) : Integer; Abstract; Virtual;
  End;
				

Type
  TAddition = Class(TOperation)
  Public
    Function Execute(Val1, Val2 : Integer) : Integer; Override;
  End;

Function TAddition.Execute(Val1, Val2 : Integer) : Integer;
Begin
  Result := Val1 + Val2;
End;
				

Type
  TMultiplication = Class(TOperation)
  Public
    Function Execute(Val1, Val2 : Integer) : Integer; Override;
  End;

Function TMultiplication.Execute(Val1, Val2 : Integer) : Integer;
Begin
  Result := Val1 * Val2;
End;
				

unit PluginIntf;

interface

uses
  ExtCtrls;

type
  IPlugin = interface
    ['{F1F7186D-76E3-4DBD-8707-408C792B1C82}']
    function GetComponent : TPanel;
    property Component : TPanel read GetComponent;
  end;

implementation

end.
				

unit TestPlugin;

uses
  ExtCtrls, PluginIntf;

type
  TTestPlugin = class(TInterfacedObject, IPlugin)
  private
    FPanel : TPanel;
  public
    constructor Create;
    destructor Destroy; override;
    function GetComponent : TPanel;
  end;

function CreatePlugin : IPlugin;

exports CreatePlugin;

implementation

function CreatePlugin : IPlugin;
begin
  Result := TTestPlugin.Create;
end;

constructor TTestPlugin.Create;
begin
  inherited;
  FPanel := TPanel.Create(nil);
  with FPanel do
  begin
    Font.Size := 24;
    Font.Color := clBlue;
    Caption := 'Panel créé dans le plug-in';
    Width := 500;
    Height := 300;
  end;
end;

destructor TTestPlugin.Destroy;
begin
  FPanel.Free;
  inherited;
end;

function TTestPlugin.GetComponent : TPanel;
begin
  Result := FPanel;
end;

end.
				

unit MainForm;

uses
  Windows, Forms, PluginIntf, ...;

resourcestring
  sUnexistingFile = 'Le fichier ''%s'' n''existe pas';
  sDLLCantBeLoaded = 'La DLL ne peut être chargée';
  sPackageCantBeLoaded = 'Le package ne peut être chargé';
  sUnexistingFunction = 'La fonction %s n''existe pas';

type
  TFormMain = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Déclarations privées }
    PackHandle : HModule;
    Plugin : IPlugin;
  public
    { Déclarations publiques }
  end;

  EPluginError = class(Exception);

implementation

procedure TFormMain.FormCreate(Sender: TObject);
begin
  PackHandle := 0;
  Plugin := nil;
end;

procedure TFormMain.Button1Click(Sender: TObject);
type
  TCreatePluginFunc = function : IPlugin; stdcall;
var CreatePlugin : TCreatePluginFunc;
begin
  if PackHandle <> 0 then exit;
  try
    if not FileExists('TestPlugin.bpl') then
      raise EPluginError.CreateFmt(sUnexistingFile, [FFileName]);
    PackHandle := LoadPackage('TestPlugin.bpl');
    if PackHandle = 0 then
      raise EPluginError.Create(sPackageCantBeLoaded);
    CreatePlugin := GetProcAddress(PackHandle, 'CreatePlugin');
    if CreatePlugin = nil then
      raise EPluginError.CreateFmt(sUnexistingFunction, ['CreatePlugin']);
    Plugin := CreatePlugin;

    with Plugin.Component do
    begin
      ParentWindow := Form.Handle;
      SetParent(Handle, Form.Handle);
      Left := 0;
      Top := 0;
      Visible := True;
    end;
  except
    FormDestroy(nil);
    raise;
  end;
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  if Plugin <> nil then with Plugin.Component do
  begin
    ParentWindow := nil;
    SetParent(Handle, 0);
  end;
  Plugin := nil;
  if PackHandle <> 0 then
    UnloadPackage(FHandle);
  PackHandle := 0;
end;

end.
				

unit PluginIntf;

interface

uses
  ...;

type
  IPlugin = interface
    ['{F1F7186D-76E3-4DBD-8707-408C792B1C82}']
    function GetComponent : TAncetre;
    property Component : TAncetre read GetComponent;
  end;

implementation

end.
					

unit PluginIntf;

interface

uses
  ...;

const
  // Types de commandes pour IPluginCommands
  ComType_BigMenu = 'BigMenu';
  ComType_MenuSeparator = 'MenuSeparator';
  ComType_Menu = 'Menu';

type
  // Type de call-back pour l'ajout de commandes
  TEnumCommandsProc = procedure(ComType, Caption, Hint : string;
                                Shortcut : TShortCut; Bitmap : TBitmap;
                                OnExecute : TNotifyEvent) of object;

  // Interface obligatoire
  IPlugin = interface
    ['{F1F7186D-76E3-4DBD-8707-408C792B1C82}']
    ...
  end;

  // Interface pour les commandes
  IPluginCommands = interface
    ['{5E46D466-0D18-4733-84F8-D7F60EF00C71}']
    procedure EnumCommands(EnumCommandsProc : TEnumCommandsProc);
  end;

  // Autres interfaces
  ...

implementation

end.
						

unit PluginIntf;

interface

uses
  ...;

type
  // Interface obligatoire
  IPlugin = interface
    ['{F1F7186D-76E3-4DBD-8707-408C792B1C82}']
    ...
  end;

  // Interface pour le redimensionnement
  IPluginSizeable = interface
    ['{CD829089-E50B-41E4-94DD-41108282A762}']
    function GetMinWidth : integer;
    function GetMaxWidth : integer;
    function GetMinHeight : integer;
    function GetMaxHeight : integer;
    function GetCanMaximize : boolean;

    property MinWidth : integer read GetMinWidth;
    property MaxWidth : integer read GetMaxWidth;
    property MinHeight : integer read GetMinHeight;
    property MaxHeight : integer read GetMaxHeight;
    property CanMaximize : boolean read GetCanMaximize;
  end;

  // Autres interfaces
  ...

implementation

end.
						

unit PluginIntf;

interface

uses
  ...;

type
  // Interface obligatoire
  IPlugin = interface
    ['{F1F7186D-76E3-4DBD-8707-408C792B1C82}']
    ...
  end;

  // Interface pour les événements
  IPluginEvents = interface
    ['{262BDFEE-8DC4-47F7-8A64-2FB728C32FCE}']
    procedure QueryUnload(var CanUnload : boolean);
  end;

  // Autres interfaces
  ...

implementation

end.
						

unit PluginIntf;

interface

uses
  ...;

const
  // Types de commandes pour IPluginCommands
  ComType_BigMenu = 'BigMenu';
  ComType_MenuSeparator = 'MenuSeparator';
  ComType_Menu = 'Menu';

type
  // Type de call-back pour l'ajout de commandes
  TEnumCommandsProc = procedure(ComType, Caption, Hint : string;
                                Shortcut : TShortCut; Bitmap : TBitmap;
                                OnExecute : TNotifyEvent) of object;

  // Interface obligatoire
  IPlugin = interface
    ['{F1F7186D-76E3-4DBD-8707-408C792B1C82}']
    function GetComponent : TAncetre;
    property Component : TAncetre read GetComponent;
  end;

  // Interface pour les commandes
  IPluginCommands = interface
    ['{5E46D466-0D18-4733-84F8-D7F60EF00C71}']
    procedure EnumCommands(EnumCommandsProc : TEnumCommandsProc);
  end;

  // Interface pour le redimensionnement
  IPluginSizeable = interface
    ['{CD829089-E50B-41E4-94DD-41108282A762}']
    function GetMinWidth : integer;
    function GetMaxWidth : integer;
    function GetMinHeight : integer;
    function GetMaxHeight : integer;
    function GetCanMaximize : boolean;

    property MinWidth : integer read GetMinWidth;
    property MaxWidth : integer read GetMaxWidth;
    property MinHeight : integer read GetMinHeight;
    property MaxHeight : integer read GetMaxHeight;
    property CanMaximize : boolean read GetCanMaximize;
  end;

  // Interface pour les événements
  IPluginEvents = interface
    ['{262BDFEE-8DC4-47F7-8A64-2FB728C32FCE}']
    procedure QueryUnload(var CanUnload : boolean);
  end;

implementation

end.
					

unit TestPlugin;

interface

uses
  PluginIntf, ...;

type
  // Composant qui sera effectivement inséré dans la fiche
  TMonComposant = class(TAncetre);
    ...
  end;

  // Classe implémentant les interfaces
  TTestPlugin = class(TInterfacedObject, IPlugin, IPluginCommands, IPluginSizeable, IPluginEvents)
  private
    FComponent : TMonComposant;

    procedure TestExecute(Sender : TObject);
  public
    constructor Create;
    destructor Destroy; override;

    // Implémentation de IPlugin
    function GetComponent : TAncetre;

    // Implémentation de IPluginCommands
    procedure EnumCommands(EnumCommandsProc : TEnumCommandsProc);

    // Implémentation de IPluginSizeable
    function GetMinWidth : integer;
    function GetMaxWidth : integer;
    function GetMinHeight : integer;
    function GetMaxHeight : integer;
    function GetCanMaximize : boolean;

    // Implémentation de IPluginEvents
    procedure QueryUnload(var CanUnload : boolean);
  end;

function CreatePlugin : IPlugin; stdcall;

exports CreatePlugin;

implementation

function CreatePlugin : IPlugin;
begin
  Result := TTestPlugin.Create;
end;

constructor TTestPlugin.Create;
begin
  inherited;
  FComponent := TMonComposant.Create(nil);
end;

destructor TTestPlugin.Destroy;
begin
  FComponent.Free;
  inherited;
end;

procedure TTestPlugin.TestExecute(Sender : TObject);
begin
  ShowMessage('Test d''événement');
end;

function TTestPlugin.GetComponent : TAncetre;
begin
  Result := FComponent;
end;

procedure TTestPlugin.EnumCommands(EnumCommandsProc : TEnumCommandsProc);
begin
  EnumCommandsProc(ComType_BigMenu, 'Test', 'Test de menu principal', 0, nil, nil);
  EnumCommandsProc(ComType_Menu, 'Test', 'Test de menu', 0, nil, TestExecute);
end;

function TTestPlugin.GetMinWidth : integer;
begin
  Result := 100;
end;

function TTestPlugin.GetMaxWidth : integer;
begin
  Result := 0;
end;

function TTestPlugin.GetMinHeight : integer;
begin
  Result := 200;
end;

function TTestPlugin.GetMaxHeight : integer;
begin
  Result := 0;
end;

function TTestPlugin.GetCanMaximize : boolean;
begin
  Result := True;
end;

procedure TTestPlugin.QueryUnload(var CanUnload : boolean);
begin
  CanUnload := MessageBox('Voulez-vous vraiment décharger ce plug-in ?',
                          mtConfirmation, [mbYes, mbNo]) = mrYes;
end;

end.
					

unit PluginClass;

interface

uses
  PluginIntf, ...;

// Si vous activez la défition suivante, les plug-in seront chargés en tant que
// DLL, et non que packages. Les plug-in de type DLL sont obsolètes, d'où le
// nom de cette définition.
{.$DEFINE OLD_STYLE_PLUGIN}

resourcestring
  sUnexistingFile = 'Le fichier ''%s'' n''existe pas';
  sDLLCantBeLoaded = 'La DLL ne peut être chargée';
  sPackageCantBeLoaded = 'Le package ne peut être chargé';
  sUnexistingFunction = 'La fonction %s n''existe pas';

type
  EPluginError = class(Exception);

  TPlugin = class
  private
    FFileName : TFileName;

    FHandle : HModule;
    FPlugin : IPlugin;
    FPluginSupportsCommands : boolean;
    FPluginCommands : IPluginCommands;
    FPluginSupportsSizeable : boolean;
    FPluginSizeable : IPluginSizeable;
    FPluginSupportsEvents : boolean;
    FPluginEvents : IPluginEvents;

    FComponent : TAncetre;

    FImages : TImageList;
    FImagesCount : integer;
    FBigMenu : TMenuItem;
    FBigMenuCount : integer;
    FCommandsObjects : TObjectList;
    FCurrentBigMenu : TMenuItem;

    FMinWidth : integer;
    FMaxWidth : integer;
    FMinHeight : integer;
    FMaxHeight : integer;
    FCanMaximize : boolean;

    function GetWidth : integer;
    function GetHeight : integer;
    procedure SetWidth(New : integer);
    procedure SetHeight(New : integer);

    procedure CreateInstance;
    procedure ReleaseInstance;
    procedure AddCommand(ComType, Caption, Hint : string;
                         ShortCut : TShortCut; Bitmap : Graphics.TBitmap;
                         OnExecute : TNotifyEvent);
    procedure AddCommands(Images : TImageList; BigMenu : TMenuItem);
    procedure RemoveCommands;
  public
    constructor Create(AFileName : TFileName);
    destructor Destroy; override;

    procedure Load(Form : TForm; Images : TImageList; BigMenu : TMenuItem;
                   TopOfComponent : integer);
    procedure UnLoad;

    property Width : integer read GetWidth write SetWidth;
    property Height : integer read GetHeight write SetHeight;
    property CanResize : boolean read FPluginSupportsSizeable;
    property MinWidth : integer read FMinWidth;
    property MaxWidth : integer read FMaxWidth;
    property MinHeight : integer read FMinHeight;
    property MaxHeight : integer read FMaxHeight;
    property CanMaximize : boolean read FCanMaximize;
  end;

implementation

constructor TPlugin.Create(AFileName : TFileName);
begin
  inherited Create;
  FFileName := AFileName;

  FHandle := 0;
  FPlugin := nil;
  FPluginSupportsCommands := False;
  FPluginCommands := nil;
  FPluginSupportsSizeable := False;
  FPluginSizeable := nil;
  FPluginSupportsEvents := False;
  FPluginEvents := nil;

  FComponent := nil;

  FImages := nil;
  FImagesCount := 0;
  FBigMenu := nil;
  FBigMenuCount := 0;
  FCommandsObjects := nil;
  FCurrentBigMenu := nil;
  
  FMinWidth := 0;
  FMaxWidth := 0;
  FMinHeight := 0;
  FMaxHeight := 0;
  FCanMaximize := False;
end;

destructor TPlugin.Destroy;
begin
  if FHandle <> 0 then ReleaseInstance;
  inherited Destroy;
end;

function TPlugin.GetWidth : integer;
begin
  Result := FComponent.Width;
end;

function TPlugin.GetHeight : integer;
begin
  Result := FComponent.Height;
end;

procedure TPlugin.SetWidth(New : integer);
begin
  if CanResize and
     ((MinWidth = 0) or (New >= MinWidth)) and
     ((MaxWidth = 0) or (New <= MaxWidth)) then
    FComponent.Width := New;
end;

procedure TPlugin.SetHeight(New : integer);
begin
  if CanResize and
     ((MinHeight = 0) or (New >= MinHeight)) and
     ((MaxHeight = 0) or (New <= MaxHeight)) then
    FComponent.Height := New;
end;

procedure TPlugin.CreateInstance;
type
  TCreatePluginFunc = function : IPlugin; stdcall;
var CreatePlugin : TCreatePluginFunc;
begin
  if FHandle <> 0 then exit;
  try
    if not FileExists(FFileName) then
      raise EPluginError.CreateFmt(sUnexistingFile, [FFileName]);
    {$IFDEF OLD_STYLE_PLUGIN}
      FHandle := LoadLibrary(PChar(FFileName));
      if FHandle = 0 then
        raise EPluginError.Create(sDLLCantBeLoaded);
    {$ELSE}
      FHandle := LoadPackage(FFileName);
      if FHandle = 0 then
        raise EPluginError.Create(sPackageCantBeLoaded);
    {$ENDIF}
    CreatePlugin := GetProcAddress(FHandle, 'CreatePlugin');
    if CreatePlugin = nil then
      raise EPluginError.CreateFmt(sUnexistingFunction, ['CreatePlugin']);
    FPlugin := CreatePlugin;
    try
      FPluginCommands := FPlugin as IPluginCommands;
      FPluginSupportsCommands := True;
    except
    end;
    try
      FPluginSizeable := FPlugin as IPluginSizeable;
      FPluginSupportsSizeable := True;
      FMinWidth := FToolSizeable.MinWidth;
      FMaxWidth := FToolSizeable.MaxWidth;
      FMinHeight := FToolSizeable.MinHeight;
      FMaxHeight := FToolSizeable.MaxHeight;
      FCanMaximize := FToolSizeable.CanMaximize;
    except
    end;
    try
      FPluginEvents := FPlugin as IPluginEvents;
      FPluginSupportsEvents := True;
    except
    end;
  except
    ReleaseInstance;
    raise;
  end;
end;

procedure TPlugin.ReleaseInstance;
begin
  FMinWidth := 0;
  FMaxWidth := 0;
  FMinHeight := 0;
  FMaxHeight := 0;
  FCanMaximize := False;
  FPluginEvents := nil;
  FPluginSupportsEvents := False;
  FPluginSizeable := nil;
  FPluginSupportsSizeable := False;
  FPluginCommands := nil;
  FPluginSupportsCommands := False;
  FPlugin := nil;
  if FHandle <> 0 then
    {$IFDEF OLD_STYLE_PLUGIN}
      FreeLibrary(FHandle);
    {$ELSE}
      UnloadPackage(FHandle);
    {$ENDIF}
  FHandle := 0;
end;

procedure TPlugin.AddCommand(ComType, Caption, Hint : string;
                             Shortcut : TShortCut; Bitmap : Graphics.TBitmap;
                             OnExecute : TNotifyEvent);
var Action : TAction;
    MenuItem : TMenuItem;
    Bmp : Graphics.TBitmap;
    I : integer;
begin
  if ComType = ComType_BigMenu then
  begin
    FCurrentBigMenu := TMenuItem.Create(nil);
    FCurrentBigMenu.Caption := Caption;
    FCurrentBigMenu.Hint := Hint;
    FBigMenu.Add(FCurrentBigMenu);
    FCommandsObjects.Add(FCurrentBigMenu);
  end else
  if ComType = ComType_MenuSeparator then
  begin
    if FCurrentBigMenu = nil then exit;
    MenuItem := TMenuItem.Create(nil);
    MenuItem.Caption := '-';
    FCurrentBigMenu.Add(MenuItem);
    FCommandsObjects.Add(MenuItem);
  end else
  if ComType = ComType_Menu then
  begin
    if FCurrentBigMenu = nil then exit;
    Action := TAction.Create(nil);
    Action.Caption := Caption;
    Action.Hint := Hint;
    Action.ShortCut := ShortCut;
    if (Bitmap <> nil) and (not Bitmap.Empty) then
    begin
      Bmp := Graphics.TBitmap.Create;
      Bmp.Width := 16;
      Bmp.Height := 16;
      Bmp.Canvas.CopyRect(Rect(0, 0, 16, 16),
                          Bitmap.Canvas,
                          Rect(0, 0, Bitmap.Width, Bitmap.Height));
      FImages.AddMasked(Bmp, clTeal);
      Bmp.Free;
      Action.ImageIndex := FImages.Count-1;
    end;
    Action.OnExecute := OnExecute;
    FCommandsObjects.Add(Action);
    MenuItem := TMenuItem.Create(nil);
    MenuItem.Action := Action;
    FCurrentBigMenu.Add(MenuItem);
    FCommandsObjects.Add(MenuItem);
  end;
end;

procedure TPlugin.AddCommands(Images : TImageList; BigMenu : TMenuItem);
begin
  if not FPluginSupportsCommands then exit;

  FImages := Images;
  FImagesCount := FImages.Count;
  FBigMenu := BigMenu;
  FBigMenuCount := FBigMenu.Count;
  FCommandsObjects := TObjectList.Create;

  FCurrentBigMenu := nil;
  FPluginCommands.EnumCommands(AddCommand);
end;

procedure TPlugin.RemoveCommands;
begin
  if not FPluginSupportsCommands then exit;

  while FBigMenu.Count > FBigMenuCount do
    FBigMenu.Delete(FBigMenuCount);
  while FImages.Count > FImagesCount do
    FImages.Delete(FImagesCount);
  FImages := nil;
  FImagesCount := 0;
  FBigMenu := nil;
  FBigMenuCount := 0;
  FCommandsObjects.Free;
end;

procedure TPlugin.Load(Form : TForm; Images : TImageList; BigMenu : TMenuItem;
                       TopOfComponent : integer);
begin
  try
    CreateInstance;
    FComponent := FPlugin.Component;
    with FComponent do
    begin
      ParentWindow := Form.Handle;
      SetParent(Handle, Form.Handle);
      Left := 0;
      Top := TopOfComponent;
      Visible := True;
    end;

    AddCommands(Images, BigMenu);
  except
    on Error : Exception do
      raise EPluginError.Create(Error.Message);
  end;
end;

procedure TPlugin.Unload;
begin
  if FHandle = 0 then exit;
  RemoveCommands;
  FComponent.ParentWindow := 0;
  SetParent(FComponent.Handle, 0);
  FComponent := nil;
  ReleaseInstance;
end;

end.
						

procedure TPlugin.CreateInstance;
type
  TCreatePluginFunc = function : IPlugin; stdcall;
var CreatePlugin : TCreatePluginFunc;
begin
  if FHandle <> 0 then exit;
  try
    if not FileExists(FFileName) then
      raise EPluginError.CreateFmt(sUnexistingFile, [FFileName]);
    {$IFDEF OLD_STYLE_PLUGIN}
      FHandle := LoadLibrary(PChar(FFileName));
      if FHandle = 0 then
        raise EPluginError.Create(sDLLCantBeLoaded);
    {$ELSE}
      FHandle := LoadPackage(FFileName);
      if FHandle = 0 then
        raise EPluginError.Create(sPackageCantBeLoaded);
    {$ENDIF}
    CreatePlugin := GetProcAddress(FHandle, 'CreatePlugin');
    if CreatePlugin = nil then
      raise EPluginError.CreateFmt(sUnexistingFunction, ['CreatePlugin']);
    FPlugin := CreatePlugin;
    try
      FPluginCommands := FPlugin as IPluginCommands;
      FPluginSupportsCommands := True;
    except
    end;
    try
      FPluginSizeable := FPlugin as IPluginSizeable;
      FPluginSupportsSizeable := True;
      FMinWidth := FToolSizeable.MinWidth;
      FMaxWidth := FToolSizeable.MaxWidth;
      FMinHeight := FToolSizeable.MinHeight;
      FMaxHeight := FToolSizeable.MaxHeight;
      FCanMaximize := FToolSizeable.CanMaximize;
    except
    end;
    try
      FPluginEvents := FPlugin as IPluginEvents;
      FPluginSupportsEvents := True;
    except
    end;
  except
    ReleaseInstance;
    raise;
  end;
end;
							

procedure TPlugin.ReleaseInstance;
begin
  FMinWidth := 0;
  FMaxWidth := 0;
  FMinHeight := 0;
  FMaxHeight := 0;
  FCanMaximize := False;
  FPluginEvents := nil;
  FPluginSupportsEvents := False;
  FPluginSizeable := nil;
  FPluginSupportsSizeable := False;
  FPluginCommands := nil;
  FPluginSupportsCommands := False;
  FPlugin := nil;
  if FHandle <> 0 then
    {$IFDEF OLD_STYLE_PLUGIN}
      FreeLibrary(FHandle);
    {$ELSE}
      UnloadPackage(FHandle);
    {$ENDIF}
  FHandle := 0;
end;
							

procedure TPlugin.AddCommand(ComType, Caption, Hint : string;
                             Shortcut : TShortCut; Bitmap : Graphics.TBitmap;
                             OnExecute : TNotifyEvent);
var Action : TAction;
    MenuItem : TMenuItem;
    Bmp : Graphics.TBitmap;
    I : integer;
begin
  if ComType = ComType_BigMenu then
  begin
    FCurrentBigMenu := TMenuItem.Create(nil);
    FCurrentBigMenu.Caption := Caption;
    FCurrentBigMenu.Hint := Hint;
    FBigMenu.Add(FCurrentBigMenu);
    FCommandsObjects.Add(FCurrentBigMenu);
  end else
  if ComType = ComType_MenuSeparator then
  begin
    if FCurrentBigMenu = nil then exit;
    MenuItem := TMenuItem.Create(nil);
    MenuItem.Caption := '-';
    FCurrentBigMenu.Add(MenuItem);
    FCommandsObjects.Add(MenuItem);
  end else
  if ComType = ComType_Menu then
  begin
    if FCurrentBigMenu = nil then exit;
    Action := TAction.Create(nil);
    Action.Caption := Caption;
    Action.Hint := Hint;
    Action.ShortCut := ShortCut;
    if (Bitmap <> nil) and (not Bitmap.Empty) then
    begin
      Bmp := Graphics.TBitmap.Create;
      Bmp.Width := 16;
      Bmp.Height := 16;
      Bmp.Canvas.CopyRect(Rect(0, 0, 16, 16),
                          Bitmap.Canvas,
                          Rect(0, 0, Bitmap.Width, Bitmap.Height));
      FImages.AddMasked(Bmp, clTeal);
      Bmp.Free;
      Action.ImageIndex := FImages.Count-1;
    end;
    Action.OnExecute := OnExecute;
    FCommandsObjects.Add(Action);
    MenuItem := TMenuItem.Create(nil);
    MenuItem.Action := Action;
    FCurrentBigMenu.Add(MenuItem);
    FCommandsObjects.Add(MenuItem);
  end;
end;

procedure TPlugin.AddCommands(Images : TImageList; BigMenu : TMenuItem);
begin
  if not FPluginSupportsCommands then exit;

  FImages := Images;
  FImagesCount := FImages.Count;
  FBigMenu := BigMenu;
  FBigMenuCount := FBigMenu.Count;
  FCommandsObjects := TObjectList.Create;

  FCurrentBigMenu := nil;
  FPluginCommands.EnumCommands(AddCommand);
end;
							

procedure TPlugin.Load(Form : TForm; Images : TImageList; BigMenu : TMenuItem;
                       TopOfComponent : integer);
begin
  try
    CreateInstance;
    FComponent := FPlugin.Component;
    with FComponent do
    begin
      ParentWindow := Form.Handle;
      SetParent(Handle, Form.Handle);
      Left := 0;
      Top := TopOfComponent;
      Visible := True;
    end;

    AddCommands(Images, BigMenu);
  except
    on Error : Exception do
      raise EPluginError.Create(Error.Message);
  end;
end;

procedure TPlugin.Unload;
begin
  if FHandle = 0 then exit;
  RemoveCommands;
  FComponent.ParentWindow := 0;
  SetParent(FComponent.Handle, 0);
  FComponent := nil;
  ReleaseInstance;
end;
							

unit MainForm;

interface

uses
  PluginClass, ...;

type
  TFormMain = class(TForm)
    ImageList: TImageList;
    ActionList: TActionList;
    ActionCharger: TAction;
    ActionDecharger: TAction;
    BigMenu: TMainMenu;
    BigMenuFichier: TMenuItem;
    MenuCharger: TMenuItem;
    MenuDecharger: TMenuItem;
    ToolBar: TToolBar;
    ToolButtonCharger: TToolButton;
    ToolButtonDecharger: TToolButton;
    StatusBar: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ActionChargerExecute(Sender: TObject);
    procedure ActionDechargerExecute(Sender: TObject);
    procedure ResizePlugin(Sender: TObject);
  private
    { Déclarations privées }
    Plugin : TPlugin;
  public
    { Déclarations publiques }
  end;

var
  FormMain: TFormMain;

implementation

procedure TFormMain.FormCreate(Sender: TObject);
begin
  Plugin := TPlugin.Create('TestPlugin.bpl');
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  Plugin.Free;
end;

procedure TFormMain.ActionChargerExecute(Sender: TObject);
begin
  Plugin.Load(Self, BigMenu.Items, ImageList, ToolBar.Height);
  ClientWidth := Plugin.Width;
  ClientHeight := Plugin.Height+ToolBar.Height+StatusBar.Height;
  if Plugin.CanResize then
  begin
    BorderStyle := bsSizeable;
    with Constraints do
    begin
      MinWidth := Plugin.MinWidth;
      MaxWidth := Plugin.MaxWidth;
      MinHeight := Plugin.MinHeight+ToolBar.Height+StatusBar.Height;
      MaxHeight := Plugin.MaxHeight+ToolBar.Height+StatusBar.Height;
    end;
    if Plugin.CanMaximize then
      BorderIcons := [biSystemMenu, biMinimize, biMaximize];
    OnResize := ResizePlugin;
  end;
end;

procedure TFormMain.ActionDechargerExecute(Sender: TObject);
begin
  OnResize := nil;
  Plugin.Unload;
  BorderIcons := [biSystemMenu, biMinimize];
  width Constraints do
  begin
    MinWidth := 0;
    MaxWidth := 0;
    MinHeight := 0;
    MaxHeight := 0;
  end;
  BorderStyle := bsSingle;
  ClientWidth := 300;
  ClientHeight := 200;
end;

procedure TFormMain.ResizePlugin(Sender: TObject);
begin
  Plugin.Width := ClientWidth;
  Plugin.Height := ClientHeight-ToolBar.Height-StatusBar.Height;
end;

end.