如何显示 DLL 中的 FireMonkey 模态形式？

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;

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

我启动我的主机程序。名称为 "DLL Host" 的图标出现在任务栏中。 [好的]
当我点击按钮时，FireMonkey 窗体出现。 [确定].
这个新表单还有一个名为 "DLL Form" 的任务栏按钮。 [好的]
当我单击 FireMonkey 窗体上的关闭按钮时，它关闭了。 [好的]
但是，它的任务栏按钮在屏幕上仍然可见！ [绝对不行！]
我可以多次单击并关闭 FireMonkey 表单。它总是会正确显示，但它的任务栏按钮永远不会消失。
当我关闭 VCL 窗体时，它从任务栏中消失了。 [确定]
但是，FireMonkey 窗体仍然可见并且程序挂起。 [绝对不行！] 堆栈显示代码在 d3d11.dll 内部某处，如果可以信任的话。

我尝试了不同的方法来创建和销毁 FMX 表单，但似乎没有任何效果。

Answer 1

简短回答：FMX 到 FMX 使用包很好。除此之外，您的第一个问题是可以解决的，无需更改源代码，但是如果确实需要 GDI+，崩溃的问题则不会。

更长的答案：您可以通过从 FMX.Platform.Win 调用 RegisterApplicationHWNDProc 并提供回调函数来轻松修复无关的任务栏按钮；这个函数应该 return 来自主机的 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，那么它应该为此从 FMX.Platform.Win 传递 ApplicationHWND。

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

//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 处理），这显然会导致访问冲突当从 FMX.Forms.

的终结部分调用 'real' FinalizeForms 时

如何显示 DLL 中的 FireMonkey 模态形式？

How can I display FireMonkey modal form from a DLL?

delphi

dll

firemonkey