Никогда такого не было и вот опять ! ( Форма в DLL)

[Alex2013]

Решил для теста затолкать CEF4 браузер в DLL.
В принципе все работает но появляется копия базовой формы .
Возможно потому что в DLL используется еще один экземпляр TApplication
Но как это может влиять на основное приложение непонятно совершенно!
Обычно windows.SetParent работает с чем угодно без особых хлопот .



Код "вызывателя"
LPR

Код: Выделить всё

program callerGUI_01;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms, c_gui_mf_02
  { you can add units after this };

{$R *.res}
procedure IntBrowser;external 'BuildInBrowser' name 'IntBrowser';
procedure CEFAppFree;external 'BuildInBrowser' name 'CEFAppFree';
Function GetBrApp:TApplication; external 'BuildInBrowser'  name  'GetBrApp';
begin
IntBrowser;
  RequireDerivedFormResource:=True;
  Application.Scaled:=True;
  Application.Initialize;

  Application.CreateForm(TForm1, Form1);

  Application.Run;
if  GetBrApp = Nil then exit;
  GetBrApp.Terminate;
  CEFAppFree;
end.
                                   


Форма

Код: Выделить всё

unit c_gui_mf_02;

{$mode objfpc}{$H+}

interface

uses
  Windows,  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;
BrApp:TApplication=Nil;
BR_MainForm:TForm=Nil;

implementation

{$R *.lfm}

{ TForm1 }
procedure IntBrowser;external 'BuildInBrowser' name 'IntBrowser';
procedure CEFAppFree;external 'BuildInBrowser' name 'CEFAppFree';
Function GetBrApp:TApplication; external 'BuildInBrowser'  name  'GetBrApp';
Function GetBR_MainForm:TForm; external 'BuildInBrowser' name 'GetBR_MainForm';


procedure TForm1.Button1Click(Sender: TObject);
  begin
    BrApp:=GetBrApp;

  if BrApp <> Nil then
    begin
      if  BR_MainForm=Nil then begin

      BR_MainForm:=GetBR_MainForm;
       windows.SetParent( BR_MainForm.Handle,Panel1.Handle  );
      end ;
     BR_MainForm.Visible:= not BR_MainForm.Visible;
     BR_MainForm.WindowState:=wsMaximized;

    end;

end;

procedure TForm1.FormResize(Sender: TObject);
begin
if BR_MainForm = nil then exit;
BR_MainForm.WindowState:=wsNormal;
BR_MainForm.WindowState:=wsMaximized;

end;

end.


Причем "левая копия" базовой формы появляется только после загрузки станицы .

LPR DLL

Код: Выделить всё

library BuildInBrowser;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms, u1_browsermode,
  { you can add units after this }
  uCEFApplication;
{$IFDEF MSWINDOWS}
  // CEF3 needs to set the LARGEADDRESSAWARE flag which allows 32-bit processes to use up to 3GB of RAM.
  {$SetPEFlags $20}
{$ENDIF}

procedure IntBrowser;
begin
If GlobalCEFApp <> Nil then exit;
GlobalCEFApp := TCefApplication.Create;

if GlobalCEFApp.StartMainProcess then
  begin
    RequireDerivedFormResource:=True;
    Application.Initialize;
    Application.CreateForm(TBR_MainForm, BR_MainForm);
  // Application.Run;//! Run не вызывается специально
  end;
end;
procedure CEFAppFree;
begin
GlobalCEFApp.Free;
GlobalCEFApp := nil;
end;
Function GetBrApp:TApplication;
begin
GetBrApp:=Application;
end;
Function GetBR_MainForm:TBR_MainForm;
begin
GetBR_MainForm:=BR_MainForm;
end;

exports IntBrowser name 'IntBrowser';

exports CEFAppFree name 'CEFAppFree';
exports GetBrApp name  'GetBrApp';
exports GetBR_MainForm name 'GetBR_MainForm';
begin
end.


[Sharfik]

Запускается программа, потом идет
IntBrowser; //initdll
потом создается форма основного приложения
Application.CreateForm(TForm1, Form1);
Потом по нажатию Button1Click выполняется
BR_MainForm:=GetBR_MainForm; - т.е. еще какую то форму тащим

Только я сомневаюсь в работоспособности
windows.SetParent( BR_MainForm.Handle,Panel1.Handle );
DLL и APP это же разные процессы, оно так прикрепляется?

[Alex2013]

"Eще какая-то форма" это та же самая форма в ДЛЛ

Код: Выделить всё

library BuildInBrowser;
...
    Application.CreateForm(TBR_MainForm, BR_MainForm);
...
Function GetBR_MainForm:TBR_MainForm;
begin
GetBR_MainForm:=BR_MainForm;
end;
...
exports GetBR_MainForm name 'GetBR_MainForm';
end.


А windows.SetParent работает даже с консолью (Это WinAPI процедура и ее без разницы, что за окно "удочерить". То есть там нет никакой привязки к текущему процессу )

Код: Выделить всё

{$mode delphi}  {$H+}
uses
   Windows,ShellAPI....   

Const  h:hwnd =0;
       SearchHandle:hwnd =0;

function EnumProc(h:HWND; lParam:DWord):boolean; stdcall;
var
ProcessId, z:cardinal;
begin
Result:=True;
GetWindowThreadProcessId(h, ProcessId);
If ProcessId=lParam then
begin
SearchHandle:=h;
Result:=False;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
ExecInfo: TShellExecuteInfoA;
var
si:STARTUPINFO;
pi:PROCESS_INFORMATION;
buf:array[1..100] of char;

S:String;
P:Pointer;
begin
  ZeroMemory(@si, sizeof(si));
  si.cb:=SizeOf(si);
  P:=@EnumProc;
{  CreateProcess(nil, 'c:windowssystem32cmd.exe', nil, nil, false,
  0, nil, nil, si, pi); }
  CreateProcess(nil, 'C:Program FilesFar Managerfar.exe', nil, nil, false, 0, nil, nil, @si,@pi);
  SearchHandle:=0;
  sleep(150);
  While SearchHandle=0 do
  begin
  Windows.EnumWindows(@EnumProc,Lparam( pi.dwProcessId) );
  Application.ProcessMessages;
  end;
  H:=SearchHandle;
  if h<>0 then  begin
   windows.SetParent(h,form1.Handle);
   MoveWindow(h,0,0,Width,Height,true);
end;
end;


Проблема там одна добыть актуальный Handle окна.
(Так что киваю на CEF4 бо у него есть свой Application (GlobalCEFApp := TCefApplication.Create) и он может заблудится и попытаться "перезагрузить не то окно" )

Добавлено спустя 4 часа 47 минут 55 секунд:
Добавил вот такую "ловушку для крокодилов" .

Код: Выделить всё

procedure TForm1.FormShow(Sender: TObject);
var BR:TForm;
begin
  try
  BR:=GetBR_MainForm;
  IF BR.Visible THEN Form1.Hide;
  except
   Form1.close;
  end;
end;


С ней работает . Но поскольку я совершенно не понял почему происходит повторная инициализация базовой формы то это "классический костыль ".

Кстати windows.SetParent( BR_MainForm.Handle,Panel1.Handle ); совершенно не причем лишение окно выползает и при таком варианте.

Код: Выделить всё

procedure TForm1.Button1Click(Sender: TObject);
  begin
   Application.ProcessMessages;
    BR_MainForm:=GetBR_MainForm;
    BR_MainForm.Visible:= not BR_MainForm.Visible;
    BR_MainForm.Refresh;
   end;


А с windows.SetParent при наличии ловушки можно написать так:

Код: Выделить всё

procedure TForm1.Button2Click(Sender: TObject);
begin
BR_MainForm:=GetBR_MainForm;
IF (BR_MainForm.Handle<>Panel1.Handle) THEN begin
windows.SetParent( BR_MainForm.Handle,Panel1.Handle  );
SetWindowLong (BR_MainForm.Handle, GWL_STYLE,
    GetWindowLong(BR_MainForm.Handle, GWL_STYLE) and not WS_CAPTION);
end;
BR_MainForm.Visible:= not BR_MainForm.Visible;
    BR_MainForm.WindowState:=wsMaximized;
    BR_MainForm.Refresh;
end;


Добавлено спустя 4 часа 3 минуты 2 секунды:

Зы
Похоже что окно просто пытается перезагружаться даже если не нажимаешь ничего .
Так что проблемы в BuildInBrowser.dll и хроме

[Sharfik]

А если загружать DLL, а не связывать жестко?

Код: Выделить всё

function TFLauncher.LoadPlugin(Filename: String): Boolean;
var
  PluginPath   :PChar;
  newPlugin    :TPluginItem;
  PluginCorrect:Boolean;
  DLLHandle    :THandle;
  sResult      :WideString;
  i            :Integer;
begin
  try
    PluginCorrect:=true;
    Result:=false;
    // загружаем dll динамически
    PluginPath:=pchar(UTF8ToSys(Filename));
    DLLHandle := loadLibrary (PluginPath);
    if DLLHandle > 32 then
    begin
      newPlugin :=TPluginItem.Create;
      newPlugin.LibHandle:=DLLHandle;

      newPlugin.faDeinit             :=GetProcAddress( DLLHandle, 'PluginDeinit');
      newPlugin.faInit               :=GetProcAddress( DLLHandle, 'PluginInit');

      if newPlugin.faDeinit      =nil then PluginCorrect:=false;
      if newPlugin.faInit        =nil then PluginCorrect:=false;

      if not PluginCorrect then
      begin
        newPlugin.Free;
        freeLibrary(DLLHandle);
      end
      else begin

   end;
    end
    else begin
      // DLL не найдена
    end;

  except
    freeLibrary(DLLHandle);
    if assigned(newPlugin) then newPlugin.Free;
  end;
end;


Я когда разбирался курил много статьи GunSmoker, сейчас уже все забыл. Но мне не нравится код библиотеки. Концовка неправильная вроде, вот так попробуй.

Код: Выделить всё

exports
        PluginInit            name 'PluginInit',
        PluginDeinit          name 'PluginDeinit',   

{$R *.res}

begin
  Application.Initialize;
end.


Для DLL с формами в настройках проекта должна стоять галочка что это оконное приложение, и вот Application.Initialize; подозреваю не дает завершится и освободится памяти процесса.

[Alex2013]

А если загружать DLL, а не связывать жестко?

Так по идее и планируется но пока не пробовал .

Я когда разбирался курил много статьи GunSmoker, сейчас уже все забыл. Но мне не нравится код библиотеки. Концовка неправильная вроде, вот так попробуй.

Ну не знаю я по аналогии с официальным примером делал

Код: Выделить всё

library lib;

{$mode objfpc}{$H+}

uses
  Classes,Forms, Interfaces, Unit1
  { you can add units after this };

procedure ShowForm;
begin
  Application.Initialize;
  Application.CreateForm(TForm1,Form1);
  Application.Run;
end;

exports
  ShowForm name 'ShowForm';
begin
end.


Пример работает нормально .

Для DLL с формами в настройках проекта должна стоять галочка что это оконное приложение, и вот Application.Initialize; подозреваю не дает завершится и освободится памяти процесса.

Я не создавал проект библиотеки "как DLL" а просто поменял BuildInBrowser.lpr в готовом проекте написав library BuildInBrowser; вместо program BuildInBrowser;

Хм нашел вот такую "крякозябру "

Код: Выделить всё

Procedure ShowForm (Appl, Form: THandle);
Begin
// Application.MainForm.Handle := Appl; // раскоментировать для Lazarus
// Application.Handle := Appl; // раскоментировать для Delphi
DllForm := TDllForm.Create(Application);
DLLForm.Show;
end;


Не совсем понял суть : нужно из DLL выкинуть Application.CreateForm(TForm1,Form1); a Application.Initialize; толи дописать в begin .... end. толи вообще не использовать ... но попробую . Однако, мне кажется, что проблема вот тут GlobalCEFApp := TCefApplication.Create;

Добавлено спустя 3 часа 52 минуты 19 секунд:
Переписал код библиотеки немного "более подробно" - глюк пропал !

Код: Выделить всё

library BuildInBrowser;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms, u1_browsermode,
  { you can add units after this }
  uCEFApplication;
{$IFDEF MSWINDOWS}
  // CEF3 needs to set the LARGEADDRESSAWARE flag which allows 32-bit processes to use up to 3GB of RAM.
  {$SetPEFlags $20}
{$ENDIF}

procedure DLLSetApplication(App:TApplication);
begin
Application:=App;
end;

procedure IntBrowser;
begin
    Application.CreateForm(TBR_MainForm, BR_MainForm);
end;

Function  CEFAppCreate:boolean;
begin
GlobalCEFApp := TCefApplication.Create;
CEFAppCreate:= GlobalCEFApp.StartMainProcess;
if GlobalCEFApp.StartMainProcess then
RequireDerivedFormResource:=True;
end;
procedure CEFAppFree;
begin
GlobalCEFApp.Free;
GlobalCEFApp := nil;
end;
Function GetBrApp:TApplication;
begin
GetBrApp:=Application;
end;
Function GetBR_MainForm:TBR_MainForm;
begin
GetBR_MainForm:=BR_MainForm;
end;

exports DLLSetApplication name 'DLLSetApplication';
exports CEFAppCreate  name 'CEFAppCreate';
exports IntBrowser   name 'IntBrowser';
exports CEFAppFree name 'CEFAppFree';
exports GetBrApp name  'GetBrApp';
exports GetBR_MainForm name 'GetBR_MainForm';
exports GlobalCEFApp name 'GlobalCEFApp';

begin

end.



Новый "Вызыватель DLL"...

Код: Выделить всё

program callerGUI_01;
{$mode objfpc}{$H+}
uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Windows,  Interfaces, // this includes the LCL widgetset
  Forms, c_gui_mf_02
  { you can add units after this };
{$R *.res}
procedure DLLSetApplication(App:TApplication);
        external 'BuildInBrowser' name 'DLLSetApplication';
procedure IntBrowser;external 'BuildInBrowser' name 'IntBrowser';
procedure CEFAppFree;external 'BuildInBrowser' name 'CEFAppFree';
Function GetBrApp:TApplication; external 'BuildInBrowser'  name  'GetBrApp';
Function CEFAppCreate :boolean; external 'BuildInBrowser' name 'CEFAppCreate';
begin
  if  CEFAppCreate then begin
  RequireDerivedFormResource:=True;
  Application.Scaled:=True;
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
   GetBrApp.Scaled:=True;  GetBrApp.Initialize; //??!
  GetBrApp.Free;  DLLSetApplication (Application);
  IntBrowser;
  Application.Run;
end;
  CEFAppFree;
end.


Но некоторая непонятка осталась ...
В этом фрагменте .

Код: Выделить всё

  GetBrApp.Scaled:=True;  GetBrApp.Initialize; //??!
//( Без этой сторчки  выпадет длинный баг-лист при  любой попытке доступа к форме браузера .)
  GetBrApp.Free;// Подумал "За чем мне две Application? " но смори выше . 
  DLLSetApplication (Application);  //"финт ушами"  Подменяю Application в ДЛЛ-ке   


Без GetBrApp.Free; работает
Без GetBrApp.Free; и DLLSetApplication (Application); тоже все в порядке .
Непонятно как может на что-то влиять GetBrApp.Initialize; если я в следующей строчке пишу GetBrApp.Free ;

[Alex2013]

А если загружать DLL, а не связывать жестко?

Упс ! Оказывается это чем-то от статической линковки все-же отличается .
"Статический" вариант тестового проекта ( Рабочий ) .

Библиотека DLL...

Код: Выделить всё

library BuildInBrowser;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms, Classes,  u1_browsermode,
  { you can add units after this }
  uCEFApplication;
//Interfaces, Classes, LCLType, Controls, StdCtrls, Forms, ExtCtrls;

{$R *.res}

{$IFDEF MSWINDOWS}
  // CEF3 needs to set the LARGEADDRESSAWARE flag which allows 32-bit processes to use up to 3GB of RAM.
  {$SetPEFlags $20}
{$ENDIF}

procedure DLLSetApplication(App:TApplication);
begin
Application:=App;
end;
procedure DLLSetApplication_Init(App:TApplication);
begin
Application.Scaled:=True;
Application.Initialize; //??!
Application.Handle:=App.Handle;
end;

procedure IntBrowser;
begin
Application.CreateForm(TBR_MainForm, BR_MainForm);
end;

Function  CEFAppCreate:boolean;
begin
GlobalCEFApp := TCefApplication.Create;
Result:=GlobalCEFApp.StartMainProcess;
if Result then
RequireDerivedFormResource:=True;
end;
procedure CEFAppFree;
begin
GlobalCEFApp.Free;
GlobalCEFApp := nil;
end;
Function GetBrApp:TApplication;
begin
GetBrApp:=Application;
end;
Function GetBR_MainForm:TBR_MainForm;
begin
GetBR_MainForm:=BR_MainForm;
end;
exports DLLSetApplication name 'DLLSetApplication';
exports DLLSetApplication_Init name 'DLLSetApplication_Init';
exports CEFAppCreate  name 'CEFAppCreate';
exports IntBrowser   name 'IntBrowser';
exports CEFAppFree name 'CEFAppFree';
exports GetBrApp name  'GetBrApp';
exports GetBR_MainForm name 'GetBR_MainForm';
exports GlobalCEFApp name 'GlobalCEFApp';

begin

end.


Основной проект (EXE)

Код: Выделить всё

program callerGUI_01;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Windows, Classes, SysUtils, Controls, Dialogs,  Interfaces, // this includes the LCL widgetset
  Forms, c_gui_mf_02,dynlibs,Messages;
  { you can add units after this }
//Interfaces, Classes, LCLType, Controls, StdCtrls, Forms, ExtCtrls;


{$R *.res}

procedure DLLSetApplication_Init(App:TApplication);
          external 'BuildInBrowser' name 'DLLSetApplication_Init';
procedure DLLSetApplication(App:TApplication);
        external 'BuildInBrowser' name 'DLLSetApplication';

procedure IntBrowser;external 'BuildInBrowser' name 'IntBrowser';
procedure CEFAppFree;external 'BuildInBrowser' name 'CEFAppFree';
Function GetBrApp:TApplication; external 'BuildInBrowser'  name  'GetBrApp';
Function CEFAppCreate :boolean; external 'BuildInBrowser' name 'CEFAppCreate';
Function GetBrApp:TApplication; external 'BuildInBrowser'  name  'GetBrApp';
Function GetBR_MainForm_X:TForm; external 'BuildInBrowser' name 'GetBR_MainForm';

Var
SaveDLLApp:TApplication;
BrApp:TApplication;


begin
 
  if  Boolean(CEFAppCreate) then
begin
  RequireDerivedFormResource:=True;
  Application.Scaled:=True;
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
DLLSetApplication_Init (Application);
IntBrowser;
  BR_MainForm := TForm( GetBR_MainForm );
  Application.Run;
end;
CEFAppFree;
end.


"Динамически" вариант тестового проекта отличается только кодом загрузчика .

Код: Выделить всё

program callerGUI_01;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Windows, Classes, SysUtils, Controls, Dialogs,  Interfaces, // this includes the LCL widgetset
  Forms, c_gui_mf_02,dynlibs,Messages;
  { you can add units after this }
//Interfaces, Classes, LCLType, Controls, StdCtrls, Forms, ExtCtrls;


{$R *.res}


type
T_DLLSetApplication = procedure (App:TApplication);stdcall;
T_IntBrowser=procedure;stdcall;
T_CEFAppFree=procedure;stdcall;
T_GetBrApp = Function :TApplication;
T_CEFAppCreate = Function : bool;stdcall;
T_GetBR_MainForm= Function:TForm;

Var
SaveDLLApp:TApplication;
lib:TLibHandle;
BrApp:TApplication;

DLLSetApplication : T_DLLSetApplication;
DLLSetApplication_Init  : T_DLLSetApplication;
IntBrowser:T_IntBrowser;
CEFAppFree:T_CEFAppFree;
GetBrApp :T_GetBrApp;
CEFAppCreate :T_CEFAppCreate;
GetBR_MainForm:T_GetBR_MainForm;

begin

  lib:=0;
lib:=SafeLoadLibrary(ExtractFileDir(paramstr(0))+'\'+
                                     'BuildInBrowser.dll');
  If lib = 0  then begin  ShowMessage ('BuildInBrowser.dll not found'); exit;  end;
  DLLSetApplication := T_DLLSetApplication (GetProcAddress(lib,'DLLSetApplication'));
  DLLSetApplication_Init := T_DLLSetApplication (GetProcAddress(lib,'DLLSetApplication_Init'));

  IntBrowser:= T_IntBrowser (GetProcAddress(lib,'IntBrowser'));
  CEFAppFree:= T_CEFAppFree (GetProcAddress(lib,'CEFAppFree'));
  GetBrApp := T_GetBrApp (GetProcAddress(lib,'GetBrApp'));
  CEFAppCreate := T_CEFAppCreate (GetProcAddress(lib,'CEFAppCreate'));
  GetBR_MainForm:= T_GetBR_MainForm(GetProcAddress(lib,'GetBR_MainForm'));

begin
 
  if  Boolean(CEFAppCreate) then
begin
  RequireDerivedFormResource:=True;
  Application.Scaled:=True;
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
DLLSetApplication_Init (Application);
IntBrowser;
  BR_MainForm := TForm( GetBR_MainForm );
  Application.Run;
end;
CEFAppFree;
end.


Запускается и вроде как работает но при любой попытке показать форму из DLL вылезает ошибка.
Понятно что

Код: Выделить всё

Application.Handle:=App.Handle;

...изрядное извращение но "в статике " ( без загрузки DLL через LoadLibrary ) все работает .
Вопрос: где тут собака зарыта ?
( В принципе можно сделать два "совсем независимых" Application (Одно в основной программе другое в DLL ) но это уже ИМХО как-то чересчур )
Скрин сверху "статика" (работает) снизу "динамика" (не работает)

[Alex2013]

Переделал пример из "Free Pascal и Lazarus Вики" https://wiki.freepascal.org/Form_in_DLL/ru для работы через LoadLibrary
( Несмотря на несколько неочевидных фокусов все заработало )

Код: Выделить всё

program MainApp;

uses
    Windows,dynlibs,SysUtils, Interfaces,
    Classes, LCLType, Controls, Dialogs, StdCtrls, Forms, ExtCtrls;

type
  TEnableDisableFormsCallBack = procedure(var FormList: Pointer);
  TCreateButtonCallBack = procedure(Caption: PChar; OnClick: TProcedure);

const
{$IFDEF WINDOWS}
  DLLDialogLib = 'DllDialog.dll';
{$ELSE}
  DLLDialogLib = 'DLLDialog.so';
{$ENDIF}

Type
T_DLLDialog_Init = procedure (DisableFormsCallBack, EnableFormsCallback: TEnableDisableFormsCallBack);
T_DLLDialog_Final = procedure;
T_DLLDialog_Show=procedure(ParentWindow: HWND);
T_DLLDialog_ShowModal=procedure(ParentWindow: HWND);
T_DLLDialog_CreateDLLButton = Procedure(ParentWindow: HWND);
T_DLLDialog_CreateButton=Procedure(CreateButtonCallBack: TCreateButtonCallBack);
//!stdcall добавлять не нужно !

type

  TMainForm = class(TForm)
  private
    PnlParent: TPanel;

    procedure BtnAddDLLButtonClick(Sender: TObject);
    procedure BtnAddButtonClick(Sender: TObject);
    procedure ShowModalDLLDialog(Sender: TObject);
    procedure ShowDLLDialog(Sender: TObject);
  public
    constructor Create(aOwner: TComponent); override;
  end;

var
  MainForm: TMainForm;
Const // чтобы не было "мусора" при загрузке
  DLLDialog_Init:T_DLLDialog_Init=Nil;
  DLLDialog_Final:T_DLLDialog_Final=Nil;
  DLLDialog_ShowModal:T_DLLDialog_ShowModal=Nil;
  DLLDialog_Show:T_DLLDialog_Show=Nil;
  DLLDialog_CreateDLLButton:T_DLLDialog_CreateDLLButton=Nil;
  DLLDialog_CreateButton:T_DLLDialog_CreateButton=Nil;

{ TMainForm }

procedure DisableFormsCallBack(var FormList: Pointer);
begin
  FormList := Screen.DisableForms(nil, TList(FormList));
end;

procedure EnableFormsCallback(var FormList: Pointer);
begin
  Screen.EnableForms(TList(FormList));
end;

constructor TMainForm.Create(aOwner: TComponent);
var
  BtnShow, BtnShowModal, BtnAddDLLButton, BtnAddButton: TButton;
begin
  inherited CreateNew(aOwner);

  Position := poWorkAreaCenter;
  Width := 600;
  Height := 200;

  BtnShow := TButton.Create(Self);
  BtnShow.Parent := Self;
  BtnShow.Caption := 'Show form';
  BtnShow.AutoSize := True;
  BtnShow.OnClick := @ShowDLLDialog;

  BtnShowModal := TButton.Create(Self);
  BtnShowModal.Parent := Self;
  BtnShowModal.Caption := 'Show modal form';
  BtnShowModal.AutoSize := True;
  BtnShowModal.OnClick := @ShowModalDLLDialog;
  BtnShowModal.AnchorSide[akLeft].Control := BtnShow;
  BtnShowModal.AnchorSide[akLeft].Side := asrRight;
  BtnShowModal.BorderSpacing.Left := 10;

  BtnAddDLLButton := TButton.Create(Self);
  BtnAddDLLButton.Parent := Self;
  BtnAddDLLButton.Caption := 'Create real DLL button';
  BtnAddDLLButton.AutoSize := True;
  BtnAddDLLButton.OnClick := @BtnAddDLLButtonClick;
  BtnAddDLLButton.AnchorSide[akLeft].Control := BtnShowModal;
  BtnAddDLLButton.AnchorSide[akLeft].Side := asrRight;
  BtnAddDLLButton.BorderSpacing.Left := 10;

  BtnAddButton := TButton.Create(Self);
  BtnAddButton.Parent := Self;
  BtnAddButton.Caption := 'Create fake DLL button';
  BtnAddButton.AutoSize := True;
  BtnAddButton.OnClick := @BtnAddButtonClick;
  BtnAddButton.AnchorSide[akLeft].Control := BtnAddDLLButton;
  BtnAddButton.AnchorSide[akLeft].Side := asrRight;
  BtnAddButton.BorderSpacing.Left := 10;

  PnlParent := TPanel.Create(Self);
  PnlParent.Parent := Self;
  PnlParent.AnchorSide[akTop].Control := BtnShow;
  PnlParent.AnchorSide[akTop].Side := asrBottom;
  PnlParent.BorderSpacing.Top := 10;
  PnlParent.Width := 220;
end;

procedure CreateButtonCallBack(ACaption: PChar; AOnClick: TProcedure);
var
  Btn: TButton;
  MyMethod: TMethod;
begin
  Btn := TButton.Create(MainForm);
  Btn.Caption := ACaption;
  Btn.Left := 100;
  Btn.Width := 100;
  Btn.Height := 20;
  MyMethod.Code := AOnClick;
  MyMethod.Data := nil;
  Btn.OnClick := TNotifyEvent(MyMethod);
  Btn.Parent := MainForm.PnlParent;
end;

procedure TMainForm.BtnAddButtonClick(Sender: TObject);
begin
  DLLDialog_CreateButton(@CreateButtonCallBack);
end;

procedure TMainForm.BtnAddDLLButtonClick(Sender: TObject);
begin
  DLLDialog_CreateDLLButton(PnlParent.Handle);
end;

procedure TMainForm.ShowDLLDialog(Sender: TObject);
begin
  DLLDialog_Show(0);
end;

procedure TMainForm.ShowModalDLLDialog(Sender: TObject);
begin
  DLLDialog_ShowModal(Self.Handle);
end;

{$R *.res}
var
   lib:TLibHandle;
begin

  lib:=0;
lib:= LoadLibrary(ExtractFileDir(paramstr(0))+'\'+ DLLDialogLib );
  If lib  < 32  then begin  ShowMessage ('dll not found'); exit;  end;
// Что это за магическое число 32  понятия не имею но в примерах есть почти всюду

  DLLDialog_Init:=T_DLLDialog_Init(GetProcAddress(lib,'DLLDialog_Init'));
  if   DLLDialog_Init <> nil then
  DLLDialog_Final:=T_DLLDialog_Final(GetProcAddress(lib,'DLLDialog_Final'));
  if  DLLDialog_Final <> nil then
  DLLDialog_ShowModal:=T_DLLDialog_ShowModal(GetProcAddress(lib,'DLLDialog_ShowModal'));
   if  DLLDialog_ShowModal <> nil then
  DLLDialog_Show:=T_DLLDialog_Show(GetProcAddress(lib,'DLLDialog_Show'));
    if  DLLDialog_Show <> nil then
   DLLDialog_CreateDLLButton:=T_DLLDialog_CreateDLLButton(GetProcAddress(lib,'DLLDialog_CreateDLLButton'));
    if  DLLDialog_CreateDLLButton <> nil then
  DLLDialog_CreateButton:=T_DLLDialog_CreateButton(GetProcAddress(lib,'DLLDialog_CreateButton'));
    if  DLLDialog_CreateButton = nil then begin ShowMessage ('dll  ERROR '); exit; end;
// Проверка кривовата но для теста сойдет 

  Application.Initialize;
  Application.CreateForm(TMainForm, MainForm);
  DLLDialog_Init(@DisableFormsCallBack, @EnableFormsCallback);
  try
    Application.Run;
  finally
    DLLDialog_Final;
  end;
end.


Однако конкретно моему проекту это пока не помогает ( Все еще есть ошибка при показе формы из ДЛЛ )...

[sts]

посмотрел я исходники (правда качать последний не стал, в наличии лазарус 2.0.2), в общем воз и ныне там, адекватной поддержки форм из либ не завезли и хуков соответствующих не заметил.
у либы по прежнему свой application и screen, а надо добавить проброс их из exe в lib или форму из lib в exe

[Alex2013]

посмотрел я исходники (правда качать последний не стал, в наличии лазарус 2.0.2),

Я собирал в 2.08 ( не думаю что от версии сильно зависит ).

адекватной поддержки форм из либ не завезли и хуков соответствующих не заметил.
у либы по прежнему свой application и screen, а надо добавить проброс их из exe в lib или форму из lib в exe

Сейчас я грешу на ресурсы ( возможно проблема в инициализации формы из ресурсов )
Но наличие РАЗНОГО поведения для "статической " и "динамической" загрузки DLL по прежнему непонятно.
Зы
Полный рабочий исходник и бинарник "по мотивам" примера Form_in_DLL ("нефильтрованный" но с LoadLibrary) на YD.
DllDialog01.7z Размер: 4,6 МБ
Тут ресурсы и "дизайн-тайм" создание формы не применяют и возможно в этом все дело.

Код: Выделить всё

procedure DLLDialog_Show(ParentWindow: HWND);
var
  DLLDialog: TDLLDialog;
begin
  DLLDialog := TDLLDialog.Create(ApplicationCallback);
  DLLDialog.ParentFormHandle := ParentWindow;
  DLLDialog.Show;
end;

procedure DLLDialog_CreateDLLButton(ParentWindow: HWND);
var
  Btn: TButton;
  BtnParentForm: TForm;
begin
  BtnParentForm := TForm.CreateNew(ApplicationCallback);
  BtnParentForm.ParentWindow := ParentWindow;
  BtnParentForm.Width := 100;
  BtnParentForm.Height := 20;
  BtnParentForm.BorderStyle := bsNone;
  BtnParentForm.Visible := True;

  Btn := TButton.Create(ApplicationCallback);
  Btn.Caption := 'Real DLL Button';
  Btn.Width := BtnParentForm.Width;
  Btn.Height := BtnParentForm.Height;
  Btn.OnClick := @ApplicationCallback.BtnClick;
  Btn.Parent := BtnParentForm;
end;


Хотя да ..

Код: Выделить всё

begin
  Application.Initialize;
end.


... в этом примере по прежнему используется .

[Alex2013]

Добился в тестовом проекте чего-то вроде этого.

С ресурсами на удивление дружит но Браузер работает через "пень колоду" и открывает чертову кучу "клонов окон" основного приложения. (То есть таже проблема, что возникала в начале темы )
Тест крайне халтурный ( инициализация движка хром добавлена прямо в обработчике нажатия кнопки) так что неудивительно что движок работает со "страшным скрипом" . Главное то что он вообще запустится и окно открылось нормально .
( Однако, все еще непонятно, что за проблема была в "первой версии" теста?
Где код типа

Код: Выделить всё

Application.CreateForm(TBR_MainForm, BR_MainForm);
BR_MainForm.Show;


отлично работал при "статической" линковке DLL но напрочь отказался работать при "динамической загрузке".)