我尝试遵循以下示例:
http://docwiki.embarcadero.com/CodeExamples/Rio/en/FMXEmbeddedForm_(Delphi)
,但是表单元素没有出现。我正在使用Delphi 10.3并针对Windows进行编译。 如果表单和面板都在库项目或程序项目中,则说明效果很好。
在Windows和MacOS上都需要它。
我尝试遵循以下示例:
http://docwiki.embarcadero.com/CodeExamples/Rio/en/FMXEmbeddedForm_(Delphi)
,但是表单元素没有出现。我正在使用Delphi 10.3并针对Windows进行编译。 如果表单和面板都在库项目或程序项目中,则说明效果很好。
在Windows和MacOS上都需要它。
要在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)