RTFormwork/项目代码/RTBasicsV1/A01基础公司管理/U_testdll.pas
“ddf” 61630656e9 1
2024-07-07 09:35:27 +08:00

108 lines
2.4 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('Company.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.