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('MarketValue.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.