我用delphi XE尝试开发一个企业信息集成系统。因为公司应用软件系统很多,使用数据库比较杂。根据领导要求,开发一套信息集成系统。
我的总体方案:将不同模块做成dll文件,主程序调用dll中的窗体,显示在主窗口的一个TRzPageControl的TRzTabSheet中。
如果程序代码没错误,一般凑合着能用。但如果代码有地址错误,比如对象不存在,却在访问。可能会出现题目中的错误。这个如果仔细点,反复调试,应该可以避免。
但是,有的错误真是莫名妙。
如下图,是正常的主窗口,选项卡中加载了DLL窗体。我点击了TreeView或DBGrid控件部分,再打开其它窗体,以后就出现如下错误,如图:
以下是主程序DLL调用代码:unit main;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, RzPanel, RzGroupBar, RzSplit, ExtCtrls, ActnList, ImgList, RzTabs,
StdCtrls, RzLabel, pngimage, Buttons, RzSpnEdt, jpeg, ADODB, RZCommon,
AppEvnts, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
RzStatus, MemTableDataEh, Db, MemTableEh, ComCtrls, RzTreeVw,
DBGridEhGrouping, GridsEh, DBGridEh;type
// DLL窗体调用接口函数
InvokeDLLForm = function(App: TApplication; Caption: String; FormID: Integer;
AParent: THandle): THandle; TMainForm = class(TForm)
sbr1: TRzStatusBar;
spn1: TRzSizePanel;
ilAction: TImageList;
.....
private
{ Private declarations }
lstDH, lstDN: TStringList; // Dll句柄列表
FCurrentVS: TRzVisualStyle;
FCurrentGCS: TRzGradientColorStyle;
procedure ClearTempTable;
// 接口
// procedure RunUserLogin(Sender: TObject); //用户登录
procedure OpenDllForm(DllName, FormName, ACaption: string; AFormID: Integer;
AParent: TRzTabSheet);
procedure FreeDLL(handle: THandle);
procedure RunDLL(Sender: TObject); // 调用DLL
Procedure RunExe(Sender: TObject); // 调用外部Exe等文件
procedure TopicHelp(Sender: TObject); // 主题帮助
// ----------
procedure ShowPopupMsg(title: string; url: string); // 弹出消息提醒框
procedure UpdateVisualStyle(tag: Integer);
function FindTabSheet(ACaption: string): Integer; // 声明响应WM_HOTKEY消息的方法
// procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
// function GetSysFocus: Integer;
//
procedure OnTabResize(Sender: TObject);
procedure OnTabEnter(Sender: TObject);
procedure ClearAction;
procedure LoadAction;
public
{ Public declarations }
iSessionID, iUserID, iEmpId: Integer;
cEmpName, cUserName: string;
procedure OpenTabForm(frm: TForm; ACaption: string;
ImageIndex: Integer = -1);
procedure ShowMainMenu;
// 热键
// procedure WMACTIVATEAPP(var Msg: TMessage); message WM_ACTIVATEAPP;
end;var
MainForm: TMainForm;implementationuses .........procedure TMainForm.OpenDllForm(DllName, FormName, ACaption: string;
AFormID: Integer; AParent: TRzTabSheet);
var
DLLHandle: THandle;
DLLSub: InvokeDLLForm;
FormHandle: THandle;
i: Integer;
begin
{ 调用DLL }
try
// 检查DLL文件是否存在
if not FileExists(DllName) then
begin
Application.MessageBox(PChar('抱歉,文件[' + DllName + ']找不到或不存在!'),
PChar(Text), MB_OK + MB_ICONWARNING);
Exit;
end;
// 加载DLL
i := lstDN.IndexOf(DllName); // 检查该DLL文件是否已加载
if i = -1 then // 没有发现
begin
// 原来没有加载过的
DLLHandle := LoadLibrary(PWideChar(DllName));
lstDN.Add(DllName); // 记录DLLName
lstDH.Add(IntToStr(DLLHandle)); // 记录DLL句柄
end
else
begin
DLLHandle := StrToInt(lstDH.Strings[i]); // 不重新加载DLL
end;
//
if DLLHandle <> 0 then
begin
try
@DLLSub := GetProcAddress(DLLHandle, PChar('Create_' + FormName)); if Assigned(DLLSub) then
begin
FormHandle := DLLSub(Application, ACaption, AFormID, AParent.Handle);
AParent.tag := FormHandle;
AParent.OnResize := OnTabResize;
AParent.OnEnter := OnTabEnter;
with TForm(GetInstanceFromhWnd(FormHandle)) do
begin
Width := AParent.ClientWidth;
Height := AParent.ClientHeight;
//Show;
end;
end
else
begin
Application.MessageBox
(PChar('模块接口不正确!' + #13#10 + ' 1.可能配置不正确,请检查窗体名是否正确。' + #13#10 +
' 2.功能可能被关闭!'), PChar(Caption), MB_OK + MB_ICONWARNING);
end;
except
pg1.CloseActiveTab;
Application.MessageBox('打开DLL窗口失败!', PChar(Text), MB_OK + MB_ICONERROR);
end;
//此处本想使用FreeLibray的,但窗体生成后,就不能释放了。
end
else
Application.MessageBox('模块可能没有安装!或者路径错误!', PChar(Caption),
MB_OK + MB_ICONWARNING);
finally
end;
end;....procedure TMainForm.RunDLL(Sender: TObject);
var
DLLHandle: THandle;
DLLSub: InvokeDLLForm;
DllName: PChar;
FormName, FormCaption: String;
FormID: Integer;
i: Integer;
lst: TStringList;
act: TAction;
tab: TRzTabSheet;
// frm: TForm;
begin
{ 打开窗口 }
frmRunWait := TfrmRunWait.Create(self);
frmRunWait.Show;
frmRunWait.Update;
//
act := (Sender as TAction);
lst := TStringList.Create;
SplitStr(act.HelpKeyword, '|', lst); // DLLName|FormName
FormCaption := act.Hint; // Caption
FormID := act.tag; // FormID
DllName := PChar(StringReplace(lst[0], '{$AppPath}', AppPath,
[rfIgnoreCase]));
FormName := lst.Strings[1];
i := FindTabSheet(FormCaption);
if i = -1 then
begin
tab := TRzTabSheet.Create(pg1);
with tab do
begin
Caption := act.Hint;
ImageIndex := act.ImageIndex;
PageControl := pg1;
Show;
end;
//调用dll窗体
OpenDllForm(DllName, FormName, FormCaption, FormID, tab);
end
else
begin
pg1.Pages[i].Show;
end;
//
frmRunWait.Close;
end;以下是DLL代码:library TimeAtt2;uses
SysUtils,
Forms,
Windows,
Messages,
Classes,
ADODB,
MyLib,
AttRecord in 'TimeAtt2\AttRecord.pas' {frmAttRecord},
pager in 'pager.pas' {fmPager: TFrame},
Comm in 'Comm.pas',
Att_DayRep in 'TimeAtt2\Att_DayRep.pas' {frmAtt_DayRep};{$R *.res}var
DLLApp: TApplication; // 退出DLL
procedure ExitDLL(Reason: Integer);
begin
if Reason = DLL_PROCESS_DETACH then
begin
Application := DLLApp;
end;
end;{ 调用功能分配模块 }
function Create_frmAttRecord(App: TApplication; ACaption: string;
AFormID: Integer; AParent: THandle): THandle; //export;
begin
Application := App;
frmAttRecord := TfrmAttRecord.Create(App); with frmAttRecord do
begin
ParentWindow := AParent;
Caption := ACaption;
FormID := AFormID;
BorderStyle := bsNone;
Show;
end;
Result := frmAttRecord.Handle;
end;function Create_frmAtt_DayRep(App: TApplication; ACaption: string;
AFormID: Integer; AParent: THandle): THandle; //export;
begin
Application := App;
frmAtt_DayRep := TfrmAtt_DayRep.Create(App); with frmAtt_DayRep do
begin
ParentWindow := AParent;
Caption := ACaption;
FormID := AFormID;
BorderStyle := bsNone;
Show;
end;
Result := frmAtt_DayRep.Handle;
end;// 接口定义
exports
// 接口函数名
Create_frmAttRecord,
Create_frmAtt_DayRep;begin
DLLApp := Application;
DLLProc := @ExitDLL;end.我虽从业多年,用了10多年的Delphi,但使用dll只能算是菜鸟级的。以上代码是七拼八凑出来的。
高手,请帮我看看代码,指点迷津!谢谢!
我的总体方案:将不同模块做成dll文件,主程序调用dll中的窗体,显示在主窗口的一个TRzPageControl的TRzTabSheet中。
如果程序代码没错误,一般凑合着能用。但如果代码有地址错误,比如对象不存在,却在访问。可能会出现题目中的错误。这个如果仔细点,反复调试,应该可以避免。
但是,有的错误真是莫名妙。
如下图,是正常的主窗口,选项卡中加载了DLL窗体。我点击了TreeView或DBGrid控件部分,再打开其它窗体,以后就出现如下错误,如图:
以下是主程序DLL调用代码:unit main;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, RzPanel, RzGroupBar, RzSplit, ExtCtrls, ActnList, ImgList, RzTabs,
StdCtrls, RzLabel, pngimage, Buttons, RzSpnEdt, jpeg, ADODB, RZCommon,
AppEvnts, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
RzStatus, MemTableDataEh, Db, MemTableEh, ComCtrls, RzTreeVw,
DBGridEhGrouping, GridsEh, DBGridEh;type
// DLL窗体调用接口函数
InvokeDLLForm = function(App: TApplication; Caption: String; FormID: Integer;
AParent: THandle): THandle; TMainForm = class(TForm)
sbr1: TRzStatusBar;
spn1: TRzSizePanel;
ilAction: TImageList;
.....
private
{ Private declarations }
lstDH, lstDN: TStringList; // Dll句柄列表
FCurrentVS: TRzVisualStyle;
FCurrentGCS: TRzGradientColorStyle;
procedure ClearTempTable;
// 接口
// procedure RunUserLogin(Sender: TObject); //用户登录
procedure OpenDllForm(DllName, FormName, ACaption: string; AFormID: Integer;
AParent: TRzTabSheet);
procedure FreeDLL(handle: THandle);
procedure RunDLL(Sender: TObject); // 调用DLL
Procedure RunExe(Sender: TObject); // 调用外部Exe等文件
procedure TopicHelp(Sender: TObject); // 主题帮助
// ----------
procedure ShowPopupMsg(title: string; url: string); // 弹出消息提醒框
procedure UpdateVisualStyle(tag: Integer);
function FindTabSheet(ACaption: string): Integer; // 声明响应WM_HOTKEY消息的方法
// procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
// function GetSysFocus: Integer;
//
procedure OnTabResize(Sender: TObject);
procedure OnTabEnter(Sender: TObject);
procedure ClearAction;
procedure LoadAction;
public
{ Public declarations }
iSessionID, iUserID, iEmpId: Integer;
cEmpName, cUserName: string;
procedure OpenTabForm(frm: TForm; ACaption: string;
ImageIndex: Integer = -1);
procedure ShowMainMenu;
// 热键
// procedure WMACTIVATEAPP(var Msg: TMessage); message WM_ACTIVATEAPP;
end;var
MainForm: TMainForm;implementationuses .........procedure TMainForm.OpenDllForm(DllName, FormName, ACaption: string;
AFormID: Integer; AParent: TRzTabSheet);
var
DLLHandle: THandle;
DLLSub: InvokeDLLForm;
FormHandle: THandle;
i: Integer;
begin
{ 调用DLL }
try
// 检查DLL文件是否存在
if not FileExists(DllName) then
begin
Application.MessageBox(PChar('抱歉,文件[' + DllName + ']找不到或不存在!'),
PChar(Text), MB_OK + MB_ICONWARNING);
Exit;
end;
// 加载DLL
i := lstDN.IndexOf(DllName); // 检查该DLL文件是否已加载
if i = -1 then // 没有发现
begin
// 原来没有加载过的
DLLHandle := LoadLibrary(PWideChar(DllName));
lstDN.Add(DllName); // 记录DLLName
lstDH.Add(IntToStr(DLLHandle)); // 记录DLL句柄
end
else
begin
DLLHandle := StrToInt(lstDH.Strings[i]); // 不重新加载DLL
end;
//
if DLLHandle <> 0 then
begin
try
@DLLSub := GetProcAddress(DLLHandle, PChar('Create_' + FormName)); if Assigned(DLLSub) then
begin
FormHandle := DLLSub(Application, ACaption, AFormID, AParent.Handle);
AParent.tag := FormHandle;
AParent.OnResize := OnTabResize;
AParent.OnEnter := OnTabEnter;
with TForm(GetInstanceFromhWnd(FormHandle)) do
begin
Width := AParent.ClientWidth;
Height := AParent.ClientHeight;
//Show;
end;
end
else
begin
Application.MessageBox
(PChar('模块接口不正确!' + #13#10 + ' 1.可能配置不正确,请检查窗体名是否正确。' + #13#10 +
' 2.功能可能被关闭!'), PChar(Caption), MB_OK + MB_ICONWARNING);
end;
except
pg1.CloseActiveTab;
Application.MessageBox('打开DLL窗口失败!', PChar(Text), MB_OK + MB_ICONERROR);
end;
//此处本想使用FreeLibray的,但窗体生成后,就不能释放了。
end
else
Application.MessageBox('模块可能没有安装!或者路径错误!', PChar(Caption),
MB_OK + MB_ICONWARNING);
finally
end;
end;....procedure TMainForm.RunDLL(Sender: TObject);
var
DLLHandle: THandle;
DLLSub: InvokeDLLForm;
DllName: PChar;
FormName, FormCaption: String;
FormID: Integer;
i: Integer;
lst: TStringList;
act: TAction;
tab: TRzTabSheet;
// frm: TForm;
begin
{ 打开窗口 }
frmRunWait := TfrmRunWait.Create(self);
frmRunWait.Show;
frmRunWait.Update;
//
act := (Sender as TAction);
lst := TStringList.Create;
SplitStr(act.HelpKeyword, '|', lst); // DLLName|FormName
FormCaption := act.Hint; // Caption
FormID := act.tag; // FormID
DllName := PChar(StringReplace(lst[0], '{$AppPath}', AppPath,
[rfIgnoreCase]));
FormName := lst.Strings[1];
i := FindTabSheet(FormCaption);
if i = -1 then
begin
tab := TRzTabSheet.Create(pg1);
with tab do
begin
Caption := act.Hint;
ImageIndex := act.ImageIndex;
PageControl := pg1;
Show;
end;
//调用dll窗体
OpenDllForm(DllName, FormName, FormCaption, FormID, tab);
end
else
begin
pg1.Pages[i].Show;
end;
//
frmRunWait.Close;
end;以下是DLL代码:library TimeAtt2;uses
SysUtils,
Forms,
Windows,
Messages,
Classes,
ADODB,
MyLib,
AttRecord in 'TimeAtt2\AttRecord.pas' {frmAttRecord},
pager in 'pager.pas' {fmPager: TFrame},
Comm in 'Comm.pas',
Att_DayRep in 'TimeAtt2\Att_DayRep.pas' {frmAtt_DayRep};{$R *.res}var
DLLApp: TApplication; // 退出DLL
procedure ExitDLL(Reason: Integer);
begin
if Reason = DLL_PROCESS_DETACH then
begin
Application := DLLApp;
end;
end;{ 调用功能分配模块 }
function Create_frmAttRecord(App: TApplication; ACaption: string;
AFormID: Integer; AParent: THandle): THandle; //export;
begin
Application := App;
frmAttRecord := TfrmAttRecord.Create(App); with frmAttRecord do
begin
ParentWindow := AParent;
Caption := ACaption;
FormID := AFormID;
BorderStyle := bsNone;
Show;
end;
Result := frmAttRecord.Handle;
end;function Create_frmAtt_DayRep(App: TApplication; ACaption: string;
AFormID: Integer; AParent: THandle): THandle; //export;
begin
Application := App;
frmAtt_DayRep := TfrmAtt_DayRep.Create(App); with frmAtt_DayRep do
begin
ParentWindow := AParent;
Caption := ACaption;
FormID := AFormID;
BorderStyle := bsNone;
Show;
end;
Result := frmAtt_DayRep.Handle;
end;// 接口定义
exports
// 接口函数名
Create_frmAttRecord,
Create_frmAtt_DayRep;begin
DLLApp := Application;
DLLProc := @ExitDLL;end.我虽从业多年,用了10多年的Delphi,但使用dll只能算是菜鸟级的。以上代码是七拼八凑出来的。
高手,请帮我看看代码,指点迷津!谢谢!
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货