unit1.pas

Delphi DLL Form 与 TDxDockSite

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    dll11: TMenuItem;
    dll21: TMenuItem;
    dll22: TMenuItem;
    procedure dll21Click(Sender: TObject);
    procedure dll22Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TCreateFormPVFN = function(ACaption:PChar):TForm;stdcall;

  TInitDllPVFN = Procedure(App:TApplication;Scr:TScreen); stdcall;

  Function MyLoadLibrary(LoadLibraryName: PChar): THandle; stdcall;

  Function CreateForm(PCaption,dll: string): TForm;stdcall;


var
  Form1: TForm1;

implementation

uses
  StrUtils;

{$R *.dfm}

Function CreateForm(PCaption,dll: string): TForm;
var
  CreateFormPVFN: TCreateFormPVFN;
  DllPoint: THandle;
  sqlTxt,formid:string;
begin
  Result := nil;
  formid := RightStr(PCaption,Length(PCaption)-1);
  if dll ='' then exit;

  DllPoint := MyLoadLibrary(Pchar(dll));
  CreateFormPVFN := GetProcAddress(DllPoint, 'CreateForm');
  if Assigned(CreateFormPVFN) then
    Result := CreateFormPVFN(Pchar(PCaption));
end;

Function MyLoadLibrary(LoadLibraryName: Pchar): THandle; 
var
  InitDllPVFN: TInitDllPVFN;
  p: ^WORD;
  ErrorCode:integer;
  tmp,tmp2: String;
begin
  tmp := String(LoadLibraryName);
  tmp := uppercase(StringReplace(tmp, '.dll', '', [rfIgnoreCase]));

  tmp2:= ExtractFilePath(Application.ExeName) + tmp + '.dll';
  if not FileExists(tmp2) then
  begin
    MessageBox(Application.MainForm.Handle, PChar('未找到' + tmp +'.dll'  + ',请确认本地有此文件!'), PChar(Application.Title), MB_ICONERROR or MB_OK or MB_APPLMODAL or MB_DEFBUTTON1);
    exit;
  end;
  
  Result := GetModuleHandle(Pchar(tmp));
  if Result <> 0 then exit;

  p := GetControlAtom;
  Result := LoadLibrary(Pchar(tmp));
  if Result = 0 then
  begin
    ErrorCode := GetLastError;
    MessageBox(Application.MainForm.Handle, PChar( '加载' + tmp + '.dll' + '失败,' + '错误代码:' + IntToStr(ErrorCode) + '。请联系技术人员'), PChar(Application.Title), MB_ICONERROR or MB_OK or MB_APPLMODAL or MB_DEFBUTTON1);
    exit;
  end;

  InitDllPVFN := GetProcAddress(Result, 'InitDll');
  if Assigned(InitDllPVFN) then
    InitDllPVFN(Application, Screen);

end;

procedure TForm1.dll21Click(Sender: TObject);
begin
  createform('TForm2','Project2.dll');
end;

procedure TForm1.dll22Click(Sender: TObject);
begin
  createform('TForm3','Project3.dll');
end;

end.