Карта сайтаСсылкиКонтакты

Несколько DLL с формами, которые загружаются динамически в PageControl главной формы

PDF Печать
Статьи

Как поместить формы из DLL на отдельную вкладку в управление PageControl с TTabSheet на главной форме прилоежения?

Есть много примеров как поместить форму из DLL, но нет описания, как загрузить DLL с формами в главную форму с PageControl. Каждая DLL открывает свой собственный TTabSheet!

Посмотрим как это работает:

DLL


unit uDLL;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls; 
type
  TDLLForm = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    ComboBox1: TComboBox;
    ListBox1: TListBox;
  private
    { Private }
  public
    { Public }
  end;
  function Initialisation: HWND; stdcall; forward;
  function CloseDLL: Boolean; stdcall; forward;
var
  DLLForm: TDLLForm;
implementation
{$R *.DFM}
function Initialisation: HWND;
begin
  DLLForm:= TDLLForm.Create(nil);
  DLLForm.Caption:= 'TestDLL';
  result:= DLLForm.Handle;
end;

function CloseDLL: Boolean;
begin
  DLLForm.Release;
  result:= true;
end;
end.

EXE файл


unit uMain;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  ComCtrls, StdCtrls, ExtCtrls;
type
  TInitialisation = function: HWND;
  TCloseDLL = function: Boolean;
  TTab = class(TTabSheet)
  private
    CloseDLL: TCloseDLL;
    LibDLL: THandle;
    WinHandle: HWND;
  end;
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    Panel1: TPanel;
    BtnSearchDLL: TButton;
    BtnClose: TButton;
    procedure BtnSearchDLLClick(Sender: TObject);
    procedure BtnCloseClick(Sender: TObject);
  private
    procedure adviceDLL(Name:String);
  end;
var
  Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.adviceDLL(Name:String);
var
  hndDLLHandle: THandle;
  Initialisation: TInitialisation;
  CloseDLL: TCloseDLL;
  Tab: TTab;
  WinHndl: HWND;
  WinName: Array [0..255] of char;
begin
  try
    // загрузка dll в динамическом режиме
    hndDLLHandle := loadLibrary(PChar(Name));
    if hndDLLHandle <> 0 then begin
      // получаем адрес функции
      @Initialisation:= getProcAddress(hndDLLHandle, 'Initialisation');
      @CloseDLL:= getProcAddress(hndDLLHandle, 'CloseDLL');
      // если адрес функции найден
      if (addr(Initialisation) <> nil) AND (addr(CloseDLL) <> nil) then begin
        Tab:= TTab.Create(nil);
        Tab.PageControl:= PageControl1;
        WinHndl:= Initialisation;
        Windows.SetParent(WinHndl, Tab.handle);
        windows.ShowWindow(WinHndl, SW_SHOWMAXIMIZED);
        GetWindowText(WinHndl, WinName, 255);
        Tab.Caption:= WinName;
        Tab.CloseDLL:= CloseDLL;
        Tab.LibDLL:= hndDLLHandle;
        Tab.WinHandle:= WinHndl;
      end;
    end;
  except
    on E: Exception do ShowMessage(E.Message);
  end;
end;

procedure TForm1.BtnSearchDLLClick(Sender: TObject);
var
  sr: TSearchRec;
begin
  if FindFirst('Test*.DLL', faAnyFile, sr) = 0 then begin
    adviceDLL(sr.Name);
    while FindNext(sr) = 0 do adviceDLL(sr.Name);
    FindClose(sr);
  end;
end;

procedure TForm1.BtnCloseClick(Sender: TObject);
var
  Tab: TTab;
  CloseDLL: TCloseDLL;
begin
  while PageControl1.PageCount <> 0 do begin
    Tab:= TTab(PageControl1.Pages[0]);
    CloseDLL:= Tab.CloseDLL;
    Tab.PageControl:= nil;
    Tab.Free;
    CloseDLL;
  end;
end;
end.

Пример можно взять здесь.

По материалам сайта www.delphi3000.com


 

Добавить комментарий


Защитный код
Обновить