从库（dll）到主要应用程序中的面板的Delphi FMX表单

问题描述 投票：0回答：1

我尝试遵循以下示例：

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

但是表单元素不会出现。我正在使用Delphi 10.3并针对Windows进行编译。如果表单和面板都在库项目或程序项目中，则效果很好。

forms delphi dll panel firemonkey
1个回答
0
投票

要在DLL中包含FMX表单，必须创建一个DLL并添加所需的表单。在DLL中，您必须公开一个以平面API形式展示DLL（一个或多个）的API，即用于创建/销毁表单，显示/隐藏表单以及您可能会执行的其他任何操作的普通函数和过程（而非方法）需要。

对于表单中的事件，您的DLL必须实现回调机制。触发事件（例如，单击按钮）时，必须调用适当的回调。

主应用程序将照常加载DLL，并调用Windows LoadLibray函数。然后将调用您设计用来创建表单，使其可见，设置边界并设置任何所需回调的API。

将DLL中的表单附加到调用应用程序中FMX表单中的某个位置有些困难。 FMX组件（TForm除外）没有窗口句柄，而在应用程序窗体内看到的DLL中必须包含该窗体的窗口句柄。

如果您对将DLL的表单附加到应用程序表单中感到满意，那么这很容易，因为任何FMX表单都具有FormToHWND（）方法来获取该表单的窗口句柄。可以将其传递给DLL。 DLL必须使用该句柄在DLL中设置表单的父窗口。

我已经创建了一个简单的应用程序和相应的DLL。DLL具有带有TLabel，TEdit和TButton的单一形式。该应用程序具有一个带有两个TButton（用于在DLL中创建/显示和隐藏该窗体）的表单，以及一个用于显示DLL中数据的TMemo。

在DLL中，该按钮用于通过使用回调将数据发送到主应用程序。

这里是代码：

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

Author:       [email protected]
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:       [email protected]
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:       [email protected]
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

享受，FrançoisPiette

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.