----------dll工程文件testDll.pas----------------
library testDll;
{ 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,
DLLFrm in 'DLLFrm.pas' {frmDLL};
{$R *.res}
//输出ShowDLLModalForm,ShowDLLForm,ShowCalendar接口方法,以便外部程序调用
exports
ShowDLLModalForm, ShowDLLForm,ShowCalendar;
begin
end.
-----------------dll工程文件中的窗体文件DLLFrm.pas----------------
unit DLLFrm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, Calendar, ComCtrls, StdCtrls, Buttons, ExtCtrls;
type
TfrmDLL = class(TForm)
calDLLCalendar: TMonthCalendar;
Bevel1: TBevel;
OKBin: TBitBtn;
CancleBin: TBitBtn;
procedure calDLLCalendarDblClick(Sender: TObject);
procedure OKBinClick(Sender: TObject);
procedure CancleBinClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
{声明要引出的方法}
procedure ShowDLLModalForm(aHandle: THandle); stdcall; //模式显示窗口
procedure ShowDLLForm(aHandle: THandle); stdcall; //非模式显示窗口
function ShowCalendar(AHandle: THandle; ACaption: String): TDateTime;stdcall; //模式显示窗口,返回选择调用的日期
implementation
{$R *.dfm}
function ShowCalendar(AHandle: THandle; ACaption: String): TDateTime;
var
DLLForm: TfrmDLL;
begin
Application.Handle := AHandle;
DLLForm := TfrmDLL.Create(Application); //创建并显示窗体
try
DLLForm.Caption := ACaption; //获得标题
DLLForm.calDLLCalendar.date := Date();
DLLForm.ShowModal; //显示方式为模式化
if DLLForm.ModalResult = mrOk then
Result := DLLForm.calDLLCalendar.Date //返回设定日期
else Result := Date();
finally
DLLForm.Free; //用完后卸载该窗体
end;
end;
//模式显示窗口
procedure ShowDLLModalForm(aHandle: THandle);
begin
Application.Handle := aHandle; //传递应用程序句柄
with TfrmDLL.Create(Application) do //创建窗体
begin
try
ShowModal; //模式显示窗体
finally
free;
end;
end;
end;
//非模式显示窗口
procedure ShowDLLForm(aHandle: THandle);
begin
Application.Handle := aHandle; //传递应用程序句柄
with TfrmDLL.Create(application) do //创建窗体
Show; //非模式显示窗体
end;
procedure TfrmDLL.calDLLCalendarDblClick(Sender: TObject);
begin
self.Close;
ModalResult := mrOk;
end;
procedure TfrmDLL.OKBinClick(Sender: TObject);
begin
ModalResult := mrOk;
end;
procedure TfrmDLL.CancleBinClick(Sender: TObject);
begin
ModalResult := mrCancel;
end;
end.
--------------------测试单元文件FtestDll.pas,用于调用dll-----------------
unit FtestDll;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
//动态态引入DLL中的方法: 定义DLL中引出的过程类型
TShowDLLForm = procedure(aHandle: THandle); stdcall;
ShowDLLModalForm = procedure(aHandle: THandle); stdcall;
ShowCalendar = function (AHandle: THandle; ACaption: String): TDateTime;stdcall;
//静态引入DLL中的方法
//procedure ShowDLLModalForm(aHandle: THandle); stdcall external '../5-1/DLLShowForm.dll';
//procedure ShowDLLForm(aHandle: THandle); stdcall external '../5-1/DLLShowForm.dll';
//function ShowCalendar(AHandle: THandle; ACaption: String): TDateTime; stdcall external '../5-1/DLLShowForm.dll';
TFtest = class(TForm)
btnShowModal: TButton;
Button1: TButton;
getdateEdit: TEdit;
BtnShow: TButton;
procedure FormCreate(Sender: TObject);
procedure btnShowModalClick(Sender: TObject);
procedure BtnShowClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
//指向加载后DLL句柄
DLLHandle: THandle;
public
{ Public declarations }
end;
var
Ftest: TFtest;
implementation
{$R *.dfm}
procedure TFtest.FormCreate(Sender: TObject);
begin
if DLLHandle = 0 then
begin
DLLHandle := LoadLibrary('testDll.dll');
{如果DLLHandle为0,代表加载DLL失败}
if DLLHandle = 0 then
raise Exception.Create('不能加载DLLShowForm.dll');
end
else
MessageDlg('Library already Loaded', mtWarning, [mbok], 0);
end;
//调用DLL里输出的ShowDLLModalForm方法,模式显示窗口
procedure TFtest.btnShowModalClick(Sender: TObject);
var
ShowDLLForm: ShowDLLModalForm;
begin
//ShowDLLModalForm(Application.Handle); // 静态调用dll方式
@ShowDLLForm := GetProcAddress(DLLHandle, 'ShowDLLModalForm');
if (@ShowDLLForm = nil) then
RaiseLastWin32Error;
ShowDLLForm(Application.Handle)
end;
//静态调用dll方式:调用DLL里输出的ShowDLLForm方法,非模式显示函数
procedure TFtest.BtnShowClick(Sender: TObject);
var
ShowDLLForm: TShowDLLForm;
begin
//ShowDLLForm(Application.Handle); // 静态调用dll方式:
@ShowDLLForm := GetProcAddress(DLLHandle, 'ShowDLLForm');
if (@ShowDLLForm = nil) then
RaiseLastWin32Error;
ShowDLLForm(Application.Handle)
end;
{//静态调用dll方式
procedure TFtest.Button1Click(Sender: TObject);
var
getDate: Tdatetime;
begin
getDate := ShowCalendar(Application.Handle,'模式调用窗体');
getdateEdit.Text := datetostr(getDate);
end;
}
//动态调用dll中的方法
procedure TFtest.Button1Click(Sender: TObject);
var
MyShowCalendar: ShowCalendar;
getDate: Tdatetime;
begin
@MyShowCalendar := GetProcAddress(DLLHandle, 'ShowCalendar');
if (@MyShowCalendar = nil) then
RaiseLastWin32Error;
getDate := MyShowCalendar(Application.Handle,'test');
getdateEdit.Text := datetostr(getDate);
end;
{ //单独调用
procedure TFtest.Button1Click(Sender: TObject);
var
OneHandle : THandle; //定义一个句柄变量
begin
OneHandle := LoadLibrary('Clendar.dll'); //动态载入DLL,并返回其句柄
try
if OneHandle <> 0 then //如果载入成功则获取ShowCalendar函数的地址
@ShowCalendar := GetProcAddress(OneHandle, 'ShowCalendar');
if not (@ShowCalendar = nil) then
//如果找到该函数则在主窗体的Label1中显示DLL窗体中设定的日期
Label1.Caption := DateToStr(ShowCalendar(Application.Handle, Caption))
else
RaiseLastWin32Error;
finally
FreeLibrary(OneHandle); //调用完毕收回DLL占用的资源
end;
end;
}
procedure TFtest.FormDestroy(Sender: TObject);
begin
if not (DLLHandle = 0) then
begin
FreeLibrary(DLLHandle);
DLLHandle := 0;
end;
end;
end.
----------------------------end------------------------