Lazarus中文社区

 找回密码
 立即注册(注册审核可向QQ群索取)

QQ登录

只需一步,快速开始

Lazarus IDE and 组件 下载地址版权申明
查看: 3164|回复: 4

Lazarus0931+FPC2.7.1下DLL窗体创建及调用小记

[复制链接]

该用户从未签到

发表于 2012-3-13 16:19:43 | 显示全部楼层 |阅读模式
同步发布在博客园:http://www.cnblogs.com/godspeeds ... /03/13/2392182.html
Computer is full of bugs
You can't eat them
So just get used to them.
-- 别想了,我说的
                                    

此贴及原博客园贴子出自本人原创,转载请注明出处,谢谢。
看了官方论坛上的一个贴子,试着写了一个类似于 InputBox函数的DLL,期间处理了几个小问题,整理一下,做个备忘。
系统环境:Win7 32bit中文版,lazarus 2012/3/12 daily snapshot,fpc2.7.1.
先看一下测试程序运行的效果。
一、主程序窗口:
窗口设置为固定边框,无最大最小按钮,“(R)获取”按钮为窗体默认按钮,“(C)退出”按钮设为ESC键。

二、按“获取”按钮,askForInt模式窗口弹出,文本框默认获取焦点,默认为0,等待输入。请注意此时主窗口无法获取焦点,虽然是模式对话框的正常反应,但因呼叫DLL,所以此处在后来的程序中确实出现了意外,花了一阵功夫才解决!!
另外请注意该askForInt 对话框固定边框,无系统按钮(最大、最小、关闭),也不能按Alt+F4强制退出,在下面的实现部分只关注代码,GUI设计部分不再赘述。

三、程序要求只接受整数输入,当输入非整数值时,弹出错误提示:

四、单击OK按钮,退回到输入整数模式对话框,输入整数的文本框重新获取焦点,等待再次输入。尝试按Alt+F4强制退出失败:

五、重新输入有效整数899:

六、主测试窗口获得该整数:

以下为实现。
一、DLL部分的实现
1.从Lazarus IDE新建一个library工程,保存为askfor. 看一下askfor.lpr的代码:
1 library askfor;
2
3 {$mode objfpc}{$H+}
4
5 uses
6   Classes, uaskfor ,interfaces,forms
7   { you can add units after this };
8 //如果没有下面这行,请添加,因为DLL包含GUI控件
9 { $R *.res}
10 //你需要添加以下整个exports部分(11-14行):
11 exports
12   {以下为需要导出DLL的函数,函数名为askForInt,返回值为integer}
13   
14   askForInt;
15
16 begin
17    Application.Initialize;//你需要添加的代码部分
18 end.
呵呵,Lazarus做DLL真是简单了明~

2.为工程添加一个Form窗体单元,保存为uaskfor.
以下为窗体的*.frm文件内容:
1 object Form1: TForm1
2   Left = 540
3   Height = 124
4   Top = 260
5   Width = 413
6   BorderIcons = []
7   BorderStyle = bsDialog
8   Caption = '数字:'
9   ClientHeight = 124
10   ClientWidth = 413
11   OnCloseQuery = FormCloseQuery
12   OnCreate = FormCreate
13   Position = poScreenCenter
14   LCLVersion = '0.9.31'
15   object Label1: TLabel
16     Left = 16
17     Height = 13
18     Top = 14
19     Width = 163
20     Caption = '请输入一个数字(默认为O):'
21     ParentColor = False
22   end
23   object txtNumber: TEdit
24     Left = 16
25     Height = 25
26     Top = 40
27     Width = 368
28     TabOrder = 0
29     Text = '0'
30   end
31   object btnOK: TButton
32     Left = 304
33     Height = 25
34     Top = 72
35     Width = 75
36     Caption = '&OK'
37     Default = True
38     OnClick = btnOKClick
39     TabOrder = 1
40   end
41 end
注意OK按钮为窗体默认按钮(btnOK.default:=true).

3.窗体包含OK按钮单击事件的默认代码:
1 unit uaskfor;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8   classes, sysutils, fileutil, forms, controls, graphics, dialogs, StdCtrls, Buttons;
9
10 type
11
12   { tform1 }
13
14   tform1 = class(tform)
15     btnOK: tbutton;//OK按钮
16     txtNumber: TEdit;//按受整数文本框
17     label1: tlabel;
18     procedure btnokclick(sender: tobject);//OK按钮单击事件
19
20   private
21     { private declarations }
22   
23   public
24     { public declarations }
25   end;
26
27 var
28   form1: tform1;
29
30 implementation
31
32 {$R *.lfm}
33
34 procedure tform1.btnokclick(sender: tobject);
35 begin
36  
37 end;

4.因为要获取一个整数,首先需要一个integer类型的变量number, 添加在第29行。
27  var
28     form1:tform1;
39     number:integer;//number 用来保存程序获取的整数值

5.用户输入一个值,然后程序进行判断,如果合法,则保存在number变量里,然后窗体关闭;如果不合法,提示,然后要求重新输入,焦点定位在文本框里:
1 procedure tform1.btnokclick(sender: tobject);
2 begin
3   try
4      number:=strtoint(txtNumber.Text);
5      close;//关闭窗体并退出
6   Except on Exception do  begin
7      application.MessageBox('输入错误!','输入整数',0);
8      self.txtNumber.SetFocus;
9
10      end;
11   end;
12
13 end;

6.那么另一个窗体如何能调用到number呢?正常情况下,添加对uaskfor单元的引用之后,就可以直接引用了。这里我们用函数来用。还记得在askfor.lpr工程代码的那个函数askForInt吗?它的返回值为integer.现在的askfor.pas单元代码如下:
1 unit uaskfor;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8   classes, sysutils, fileutil, forms, controls, graphics, dialogs, StdCtrls, Buttons;
9
10 type
11
12   { tform1 }
13
14   tform1 = class(tform)
15     btnOK: tbutton;//OK按钮
16     txtNumber: TEdit;//按受整数文本框
17     label1: tlabel;
18     procedure btnokclick(sender: tobject);//OK按钮单击事件
19
20   private
21     { private declarations }
22   
23   public
24     { public declarations }
25   end;
26
27 var
28   form1: tform1;
29
30 implementation
31
32 {$R *.lfm}
33
34 function askForInt:integer;stdcall;export;
35
36 procedure tform1.btnokclick(sender: tobject);
37 begin
38   try
39      number:=strtoint(txtNumber.Text);
40      
41      close;//关闭窗体并退出
42   Except on Exception do  begin
43      application.MessageBox('输入错误!','输入整数',0);
44      self.txtNumber.SetFocus;
45      
46      end;
47   end;
48
49 end;
50
51
52 function askforint: integer; stdcall;
53 begin
54     result:=number;
55
56 end;

我们在34行添加了一个 askForInt函数,注意 stdcall;export 修饰符为导出DLL提供了必要的支持。52-56行是该函数的实现,简单返回number 的值。
7.如何保证输入不合法的时候窗体不允许强制关闭(ALT-F4)?在窗体的FormCloseQuery(sender: tobject; var canclose: boolean)事件里,当参数canClose为真是可以关闭窗体,为假时就关不了了。
接下来的逻辑是这样的:
if 输入合法 then
  canClose:=true
else
  canClose:=false;

8.那么我们在何处判断输入是合法的呢?ok 按钮单击事件里,分别在第39行和第42行。其中第39行说明strtoint类型转换成功,而第42行转化失败系统抛出异常。我们为TForm1 声明一个boolean型变量okToClose,39行没抛出异常时okToClose应为true,而42行时应为false.接下来,okToClose为真时,canClose就为真;okToClose为假时,canClose 就为假。
procedure tform1.formclosequery(sender: tobject; var canclose: boolean);
begin
  canclose:=okToClose;
end;

9.差不多了,再说两点。那么okToClose是何时何地初始化的?初始值为真还是为假?我们说,Form不能被关闭,除非...(除非输入合法),所以初始值应为假,只有在输入合法时才被修正为真,即上面所讲的第39行,这样当输入非法时,在异常部分即便不给okToClose赋值,它也是为假,符合系统的设计。一般地,窗体的变量初始化在Form 的 FormCreate 事件里做就可以了。另外,当窗体一弹出时,接受输入的文本框即获得焦点方显得合乎道理一些。这两个问题都放在Form的FormCreate事件里处理:
procedure tform1.formcreate(sender: tobject);
begin
  
  okToClose:=false;
  txtNumber.Focused;
end;

10.现在剩下最后一步了:askForInt函数可以获取所需要的整数输入,但问题是对话框窗口是几时打开的呢?不至一个方案可以解决,我们先偿试在askForInt函数里打开这个对话框的方案,即让已经声明好的form1变量做好自己的工作:
function askforint: integer; stdcall;
begin
    form1:=TForm1.Create(nil);
    form1.ShowModal();//注意这句,我们要的是模式对话框!!
    result:=number;
    form1.Destroy();//用Create(nil)创建的类得自己释放

end;

我们添加了FormCloseQuery和FormCreate事件处理函数,对askForInt函数的实现进行了修改,uaskfor单元的全部代码如下:
1 unit uaskfor;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8   classes, sysutils, fileutil, forms, controls, graphics, dialogs, StdCtrls, Buttons;
9
10 type
11
12   { tform1 }
13
14   tform1 = class(tform)
15     btnOK: tbutton;
16     txtNumber: TEdit;
17     label1: tlabel;
18     procedure btnokclick(sender: tobject);
19     procedure formclosequery(sender: tobject; var canclose: boolean);
20     procedure formcreate(sender: tobject);
21   private
22     { private declarations }
23     okToClose:boolean;
24   public
25     
26     { public declarations }
27   end;
28
29 function askForInt:integer;stdcall;export;
30
31 var
32   form1: tform1;
33   number:integer;
34
35 implementation
36
37 {$R *.lfm}
38
39 { tform1 }
40
41
42 procedure tform1.btnokclick(sender: tobject);
43 begin
44   try
45      number:=strtoint(txtNumber.Text);
46      okToClose:=true;
47      close;//关闭窗体并退出
48   Except on Exception do  begin
49      application.MessageBox('输入错误!','输入整数',0);
50      self.txtNumber.SetFocus;
51      
52      end;
53   end;
54
55
56 end;
57
58 procedure tform1.formclosequery(sender: tobject; var canclose: boolean);
59 begin
60   canclose:=okToClose;
61 end;
62
63 procedure tform1.formcreate(sender: tobject);
64 begin
65   
66   okToClose:=false;
67   txtNumber.Focused;
68 end;
69
70
71 function askforint: integer; stdcall;
72 begin
73     form1:=TForm1.Create(nil);
74     form1.ShowModal();//注意我们要的是模式对话框!
75     result:=number;
76     form1.Destroy();//用Create(nil)创建的类得自己释放
77
78 end;
79
80
81 end.

11.Shift+F9 build,生成askfor.dll.
二、客户测试程序的实现
1.创建一个普通的GUI工程,测试主窗体的各属性值如下:
1 object Form1: TForm1
2   Left = 530
3   Height = 127
4   Top = 350
5   Width = 355
6   BorderStyle = bsDialog
7   Caption = '测试窗口'
8   ClientHeight = 127
9   ClientWidth = 355
10   LCLVersion = '0.9.31'
11   object Edit1: TEdit
12     Left = 27
13     Height = 25
14     Top = 40
15     Width = 304
16     TabOrder = 0
17     Text = '2012'
18   end
19   object btnRetrieve: TButton
20     Left = 24
21     Height = 25
22     Top = 80
23     Width = 75
24     Caption = '(&R)获取'
25     Default = True
26     OnClick = btnRetrieveClick
27     TabOrder = 1
28   end
29   object btnClose: TButton
30     Left = 256
31     Height = 25
32     Top = 80
33     Width = 75
34     Cancel = True
35     Caption = '(&C)退出'
36     OnClick = btnCloseClick
37     TabOrder = 2
38   end
39   object Label1: TLabel
40     Left = 24
41     Height = 13
42     Top = 16
43     Width = 115
44     Caption = '从DLL获取一个整数:'
45     ParentColor = False
46   end
47 end

2.主窗体的代码单元unit1.pas 首先需要添加对dynlibs单元的引用,以使DLL调用的相关函数可用。
1 unit unit1;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8   classes, sysutils, fileutil, forms, controls, graphics, dialogs, StdCtrls,dynlibs;
9
10 type
11
12   { tform1 }
13
14   tform1 = class(tform)
15     btnRetrieve: tbutton;
16     btnClose: tbutton;
17     edit1: tedit;
18     label1: tlabel;
19     procedure btnRetrieveclick(sender: tobject);
20     procedure btnCloseclick(sender: tobject);
21   private
22     { private declarations }
23
24   public
25     { public declarations }
26   end;
27
28 var
29   form1: tform1;
30
31 implementation
32
33 {$R *.lfm}
34
35 { tform1 }

3.“(C)退出"按钮的事件代码---close;

procedure tform1.btnCloseclick(sender: tobject);
begin
  close;
end;

4."(R)获取"按钮的事件代码:
调用 askfor.dll里的askForInt函数的步骤:
1).声明TLibHandle类型的变量句柄lib;
2).调用LoadLibrary('askfor.dll'),返回的句柄存放在lib变量里;
3).声明函数类型TFunc=function():integer,stdcall;即返回值为integer,无参的函数类型;
4).声明TFunc类型的变量getInt:TFunc;
5).调用GetProcedureAddress(lib,'askForInt')返回函数askForInt地址,getInt指向该地址,注意pointer(getInt)转换,即:pointer(getInt):=GetProcedureAddress(lib,'askForInt');pointer(getInt)其实就是C下不透明指针的对等。
6).Assigned(getInt)测试getInt是否为空,如不为空就可以准备调用了。
7).声明integer类型变量num;
8).num:=getInt();
9).调用完毕后记得用 FreeLibrary(lib)释放资源;
以上即为调用 askfor.dll里askForInt()函数的全部步骤;接下来:
10). TEdit1文本框显示该num值 :
11).edit1.text:=inttostr(num);
代码:
1 procedure tform1.btnRetrieveclick(sender: tobject);
2 type
3   
4   TFunc=function():integer;stdcall;
5 var
6   lib:TlibHandle;
7   
8   getInt:TFunc;
9   num:integer;
10   
11   
12
13 begin
14   lib:=loadlibrary('askfor.dll');
15   try
16     pointer(getInt):=getProcedureAddress(lib,'askForInt');
17     if Assigned(getInt) then begin
18         num:=getInt();
19         self.edit1.Text:=inttostr(num);
20     end;
21   finally
22     freelibrary(lib);
23   end;
24
25 end;

主程序全部代码:

1 unit unit1;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8   classes, sysutils, fileutil, forms, controls, graphics, dialogs, StdCtrls,dynlibs;
9
10 type
11
12   { tform1 }
13
14   tform1 = class(tform)
15     btnRetrieve: tbutton;
16     btnClose: tbutton;
17     edit1: tedit;
18     label1: tlabel;
19     procedure btnRetrieveClick(sender: tobject);
20     procedure btnCloseClick(sender: tobject);
21   private
22     { private declarations }
23
24   public
25     { public declarations }
26   end;
27
28 var
29   form1: tform1;
30
31 implementation
32
33 {$R *.lfm}
34
35 { tform1 }
36
37 procedure tform1.btnCloseClick(sender: tobject);
38 begin
39   close;
40 end;
41
42 procedure tform1.btnRetrieveClick(sender: tobject);
43 type
44
45   TFunc=function():integer;stdcall;
46 var
47   lib:Tlibhandle;
48
49   getInt:TFunc;
50   num:integer;
51
52   form:TForm;
53
54 begin
55   lib:=loadlibrary('askfor.dll');
56   try
57     pointer(getInt):=getProcedureAddress(lib,'askForInt');
58     if Assigned(getInt) then begin
59        num:=getInt();
60           self.edit1.Text:=inttostr(num);
61     end;
62
63   finally
64     freelibrary(lib);
65   end;
66
67 end;
68
69 end.                 
        
F9 Run.试着输入几个字母,提示输入错误....一切正常。Congratulations!!

等等。打开输入整数的对话框后,试着给主程序窗口提供焦点,行??再试着给主程序窗口的TEdit控件里输入数字神马滴,也竟然行??DLL里不是模式对话框吗?我倒,我倒。


好在有官方论坛,好在有百度GOOGLE。
不管你是相信它是个bug:http://bugs.freepascal.org/view.php?id=7182,还是相信以下的解释:
在Delphi或是Lazarus的 GUI应用中,主窗体启用了一个TApplication实例,用户的DLL(由LCL GUI)构建也开启了一个TApplication实例,现在共有两个TApplication实例,所以虽然DLL的窗体设计为模式对话框,但主程序由另一个TApplication实例控制,所以使得模式对话框失效。
----我们都得解决它,不是吗?
三、如果再回到从前
回头看DLL的实现部分。如果DLL提供一个返回对话框窗口类TForm1 的函数,主程序从该函数入手,然后构造该输入对话框实例并显示之,在这个过程中进一步控制模式还是非模式窗口问题情况会如何?下面试试。
1.askfor.lpr的export部分添加另一个导出函数getClass:
library askfor;

{$mode objfpc}{$H+}

uses
  Classes, uaskfor ,interfaces,forms
  { you can add units after this };

{ $R *.res}

exports

  getClass,
  askForInt;

begin
   Application.Initialize;
end.

2.uaskfor.pas单元添加getClass的实现,并对原来的askForInt函数的实现做相应的修改,uaskfor.pas 全部代码如下:
1 unit uaskfor;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8   classes, sysutils, fileutil, forms, controls, graphics, dialogs, StdCtrls, MaskEdit, Buttons;
9
10 type
11
12   { tform1 }
13
14   tform1 = class(tform)
15     btnOK: tbutton;
16     txtNumber: TEdit;
17     label1: tlabel;
18     
19     procedure btnokclick(sender: tobject);
20     procedure formclosequery(sender: tobject; var canclose: boolean);
21     procedure formcreate(sender: tobject);
22   private
23     { private declarations }
24     okToClose:boolean;
25   public
26     //number:integer;
27     { public declarations }
28   end;
29 function getClass:TFormClass;stdcall;export;
30 function askForInt:integer;stdcall;export;
31
32 var
33   //form1: tform1;
34   number:integer;
35
36 implementation
37
38 {$R *.lfm}
39
40 { tform1 }
41
42
43
44
45
46
47 procedure tform1.btnokclick(sender: tobject);
48 begin
49   try
50      number:=strtoint(txtNumber.Text);
51      okToClose:=true;
52      close;
53   Except on Exception do  begin
54      application.MessageBox('输入错误!','输入整数',0);
55      self.txtNumber.SetFocus;
56      okToClose:=false;
57      end;
58   end;
59
60
61 end;
62
63 procedure tform1.formclosequery(sender: tobject; var canclose: boolean);
64 begin
65   canclose:=okToClose;
66 end;
67
68 procedure tform1.formcreate(sender: tobject);
69 begin
70   
71
72   okToClose:=false;
73   txtNumber.Focused;
74 end;
75
76 function getclass: tformclass; stdcall;
77 begin
78   result:=tform1;
79 end;
80
81 function askforint: integer; stdcall;
82 begin
83     result:=number;
84
85 end;
86
87
88
89 end.

第一是getClass 函数原型返回一个TFormClass类型,实际上实现部分是返回了TForm1.因TFormClass 是我们的TForm1的祖先类,所以向上转型是可以的。
第二是askForInt函数这次简单地返回了变量number.原因前面讲过了,打算在主程序里通过调用getClass后得到TFormClass,然后通过它来构造一个TForm1的实例。大概的思路如下:
var
   formClass:TFormClass;
   form:TForm;
begin
   formClass:=getClass();//
   form:=formClass.Create(nil);
   form.ShowModal();//现在输入窗口打开,焦点锁定,用户无论如何得输入合法整数,然后number变量被填充

  ...

end;

Shift+F9 build,再次生成askfor.dll.
四、再看主测试程序:
唯一改变的代码部分是"(R)获取"按钮单击事件:
1 procedure tform1.button1click(sender: tobject);
2 type
3   TClassFunc=function():TFormClass;stdcall;
4   TFunc=function():integer;stdcall;
5 var
6   lib:Tlibhandle;
7   getTheClass:TClassFunc;
8   getInt:TFunc;
9   num:integer;
10   formclass:TFormClass;
11   form:TForm;
12
13 begin
14   lib:=loadlibrary('askfor.dll');
15   try
16     pointer(getTheClass):=getProcedureAddress(lib,'getClass');
17     if Assigned(getTheClass) then begin
18         self.Enabled:=false;
19         try
20           formClass:=GetTheClass();
21           form:=GetTheClass.create(nil);
22           try
23             form.ShowModal;
24             pointer(getInt):=getProcedureAddress(lib,'askForInt');
25             if Assigned(getInt) then begin
26                 num:=getInt();
27                 self.edit1.Text:=inttostr(num);
28             end;
29           finally
30             form.Free;
31           end;
32         finally
33           self.Enabled:=true;
34         end;
35
36
37     end;
两点要说,一是self.Enabled:=false; 及self.Enabled:=true的插入点及其作用,这个想一想自然明白;二是通过调用getProcedureAddress(lib,'getClass')获取DLL getClass:TFormClass 函数入口地址,然后通过调用它来得到TForm(实际上是TForm1)类,最后通过TForm1.Create(nil)来创建窗口实例,这个过程也是明了自然。
F9 Run,测试,测试。O啦~
Thank you ^_^

评分

参与人数 2威望 +14 收起 理由
逍遥派掌门人 + 3 欢迎这样的好文章!
猫工 + 11 Lazarus社区有你更精彩!

查看全部评分

回复

使用道具 举报

该用户从未签到

发表于 2012-3-19 09:42:49 | 显示全部楼层
这文章体现了水平。
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2012-3-14 13:56:56 | 显示全部楼层
不错,写得比较详细。
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2012-3-14 16:30:39 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2012-3-13 17:45:37 | 显示全部楼层
优秀文章,支持!n神马都是浮云
回复 支持 反对

使用道具 举报

*滑块验证:

本版积分规则

QQ|手机版|小黑屋|Lazarus中国|Lazarus中文社区 ( 鄂ICP备16006501号-1 )

GMT+8, 2024-4-20 15:28 , Processed in 0.037795 second(s), 10 queries , Redis On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表