Question

Я пытался следовать примеру:

http://docwiki.embarcadero.com/CodeExamples/Rio/en/FMXEmbeddedForm_ (Delphi)

, но элементы формы просто не отображаются. Я использую Delphi 10.3 и компилирую для Windows. Если и форма, и панель находятся в проекте библиотеки или в программном проекте, тогда он работает хорошо.

Это необходимо для работы как в Windows, так и в MacOS.

fpiette · Answer 1 · 14 января 2020

Чтобы иметь форму FMX в DLL, вы должны создать DLL и добавить нужную форму. В DLL вы должны предоставить API, который представляет вашу DLL (одну или несколько) как плоский API, то есть обычные функции и процедуры (не методы) для создания / уничтожения формы, ее отображения / скрытия и всего, что вы можете need.

Для события в форме ваша DLL должна реализовать механизм обратного вызова. Когда событие инициируется (например, нажатие кнопки), вы должны вызвать соответствующий обратный вызов.

Основное приложение будет загружать DLL как обычно, вызывая Windows функцию LoadLibray. Затем он вызовет API, который вы разработали, чтобы создать форму, сделать ее видимой, установить его границы и настроить любой требуемый обратный вызов.

Присоединение формы в DLL где-то в форме FMX в вызывающем приложении является довольно сложной задачей. Компоненты FMX, кроме TForm, не имеют дескриптора окна, который необходим для того, чтобы форма в DLL была видна внутри формы приложения.

Если вы довольны вложением формы DLL в форму приложения, тогда это легко, потому что любая форма FMX имеет метод FormToHWND (), чтобы получить дескриптор окна для формы. Это может быть передано в DLL. DLL должна использовать этот дескриптор для установки родительского окна формы в DLL.

Я создал простое приложение и соответствующую DLL. DLL имеет одну форму с TLabel, TEdit и TButton. Приложение имеет одну форму с двумя TButton (для создания / отображения и скрытия формы в DLL) и TMemo для отображения данных из DLL.

В DLL кнопка используется для отправки данные в основное приложение с помощью обратного вызова.

Вот код:

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       Francois.PIETTE@overbyte.be
Creation:     Jan 14, 2020
Description:  Demo app for FMX form in a DLL
Disclaimer:   This is free software. Use it at your own risks.
Version:      1.00
History:


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit FomInDllAppMain;

interface

uses
    System.SysUtils, System.Types, System.UITypes, System.Classes,
    System.Variants, System.IOUtils,  WinApi.Windows,
    FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
    FMX.Controls.Presentation, FMX.StdCtrls, FMX.Platform.Win,
    FMX.ScrollBox, FMX.Memo;

type
    TInDllCreateForm                = function  (ParentHWnd : HWnd): HWnd;
                                                stdcall;
    TInDllProc                      = procedure;  stdcall;
    TInDllSetBounds                 = procedure (ALeft,  ATop    : Integer;
                                                 AWidth, AHeight : Integer);
                                                stdcall;
    TInDllSetCallback               = procedure (const Context  : PChar;
                                                 const Value    : Pointer;
                                                 const UserData : UIntPtr); stdcall;

    TAppMainForm = class(TForm)
        CreateFormButton: TButton;
        DestroyFormButton: TButton;
        DisplayMemo: TMemo;
        procedure CreateFormButtonClick(Sender: TObject);
        procedure DestroyFormButtonClick(Sender: TObject);
    private
        FDllHandle                     : THandle;
        FWindowHandle                  : HWnd;
        FProcCreate                    : TInDllCreateForm;
        FProcDestroy                   : TInDllProc;
        FProcShow                      : TInDllProc;
        FProcHide                      : TInDllProc;
        FProcSetBounds                 : TInDllSetBounds;
        FProcSetCallback               : TInDllSetCallback;
        function Load(
            const FileName     : String;
            const ParentHandle : HWND;
            const LeftPos      : Integer;
            const TopPos       : Integer;
            out   ErrMsg       : String): Integer;
        procedure Unload(const ErrMsg : String = '');
        function  GetProcAddr(const ProcName : String;
                              const ProcAddr : PPointer;
                              out   ErrCode  : Integer;
                              out   ErrMsg   : String): Boolean;
        function InDllOKButtonCallback(Param : UIntPtr) : UIntPtr;
    end;

var
  AppMainForm: TAppMainForm;

implementation

{$R *.fmx}

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TAppMainForm.CreateFormButtonClick(Sender: TObject);
var
    DllFilename : String;
    ErrorMsg    : String;
begin
    DllFilename := IncludeTrailingPathDelimiter(TDirectory.GetCurrentDirectory)
                   + 'FormInDll.dll';
    if Load(DllFilename,
            FormToHWND(Self),
            16,
            50,
            ErrorMsg) <> 0 then begin
        DisplayMemo.Lines.Add(ErrorMsg);
        Exit;
    end;
    DisplayMemo.Lines.Add('FormInDll loaded');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TAppMainForm.DestroyFormButtonClick(Sender: TObject);
begin
    Unload();
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TAppMainForm.GetProcAddr(
    const ProcName   : String;
    const ProcAddr   : PPointer;
    out   ErrCode    : Integer;
    out   ErrMsg     : String) : Boolean;
begin
    IntPtr(ProcAddr^) := IntPtr(GetProcAddress(FDllHandle, PChar(ProcName)));
    if not Assigned(ProcAddr^) then begin
        Result  := FALSE;
        ErrCode := Integer(GetLastError);
        ErrMsg  := Format('Function "%s" not found. Error #%d',
                         [ProcName, ErrCode]);
        Unload;
    end
    else begin
        Result  := TRUE;
        ErrCode := ERROR_SUCCESS;
        ErrMsg  := '';
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TAppMainForm.InDllOKButtonCallback(Param: UIntPtr): UIntPtr;
begin
    DisplayMemo.Lines.Add('Data received: "' + PChar(Param) + '"');
    Result := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function InDllOKButtonCallback(
    UserData : UIntPtr;
    Param    : UIntPtr) : UIntPtr;
var
    Form : TAppMainForm;
begin
    Form   := TObject(UserData) as TAppMainForm;
    Result := Form.InDllOKButtonCallback(Param);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TAppMainForm.Load(
    const FileName     : String;
    const ParentHandle : HWND;
    const LeftPos      : Integer;
    const TopPos       : Integer;
    out   ErrMsg       : String): Integer;
begin
    Result := ERROR_FILE_NOT_FOUND;
    if FDllHandle = 0 then begin
        FDllHandle    := LoadLibrary(PChar(FileName));
        if FDllHandle = 0 then begin
            Result := GetLastError;
            ErrMsg := Format('LoadLibrary failed with error #%d', [Result]);
            Unload;
            Exit;
        end;

        if not GetProcAddr('CreateForm', @@FProcCreate, Result, ErrMsg) then
            Exit;
        if not GetProcAddr('DestroyForm', @@FProcDestroy, Result, ErrMsg) then
            Exit;
        if not GetProcAddr('Show', @@FProcShow, Result, ErrMsg) then
            Exit;
        if not GetProcAddr('Hide', @@FProcHide, Result, ErrMsg) then
            Exit;
        if not GetProcAddr('SetBounds', @@FProcSetBounds, Result, ErrMsg) then
            Exit;
        if not GetProcAddr('SetCallback', @@FProcSetCallback, Result, ErrMsg) then
            Exit;
    end;

    FWindowHandle := FProcCreate(ParentHandle);
    FProcSetCallback('OKButton', @FomInDllAppMain.InDllOKButtonCallback, UIntPtr(Self));
    FProcSetBounds(LeftPos, TopPos, -1, -1);
    FProcShow;
    Result := ERROR_SUCCESS;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TAppMainForm.Unload(const ErrMsg: String);
begin
    if (FDllHandle = 0) or (@FProcDestroy = nil) then
        Exit;
    FProcDestroy;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.

Форма в основном приложении в виде dfm:

object AppMainForm: TAppMainForm
  Left = 0
  Top = 0
  Caption = 'AppMain'
  ClientHeight = 480
  ClientWidth = 461
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  DesignerMasterStyle = 0
  object CreateFormButton: TButton
    Position.X = 16.000000000000000000
    Position.Y = 24.000000000000000000
    TabOrder = 0
    Text = 'CreateForm'
    OnClick = CreateFormButtonClick
  end
  object DestroyFormButton: TButton
    Position.X = 120.000000000000000000
    Position.Y = 24.000000000000000000
    TabOrder = 1
    Text = 'DestroyForm'
    OnClick = DestroyFormButtonClick
  end
  object DisplayMemo: TMemo
    Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
    DataDetectorTypes = []
    Position.X = 16.000000000000000000
    Position.Y = 224.000000000000000000
    Size.Width = 421.000000000000000000
    Size.Height = 165.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 2
    Viewport.Width = 417.000000000000000000
    Viewport.Height = 161.000000000000000000
  end
end

Код для DLL:

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       Francois.PIETTE@overbyte.be
Creation:     Jan 14, 2020
Description:  Demo DLL for FMX form in a DLL
Disclaimer:   This is free software. Use it at your own risks.
Version:      1.00
History:


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
library FormInDll;

uses
  System.SysUtils,
  System.Classes,
  WinApi.Windows,
  FMX.Types,
  FMX.Forms,
  FormInDllForm in 'FormInDllForm.pas' {DllForm};

{$R *.res}

var
    DllForm      : TDllForm;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function CreateForm(ParentForm: HWnd) : HWnd; stdcall;
begin
    try
        if not Assigned(DllForm) then
            DllForm := TDllForm.Create(nil);
        Result := DllForm.AttachToHWnd(ParentForm);
    except
        Result := INVALID_HANDLE_VALUE;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure DestroyForm; stdcall;
begin
    if Assigned(DllForm) then
        FreeAndNil(DllForm);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure Show; stdcall;
begin
    if Assigned(DllForm) then
        DllForm.Show;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure Hide; stdcall;
begin
    if Assigned(DllForm) then
        DllForm.Hide;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer); stdcall;
var
    Width, Height : Integer;
begin
    if not Assigned(DllForm) then
        Exit;

    if AWidth >= 0 then
        Width := AWidth
    else
        Width := DllForm.Width;

    if AHeight >= 0 then
        Height := AHeight
    else
        Height := DllForm.Height;

    DllForm.SetBounds(ALeft, ATop, Width, Height);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure SetCallback(
    const Context  : PChar;
    const Value    : TCallbackFunction;
    const UserData : UIntPtr); stdcall;
begin
    if Assigned(DllForm) then
        DllForm.SetCallback(Context, Value, UserData);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
exports
    CreateForm,
    DestroyForm,
    Show,
    Hide,
    SetBounds,
    SetCallback;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure DllMain(Reason: Integer);
begin
  if Reason = DLL_PROCESS_DETACH then begin
    OutputDebugString('DLL PROCESS DETACH');
    FreeAndNil(DllForm);
    FreeAndNil(Application);
  end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

begin
    DllProc := @DllMain;
    DllProc(DLL_PROCESS_ATTACH);
end.

И, наконец, код для формы в DLL:

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       Francois.PIETTE@overbyte.be
Creation:     Jan 14, 2020
Description:  Demo FMX form in a DLL
Disclaimer:   This is free software. Use it at your own risks.
Version:      1.00
History:


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit FormInDllForm;

interface

uses
    System.SysUtils, System.Types, System.UITypes,
    System.Classes, System.Variants,
    FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
    FMX.Edit, FMX.Controls.Presentation,
    FMX.Platform.Win,
    WinApi.Windows;

type
    TCallbackFunction = function (UserData : UIntPtr;
                                  Param    : UIntPtr) : UIntPtr;

    TDllForm = class(TForm)
        Label1: TLabel;
        DataEdit: TEdit;
        OKButton: TButton;
        procedure OKButtonClick(Sender: TObject);
    private
        FOKButtonCallback : TCallbackFunction;
        FOKButtonUserData : UIntPtr;
    public
        function  AttachToHWnd(AHandle : HWND) : HWND;
        procedure SetCallback(const Context  : PChar;
                              const Value    : TCallbackFunction;
                              const UserData : UIntPtr);
    end;

var
  DllForm: TDllForm;

implementation

{$R *.fmx}

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

{ TDllForm }

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TDllForm.AttachToHWnd(AHandle: HWND): HWND;
var
    FmxFormHWnd: HWnd;
begin
    FmxFormHWnd := FmxHandleToHWND(Handle);
    SetWindowLong(FmxFormHWnd,
                  GWL_STYLE,
                  NativeInt(WS_POPUP or WS_CLIPSIBLINGS or
                            WS_CLIPCHILDREN or WS_SYSMENU));
    SetWindowLong(FmxFormHWnd,
                  GWL_EXSTYLE,
                  WS_EX_CONTROLPARENT or WS_EX_APPWINDOW);
    Winapi.Windows.SetParent(FmxFormHWnd, AHandle);
    Visible := TRUE;
    Result  := FmxFormHWnd;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TDllForm.OKButtonClick(Sender: TObject);
begin
    if @FOKButtonCallback = nil then
        Exit;
    FOKButtonCallback(FOKButtonUserData, UIntPtr(PChar(DataEdit.Text)));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TDllForm.SetCallback(
    const Context  : PChar;
    const Value    : TCallbackFunction;
    const UserData : UIntPtr);
begin
    if SameText(Context, 'OKButton') then begin
        FOKButtonCallback := Value;
        FOKButtonUserData := UserData;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.

DLL в форме .dfm:

object DllForm: TDllForm
  Left = 0
  Top = 0
  Caption = 'DllForm'
  ClientHeight = 78
  ClientWidth = 262
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  DesignerMasterStyle = 0
  object Label1: TLabel
    Position.Y = -1.000000000000000000
    Text = 'This a form in DLL'
    TabOrder = 0
  end
  object DataEdit: TEdit
    Touch.InteractiveGestures = [LongTap, DoubleTap]
    TabOrder = 1
    Text = 'Enter data here'
    Position.Y = 35.000000000000000000
    Size.Width = 145.000000000000000000
    Size.Height = 22.000000000000000000
    Size.PlatformDefault = False
  end
  object OKButton: TButton
    Position.X = 156.000000000000000000
    Position.Y = 35.000000000000000000
    TabOrder = 2
    Text = 'OKButton'
    OnClick = OKButtonClick
  end
end

Наслаждайтесь, Франсуа Пиетт

Delphi Форма FMX из библиотеки (dll) в панель в основном приложении

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Delphi Форма FMX из библиотеки (dll) в панель в основном приложении

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Похожие темы