从 Delphi FMX窗体库(dll)导入面板中的主应用程序

whhtz7ly  于 2022-11-23  发布在  其他
关注(0)|答案(1)|浏览(284)

我曾试图效仿的例子:
http://docwiki.embarcadero.com/CodeExamples/Rio/en/FMXEmbeddedForm_(Delphi)
但窗体元素就是不出现。我使用的是 Delphi 10.3,并针对Windows进行编译。如果窗体和面板都在库项目或程序项目中,那么它就可以正常工作。
它需要在Windows和MacOS中工作。

k10s72fa

k10s72fa1#

要在DLL中创建FMX表单,您必须创建一个DLL并添加所需的表单。在DLL中,您必须公开一个API,该API将您的DLL(一个或多个)表示为平面API,即普通函数和过程(不是方法)来创建/销毁表单,显示/隐藏表单以及您可能需要的任何其他内容。
对于窗体中的事件,您的DLL必须实现回调机制。当触发事件(例如单击按钮)时,您必须调用相应的回调。
主应用程序将像往常一样加载DLL,调用Windows LoadLibray函数。然后将调用您设计的API来创建窗体,使其可见,设置其边界并设置任何所需的回调。
在调用应用程序的FMX窗体中附加DLL中的窗体有些困难。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.

格式为.dfm的DLL:

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

享受吧弗朗索瓦·皮耶特

相关问题