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

来源:互联网 发布:天猫双11 数据 秋裤 编辑:程序博客网 时间:2024/06/05 02:50

 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.