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

我尝试遵循以下示例:

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

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

在Windows和MacOS上都需要它。

speedisk 回答:从库(dll)到主要应用程序中的面板的Delphi FMX表单

要在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:       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,ErrMsg) then
            Exit;
        if not GetProcAddr('Show',@@FProcShow,ErrMsg) then
            Exit;
        if not GetProcAddr('Hide',@@FProcHide,ErrMsg) then
            Exit;
        if not GetProcAddr('SetBounds',@@FProcSetBounds,ErrMsg) then
            Exit;
        if not GetProcAddr('SetCallback',@@FProcSetCallback,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,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,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,FMX.Edit,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

享受, 弗朗索瓦·皮耶特(FrançoisPiette)

本文链接:https://www.f2er.com/2776583.html

大家都在问