|
|
|
同步发布在博客园：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 ^_^ |
评分
-
查看全部评分
|
|手机版|小黑屋|Lazarus中国|Lazarus中文社区
( 鄂ICP备16006501号-1 )
发表于 2012-3-13 16:19:43
发表于 2012-3-14 13:56:56
发表于 2012-3-13 17:45:37