How can I display a FireMonkey modal form from a DLL?

I would like to load the DLL (from the VCL application , but this should be important [this is not true, since VCL and FMX contain a message loop]) and display the FireMonkey modal mode of the form created in this DLL. The form display works fine, but after that I have problems with cleaning ...

I can only find articles on this topic from 2011/2012, and they mainly relate to XE2. Unfortunately, these solutions no longer work. (Or am I 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.

ShowMainForminitializes GDI + and then shows the form. After that, he tries to clean, but does not work.

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 Windows 10 Creators Edition):

  • -. "DLL Host". [ OK]
  • , FireMonkey. [ OK].
  • "DLL Form". [ OK]
  • "" FireMonkey, . [ OK]
  • ! [ !]
  • FireMonkey. , .
  • VCL, . [ ]
  • FireMonkey, , , . [ !] , - d3d11.dll, .

FMX, .

+4
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 +, private 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), , , , "" FinalizeForms FMX.Forms.

+2

Source: https://habr.com/ru/post/1688880/


All Articles