請問高手插件主程序中能不能得到插件程序窗體關閉時的消息??? -开发者知识库

請問高手插件主程序中能不能得到插件程序窗體關閉時的消息??? -开发者知识库,第1张

本人在工作中創建一個插件窗體,編譯成Dll文件,然后通過插件主程序調用:插件Dll應放在和插件主程序下的plugins目錄下;當時我創建的是模式窗體,可是后來我想創建一個無模式窗體。請問高手我能不能在插件主程序中得到插件窗體關閉時的消息?(或者是說我能不能控制只創建一個無模式窗體?),如有高手指教,在下將感激不僅。


---------------------------------------------插件窗體-------------------------------------------------------------------------------

library Plugins;

uses
  SysUtils,
  Classes,
  PlugFrm in 'PlugFrm.pas' {frmPlugins};
exports
  ShowDllForm,GetCaption;
{$R *.res}

begin
end.

------------------------------------------------------------------------------------------------------------------------
unit PlugFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CheckLst, Grids, Mask, Buttons;

type
  TfrmPlugins = class(TForm)
    BitBtn1: TBitBtn;
    DrawGrid1: TDrawGrid;
    CheckListBox1: TCheckListBox;
  private

    { Private declarations }
  public
    { Public declarations }
  end;


var
  frmPlugins: TfrmPlugins;
  function ShowDllForm(AHandle:THandle;ACaption:string):integer;stdcall;
  function GetCaption:pChar;stdcall;


implementation

{$R *.dfm}

function GetCaption:pchar;stdCall;
begin
  Result:='插件程序測試窗體';
end;

function ShowDllForm(AHandle:THandle;ACaption:string):integer;stdcall;
var
  Dll_Form:TFrmPlugins;
begin
  Result:=0;
  try
    Application.Handle:=AHandle;
    //if not assigned(Dll_Form) then //是否已建立實例
      Dll_Form:=TFrmPlugins.Create(Application);
    try
      Dll_form.Caption:=ACaption;
      //Dll_form.ShowModal
      Dll_form.Show;
    finally
      //Dll_form.Free;
    end;
  except
    Result:=1;
  end;
end;


end.

-------------------------------------------------插件主程序-----------------------------------------------------------------------


unit PluginMain;

interface

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

type
  TForm1 = class(TForm)
    MainMenu: TMainMenu;
    fds1: TMenuItem;
    fdas1: TMenuItem;
    N_plugins: TMenuItem;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    procedure LoadPlugins;
    procedure PlugInsClick(Sender:Tobject);
    procedure FreePlugIns;
    procedure SearchFileExt(Const Dir,Ext:String;Files:TStrings);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TShowDllForm = function(AHandle:THandle;ACaption:string):integer;stdcall;

  TGetCaption = function:Pchar;Stdcall;

  EDllLoadError = Class(Exception);

  TTestPlugin = class
    Caption:String;
    Address:THandle;
    Call:Pointer;
  end;

var
  plugins:TList;

{ TForm1 }

procedure TForm1.SearchFileExt(Const Dir,Ext:String;Files:TStrings);
var
  Found:TSearchRec;
  Finished:integer;
begin
  Finished:=findfirst(Dir '*.*',faAnyFile ,Found);
  while (Finished=0)  do
  begin
    if pos(uppercase(ext),uppercase(Found.Name))>0 then
      Files.Add(Dir Found.Name);
    finished:=findNext(Found);
  end;
  FindClose(Found);
end;

procedure TForm1.LoadPlugIns;
var
  Files:TStrings;
  i:integer;
  TestPlugIn:TTestPlugin;
  NewMenu:TmenuItem;
  GetCaption:TGetCaption;
  s:string;
begin
  Files:=TStringlist.Create;//文件列表
  Plugins:=TList.Create;//插件列表

  s:=ExtractFilePath(Application.ExeName) 'Plugins\';

  SearchFileExt(s,'.dll',Files);
  for i:=0 to files.Count-1 do
  begin
    TestPlugIn:=TTestPlugin.Create;
    TestPlugIn.Address:=LoadLibrary(Pchar(Files[i]));
    if TestPlugIn.Address=0 then
      Raise EDllLoadError.Create('裝載' Pchar(Files[i]) '失敗');
    try
      @GetCaption:=GetProcAddress(TestPlugin.Address,'GetCaption'); //取函數地址
      TestPlugIn.Caption:=Getcaption;
      TestPlugIn.Call:=GetProcAddress(TestPlugin.Address,'ShowDllForm'); //取函數地址

      PlugIns.Add(TestPlugIn);//加插件列表

      Newmenu:=TMenuItem.Create(self);
      NewMenu.Caption:=TestPlugIn.Caption;
      NewMenu.OnClick:=PlugInsClick;
      NewMenu.Tag:=i;//插件標識
      N_PlugIns.Add(Newmenu);  //加插件表單
    except
      raise EdllLoadError.Create('初始化失敗');
    end;
  end;
end;

procedure TForm1.freePlugins;
var i:integer;
begin
  for i:=0 to PlugIns.Count-1 do
  begin
    FreeLibrary(TTestPlugIn(PlugIns[i]).Address);//釋放插件實例
  end;
  PlugIns.Free;//釋放插件列表
end;

procedure TForm1.PlugInsClick(Sender: Tobject);
var
  ShowDllForm:TShowDllForm;
begin
  //取插件函數地址
  @ShowDllForm:=TTestplugin(PlugIns[TMenuItem(Sender).Tag]).Call;
  //通過插件表示調用插件函數
  if ShowDllForm(Application.Handle,TTestPlugin(PlugIns[TmenuItem(sender).Tag]).Caption)=1 then
    ShowMessage('打開窗體錯誤');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  LoadPlugIns;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeplugIns;
end;

end.

4 个解决方案

#1


幫UP

最佳答案:

本文经用户投稿或网站收集转载,如有侵权请联系本站。

发表评论

0条回复