uplugindemo.pas

来自「软件设计框架范例」· PAS 代码 · 共 133 行

unit uPlugInDemo;

interface

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

type
  TPluginDescribe = Function:Boolean; stdcall;
  TPluginDrawDescribe = procedure(DC:HDC;Rect:TRect); stdcall;
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    LibHandle: HMODULE;
    DwarProc: TPluginDrawDescribe;
    procedure LoadPlugins;
    procedure LoadPlugin(sr: TSearchRec);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  LibHandle:=0;
  LoadPlugins;
end;

procedure TForm1.LoadPlugins;
var
  sr: TSearchRec;
  path: string;
  Found: Integer;
begin
  path := ExtractFilePath(Application.Exename);
  try
    Found := FindFirst(path + '*.DLL', 0, sr);
    while Found = 0 do
    begin
      LoadPlugin(sr);
      Found := FindNext(sr);
    end;
  finally
    FindClose(sr);
  end;
end;

procedure TForm1.LoadPlugin(sr: TSearchRec);
var
  iLibHandle: HMODULE;
  pDescribeProc: TPluginDescribe;
  pDwarProc: TPluginDrawDescribe;
begin
  iLibHandle := LoadLibrary(Pchar(sr.Name));
  if iLibHandle <> 0 then
  begin
    try
      pDescribeProc := GetProcAddress(iLibHandle, 'loadpicture');
      pDwarProc := GetProcAddress(iLibHandle, 'drawpicture');
      if Assigned(pDescribeProc) and Assigned(pDwarProc) then
        ListBox1.Items.Add(sr.Name);
    finally
      FreeLibrary(iLibHandle);
    end;
  end else
    ShowMessage('loading Dll file error!');
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
var pDescribeProc: TPluginDescribe;
begin
  if ListBox1.ItemIndex<>-1 then
  begin
    if LibHandle<>0 then
      FreeLibrary(LibHandle);
    DwarProc:=nil;
    LibHandle := LoadLibrary(PChar(ListBox1.Items[ListBox1.ItemIndex]));
    if LibHandle <> 0 then
    begin
      try
        pDescribeProc := GetProcAddress(LibHandle, 'loadpicture');
        if pDescribeProc then
        begin
          DwarProc := GetProcAddress(LibHandle, 'drawpicture');
          Invalidate;
        end;
      Except
        FreeLibrary(LibHandle);
        LibHandle:=0;
      end;
    end
    else
      ShowMessage('loading Dll file error!');
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  try
    if (LibHandle<>0) and Assigned(DwarProc) then
      DwarProc(Self.Canvas.Handle,Self.ClientRect);
  Except
    if LibHandle<>0 then
    begin
      FreeLibrary(LibHandle);
      LibHandle:=0;
    end;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if LibHandle<>0 then
  begin
    FreeLibrary(LibHandle);
    LibHandle:=0;
  end;
end;

end.