Question

我想加载一个DLL（来自VCL应用程序~~，但这应该是重要的~~ [由于VCL和FMX都包含消息循环而不是这样]）并显示一个在该DLL中创建的FireMonkey模式窗体。显示表单工作正常但我在清理后有问题...

我只能在2011/2012年找到关于该主题的文章，他们大多指的是XE2。遗憾的是，这些解决方案不再适用。（或者我做错了什么。）

所有示例文件都在此处：https://github.com/gabr42/GpDelphiCode/tree/master/FMX%20from%20DLL

我的DLL只导出ShowMainForm。

library FMXDLL;

uses
  System.SysUtils,
  System.Classes,
  FMXMain in 'FMXMain.pas' {FormMain};

{$R *.res}

exports
  ShowMainForm;

begin
end.

ShowMainForm初始化GDI +，然后显示表单。之后，它试图清理但却失败了。

uses
  Winapi.GDIPAPI,
  Winapi.GDIPOBJ;

procedure InitGDIP;
begin
  // Initialize StartupInput structure
  StartupInput.DebugEventCallback := nil;
  StartupInput.SuppressBackgroundThread := False;
  StartupInput.SuppressExternalCodecs   := False;
  StartupInput.GdiplusVersion := 1;

  GdiplusStartup(gdiplusToken, @StartupInput, nil);
end;

procedure FreeGDIP;
begin
  if Assigned(GenericSansSerifFontFamily) then
    GenericSansSerifFontFamily.Free;
  if Assigned(GenericSerifFontFamily) then
    GenericSerifFontFamily.Free;
  if Assigned(GenericMonospaceFontFamily) then
    GenericMonospaceFontFamily.Free;
  if Assigned(GenericTypographicStringFormatBuffer) then
    GenericTypographicStringFormatBuffer.free;
  if Assigned(GenericDefaultStringFormatBuffer) then
    GenericDefaultStringFormatBuffer.Free;

  GdiplusShutdown(gdiplusToken);
end;

procedure ShowMainForm; stdcall;
var
  FormMain: TFormMain;
begin
  InitGDIP;
  Application.Title := 'DLL Form';
  FormMain := TFormMain.Create(Application);
  FormMain.ShowModal;
  FormMain.Free;
  Application.Terminate;
  Application.ProcessMessages;
  FreeGDIP;
end;

表单包含一个关闭表单的按钮。

procedure TFormMain.btnCloseClick(Sender: TObject);
begin
  Close;
end;

主机应用程序在创建其主窗体时加载此DLL

procedure TFormHost.FormCreate(Sender: TObject);
begin
  FLibHandle := LoadLibrary('FMXDLL');
  if FLibHandle = 0 then begin
    ShowMessage('Cannot load FMXDLL.DLL');
    Application.Terminate;
  end
  else begin
    FShowMain := GetProcAddress(FLibHandle, 'ShowMainForm');
    if not assigned(FShowMain) then begin
      ShowMessage('Missing export: ShowMainForm');
      Application.Terminate;
    end;
  end;
end;

它有一个显示FireMonkey表单的按钮。

procedure TFormHost.Button1Click(Sender: TObject);
begin
  FShowMain();
end;

在销毁表单时卸载DLL。

procedure TFormHost.FormDestroy(Sender: TObject);
begin
  if FLibHandle <> 0 then begin
    FreeLibrary(FLibHandle);
    FLibHandle := 0;
  end;
end;

这是观察到的行为（在Windows 10 Creators Edition上运行的Delphi 10.1 Berlin）：

我启动了我的主机程序。一个名为＆＃34; DLL Host＆＃34;的图标出现在任务栏中。 [确定
单击按钮时，将显示FireMonkey表单。 [确定]。
这个新表单还有一个名为＆＃34; DLL Form＆＃34;的任务栏按钮。 [确定
当我单击FireMonkey表单上的“关闭”按钮时，它将关闭。 [确定
但是，其任务栏按钮仍然在屏幕上可见！ [绝对不行！]
我可以多次点击并关闭FireMonkey表单。它将始终正确显示，但其任务栏按钮永远不会消失。
当我关闭我的VCL表单时，它会从任务栏中消失。 [确定]
然而，FireMonkey表单仍然可见并且程序挂起。 [绝对不行！] Stack显示代码位于d3d11.dll内，如果可以信任的话。

我尝试了不同的创建和销毁FMX表单的方法，但似乎没有任何工作正常。

Answer 1

简短回答：FMX到FMX使用套餐很好。除此之外，您的第一个问题是可解决的，没有源代码更改，但是如果真的需要GDI +，那么崩溃的问题就不会发生。

更长的答案：您可以通过从RegisterApplicationHWNDProc调用FMX.Platform.Win并提供回调函数，轻松修复无关的任务栏按钮;然后，此函数应返回来自主机的HWND。最好的方法是导出显式初始化函数：

var
  _AppHandle: HWND;

function GetAppHandle: HWND;
begin
  Result := _AppHandle;
end;

function InitializeDLL(AppHandle: HWND): HRESULT; stdcall;
begin
  try
    if AppHandle = 0 then Exit(E_HANDLE);
    if _AppHandle <> 0 then Exit(E_FAIL);
    InitGDIP; //reuse what you've taken from WinApi.GDIOBJ.pas
    _AppHandle := AppHandle;
    RegisterApplicationHWNDProc(GetAppHandle);
    Result := S_OK;
  except
    Result := E_UNEXPECTED;
  end;
end;

然后你有一个FinalizeDLL导出或某些用于清理：

procedure FinalizeDLL; stdcall;
begin
  FreeGDIP;
end;

主持人会在第一次使用时拨打InitializeDLL;如果应用程序本身使用FMX，那么它应该从ApplicationHWND传递FMX.Platform.Win。

但是，这并不能解决崩溃时的崩溃问题。更确切地说：当DLL使用Direct2D后端时，我不会得到它们，只有当我强制使用GDI +时。问题是全球持有的资源，例如由风格经理。您可能认为在完成GDI +之前可以通过执行FinalizeForms中的私有FMX.Forms.pas过程（而FinalizeForms本身是私有的，它所调用的不是）来明确清理事物：

//from FMX.Forms
procedure FinalizeForms;
begin
  FreeControls;
  TStyleManager.UnInitialize;
  TFilterManager.UnInitialize;
  TBitmapCodecManager.UnInitialize;
  TTextLayoutManager.UnInitialize;
  TCanvasManager.UnInitialize;
  TContextManager.UnInitialize;
  TShaderManager.UnInitialize;
end;

procedure FinalizeDLL; stdcall;
begin
  FinalizeForms;
  FreeGDIP;
end;

然而，这种解决方法最终仍然失败，因为TStyleManager.UnInitialize使用普通Free进行前两次处理（第三次获得FreeAndNil处理），这显然会导致访问违规＆＃39;真正的＆＃39;从FinalizeForms的最终版部分调用FMX.Forms。

如何从DLL显示FireMonkey模式窗体？

1 个答案: