RTFormwork/项目代码/RTBasicsV1/A08索赔管理/U_testdll.pas
2024-09-04 14:56:19 +08:00

95 lines
2.3 KiB
ObjectPascal

unit U_testdll;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Menus, ToolWin, ComCtrls, ImgList, DB, ADODB,
System.ImageList;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
test1: TMenuItem;
ToolBar1: TToolBar;
Edit1: TEdit;
ToolButton1: TToolButton;
ImageList1: TImageList;
ADOConnection1: TADOConnection;
DllName: TEdit;
Label1: TLabel;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure test1Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
newh: hwnd;
implementation
{$R *.dfm}
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
sendmessage(newh, 1034, 4, 0);
Action := cafree;
end;
procedure TForm1.test1Click(Sender: TObject);
type
TMyFunc = function(App: Tapplication; FormH: hwnd; FormID: integer; Language: integer; WinStyle: integer; GCode: Pchar; GName: Pchar; DataBase: Pchar; Title: PChar; Parameters1: PChar; Parameters2: PChar; Parameters3: PChar; Parameters4: PChar; Parameters5: PChar; Parameters6: PChar; Parameters7: PChar; Parameters8: PChar; Parameters9: PChar; Parameters10: PChar; DataBaseStr: PChar): hwnd; stdcall;
var
Tf: TMyFunc;
Tp: TFarProc;
Th: Thandle;
begin
//静态加载
//newh:=getForm(Application,1,ADOConnection1,PChar('sa'),PChar('dsa'));
//动态加载
// showMessage(intTostr(application.Handle));
Th := LoadLibrary('Claim.dll');
if Th > 0 then
begin
try
Tp := GetProcAddress(Th, 'GetDllForm');
if Tp <> nil then
begin
Tf := TMyFunc(Tp);
newh := Tf(Application, 0, strToint(edit1.text), 0, 0, PChar('ygcode'), PChar('ygname'), PChar('datebase'), PChar('title'), PChar(''), PChar(''), '', '', '', '', '', '', '', '', '');
end
else
begin
ShowMessage('打印执行错误');
end;
finally
// FreeLibrary();
end;
end
else
begin
ShowMessage('找不到' + Trim(DllName.Text));
end;
end;
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
close;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
sendmessage(newh, 1034, 1, 0);
end;
end.