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.