How can I display FireMonkey modal form from a DLL?

Question

I would like to load a DLL (from an VCL application but that should't be important [that is not true as both VCL and FMX contain a message loop]) and display a FireMonkey modal form created in that DLL. Showing the form works OK but I have problems cleaning after it ...

I can only find only articles on that topic from years 2011/2012 and they mostly refer to XE2. These solutions sadly don't work anymore. (Or I'm doing something wrong.)

All sample files are here: https://github.com/gabr42/GpDelphiCode/tree/master/FMX%20from%20DLL

My DLL just exports ShowMainForm.

library FMXDLL;

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

{$R *.res}

exports
  ShowMainForm;

begin
end.

ShowMainForm initializes GDI+ and then shows the form. Afterwards, it tries to clean up but fails at that.

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;

Form contains a button which closes the form.

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

Host application loads this DLL when its main form is created

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;

It has a button which shows FireMonkey form.

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

DLL is unloaded when form is destroyed.

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

This is observed behaviour (Delphi 10.1 Berlin running on Windows 10 Creators Edition):

• I start my host program. An icon with name "DLL Host" appears in the taskbar. [OK]
• When I click the button, FireMonkey form appears. [OK].
• This new form also has a taskbar button with a name "DLL Form". [OK]
• When I click Close button on the FireMonkey form, it closes. [OK]
• However, its taskbar button is still visible on screen! [Definitely NOT OK!]
• I can click and close FireMonkey form multiple times. It will always show correctly but its taskbar button will never disappear.
• When I close my VCL form, it disappears from the taskbar. [OK]
• The FireMonkey form is, however, still visible and program hangs. [Definitely NOT OK!] Stack shows that the code is somewhere inside d3d11.dll, if that can be trusted.

I tried different ways of creating and destroying the FMX form but nothing seems to be working correctly.

Answer 1

Short answer: FMX to FMX using packages is fine. Outside of that your first issue is solvable, without source code changes, however the crashing one isn't, if GDI+ is really needed.

Longer answer: you can fix the extraneous taskbar button easily enough by calling RegisterApplicationHWNDProc from FMX.Platform.Win, and providing a callback function; this function should then return a HWND sourced from the host. Best way to do this is probably to export an explicit initialisation function:

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;

You'd then have a FinalizeDLL export or somesuch for cleanup:

procedure FinalizeDLL; stdcall;
begin
  FreeGDIP;
end;

The host would call InitializeDLL on first-time use; were the application itself use FMX, then it should pass ApplicationHWND from FMX.Platform.Win for this.

However, this doesn't resolve the crashes on close. More exactly: I don't get them when the DLL is using the Direct2D backend, only when I force GDI+. The problem is the existence of resources held globally, e.g. by the style manager. You might think you could clean things up explicitly before finalising GDI+ by doing what the private FinalizeForms procedure in FMX.Forms.pas does (while FinalizeForms itself is private, what it calls is not):

//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;

This workaround however still fails eventually because TStyleManager.UnInitialize uses a plain Free for its first two disposals (the third gets the FreeAndNil treatment), which obviously then leads to access violations when the 'real' FinalizeForms is called from the finalisation section of FMX.Forms.