在DLL中定义MDIChild Form的DLL代码和执行程序代码

来源:互联网 发布:淘宝有哪些行业 编辑:程序博客网 时间:2024/05/16 06:33

艾老师,关于在 dll 中显示 mdi 子窗体的问题 

dll 里的函数
function openForm(mainForm:forms):tform;stdcall;
var
  f:tform5;
  ptr:pLongint;

begin
 
  ptr:=@(application.MainForm);
  ptr^:=Longint(MainForm);
  f:=tform5.Create(mainForm);
  f.Show;
  result:=f;
end;

主程序里就是用的静态调用

==============================
我查了查大富翁的贴子,好多都是这么做的,可我的这个窗体可以显示出来,但就不是子窗体

不知为什么

请艾老师指点一下

代码的想法是好的。以下是在DLL中定义MDIChild Form的DLL代码和执行程序代码。 [2457字节 aizb 2006-3-17 22:25:49 回复:0/9 版块:Delphi基础教程]

library Project2;

uses
  SysUtils,
  Classes,
  Forms,
  Windows,
  Unit2 in 'Unit2.pas' {Form2};

{$R *.res}
var P:^TForm;

Function CreateMIDChildForm(MainForm:TForm):TForm;stdcall;
begin
  //在DLL中的Application和主程序中的Application是两个不同的对象,这个Application的MainForm是nil。
  P:=@Application.MainForm;//取得Application.MainForm的地址。
  P^:=MainForm;//将该地址指向的值赋为MainForm,即让该地址指向传入MDIForm,这个技巧有时虽然能解决问题,但是并不是Borland推荐的。
  result:=TForm2.Create(MainForm);//创建MDIChild。
  result.Show;//显式MDIChild。
end;

//导出函数。
Exports CreateMIDChildForm;

procedure DLLExitProc(Reason: Integer);
var i:Integer;
begin
  //注意这段代码。
  if Reason = DLL_PROCESS_DETACH then
  //DLL释放的时候将执行传入参数DLL_PROCESS_DETACH。
  begin
    //检查Application的MainForm的每一个MDIChildForm,如果类型为TForm2,则释放掉,否则会出错。
    for i:=0 to Application.MainForm.MDIChildCount-1 do
      if Application.MainForm.MDIChildren[i] is TForm2 then
        Application.MainForm.MDIChildren[i].Free;
    //恢复Application.MainForm为nil.
    P:=@Application.MainForm;
    P^:=nil;
  end;
end;

begin
  //将DLLProc全局过程变量指向自定义的过程DLLExitProc
  DLLProc := @DLLExitProc;
  DLLExitProc(DLL_PROCESS_ATTACH);//调用一次DLLExitProc,这是DLL装载的时候需要执行的,所以传入DLL_PROCESS_ATTACH。
end.


调用程序的源码:


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    H:THandle;
    { Private declarations }
  public
    { Public declarations }
  end;
  TCreateMIDChildForm =Function (MainForm:TForm):TForm;stdcall;
var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
Var
  CreateMIDChildForm:Pointer;
begin
  if (h<>INVALID_HANDLE_VALUE) and (h<>0) then
  begin
    //取得DLL中的函数地址。
    CreateMIDChildForm:=GetProcAddress(h,'CreateMIDChildForm');
    if CreateMIDChildForm<>nil then//如果地址不为nil
    begin
      //调用函数。
      TCreateMIDChildForm(CreateMIDChildForm)(self);
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //装载DLL。
  H:=LoadLibrary('Project2.DLL');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if (h<>INVALID_HANDLE_VALUE) and (h<>0) then
  begin
    //释放DLL。
    FreeLibrary(h);
  end;
end;

end.

原创粉丝点击