在dll中delphi中封装窗体(实例)

来源:互联网 发布:阿里云九折推荐码 编辑:程序博客网 时间:2024/06/05 02:45

 dll工程

library FormDLL;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  SysUtils,
  Classes,
  Forms,
  DLLForm in 'DLLForm.pas' {frmDLL},
  dllFrom2 in 'dllFrom2.pas' {Form2};

{$R *.res}

exports
  SynAPP,ShowForm;


begin
end.

//dll单元文件一

unit DLLForm;

interface

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

type
  TfrmDLL = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }

  end;

var
  frmDLL: TfrmDLL;

  procedure SynAPP(App:THandle);stdcall;
  procedure ShowForm;stdcall;

implementation

uses Math,dllFrom2;

{$R *.dfm}

procedure SynAPP(App:THandle );stdcall;
begin
  Application.Handle := App;
end;

procedure ShowForm;stdcall;
begin
  try
    frmDLL := TfrmDLL.Create (Application);
    try
      if frmDLL.ShowModal = idOk then
      begin
        try
          Form2 := TForm2.Create(Application);
          Form2.ShowModal;
        finally
          FreeAndnil(Form2);
        end;
      end;
    finally
      FreeAndNil(frmDLL);
    end;
  except
    on E: Exception do
      MessageDlg ('Error in DLLForm: ' +
        E.Message, mtError, [mbOK], 0);
  end;
end;

procedure TfrmDLL.Button1Click(Sender: TObject);
begin
  self.ModalResult := idOk;
end;

end.

dll单元文件二

unit dllFrom2;

interface

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

type
  TForm2 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
var
  sMsg : string;
begin
  with TiniFile.Create(ExtractFilePath(paramstr(0)) + 'config.ini') do
  begin
    try
      sMsg := ReadString('hello','abc','NO');
      ShowMessage(sMsg);
    finally
      free;
    end;
  end;
end;

end.

测试工程

program test;

uses
  Forms,
  testDLLForm in 'testDLLForm.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

//单元文件

unit testDLLForm;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

procedure SynAPP(App:THandle);stdcall;external 'FormDLL.dll'; //这里的
procedure ShowForm;stdcall;external 'FormDLL.dll';

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  SynAPP(Application.Handle);
  ShowForm ;
end;

 

procedure TForm1.Button2Click(Sender: TObject);
var
  sMsg : string;
begin
  with TiniFile.Create(ExtractFilePath(paramstr(0)) + 'config.ini') do
  begin
    try
      sMsg := ReadString('hello','abc','NO');
      ShowMessage(sMsg);
    finally
      free;
    end;
  end;
end;

end.