DLL 中的 FMX 形式 (firemonkey/delphi)
我试图在 dll 中制作 FMX 表单,大约 17 小时(尝试不同的方法)后我得到了它的工作,除了我在尝试卸载 dll 时遇到异常。我不知道如何让它发挥作用,也许有人可以帮助我并指出我做错了什么?
旁注: 由于 AA 绘图,我的 VCL 应用程序中无法有 FMX 表单,我只需要在画布上绘图时在文本上使用它,而在 VCL 应用程序上有 FMX 表单时,我在文本上没有得到 ClearType :( 我正在尝试制作某种 OSD/HUD
项目来显示我的问题:
exe unit1.pas
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
unitLoadDLL, Winapi.GDIPOBJ;
procedure TForm1.Button1Click(Sender: TObject);
begin
showme();
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
closeme();
end;
end.
exe unitLoadDll.pas
unit unitLoadDLL;
interface
uses Windows, Dialogs;
type
TShowme = procedure();
TCloseme = procedure();
var
showme : TShowme = nil;
closeme : TCloseme = nil;
DllHandle : THandle;
implementation
initialization
if DllHandle = 0 then begin
DllHandle := LoadLibrary('C:\Users\Ja\Desktop\dupa\dll\Win32\Debug\Project1.dll');
if DllHandle > 0 then begin
@showme := GetProcAddress(DllHandle,'showme');
@closeme := GetProcAddress(DllHandle,'closeme');
end
else begin
MessageDlg('Select Image functionality is not available', mtInformation, [mbOK], 0);
end;
end;
finalization
if DLLHandle <> 0 then
FreeLibrary(DLLHandle);
end.
dll project1.dpr
library Project1;
uses
FMX.Forms,
System.SysUtils,
System.Classes,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
procedure showme(); stdcall export;
begin
TForm1.showme;
end;
procedure closeme(); stdcall export;
begin
TForm1.closeme;
end;
exports
showme, closeme;
begin
end.
dll unit1.pas
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs;
type
TForm1 = class(TForm)
Label1: TLabel;
private
{ Private declarations }
public
class procedure showme();
class procedure closeme();
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
class procedure TForm1.showme();
begin
Form1 := TForm1.Create(Application);
Form1.Show;
end;
class procedure TForm1.closeme();
begin
Form1.Free;
end;
end.
编辑(修复):
所有答案都有帮助,但我所做的是,GDI+ 在 dll 卸载之前被关闭...出现的是问题所在。unit1.pas 中
的 newunitLoadDll.pas
unit unitLoadDLL;
interface
uses Windows, Dialogs;
type
TShowme = procedure();
TCloseme = procedure();
var
showme : TShowme = nil;
closeme : TCloseme = nil;
DllHandle : THandle;
function LoadLib : Boolean;
procedure UnloadLib;
implementation
function LoadLib : Boolean;
begin
if DllHandle = 0 then begin
DllHandle := LoadLibrary('C:\Users\Ja\Desktop\dupa\dll\Win32\Debug\Project1.dll');
if DllHandle > 0 then begin
@showme := GetProcAddress(DllHandle,'showme');
@closeme := GetProcAddress(DllHandle,'closeme');
end
else begin
MessageDlg('Select Image functionality is not available', mtInformation, [mbOK], 0);
end;
end;
Result := DllHandle <> 0;
end;
procedure UnloadLib;
begin
if DLLHandle <> 0 then begin
FreeLibrary(DLLHandle);
DllHandle := 0;
end;
end;
initialization
LoadLib;
finalization
UnloadLib;
end.
newunit1.pas
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Winapi.GDIPOBJ;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
unitLoadDLL;
procedure TForm1.Button1Click(Sender: TObject);
begin
showme();
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
closeme();
end;
end.
我将 Winapi.GDIPOBJ 移到了接口指令之后的“uses”位置,并且它成功了...
谢谢大家的回答!很快再见!
Im trying to make a FMX form in a dll, after about 17 hours (of trying diffrent approches) i got it working, except i get a exception trying to unload the dll. I have no idea how to make it work, maybe someone could help me and point out what im doing wrong?
side note:
i cant have a FMX form in my VCL application becouse of the AA drawing, i just need it on my text while drawing on a canvas and while having a FMX form on a VCL application, i dont get that cleartype on text :( im trying to make a some sort of OSD/HUD.
Project showing my problem:
exe unit1.pas
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
unitLoadDLL, Winapi.GDIPOBJ;
procedure TForm1.Button1Click(Sender: TObject);
begin
showme();
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
closeme();
end;
end.
exe unitLoadDll.pas
unit unitLoadDLL;
interface
uses Windows, Dialogs;
type
TShowme = procedure();
TCloseme = procedure();
var
showme : TShowme = nil;
closeme : TCloseme = nil;
DllHandle : THandle;
implementation
initialization
if DllHandle = 0 then begin
DllHandle := LoadLibrary('C:\Users\Ja\Desktop\dupa\dll\Win32\Debug\Project1.dll');
if DllHandle > 0 then begin
@showme := GetProcAddress(DllHandle,'showme');
@closeme := GetProcAddress(DllHandle,'closeme');
end
else begin
MessageDlg('Select Image functionality is not available', mtInformation, [mbOK], 0);
end;
end;
finalization
if DLLHandle <> 0 then
FreeLibrary(DLLHandle);
end.
dll project1.dpr
library Project1;
uses
FMX.Forms,
System.SysUtils,
System.Classes,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
procedure showme(); stdcall export;
begin
TForm1.showme;
end;
procedure closeme(); stdcall export;
begin
TForm1.closeme;
end;
exports
showme, closeme;
begin
end.
dll unit1.pas
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs;
type
TForm1 = class(TForm)
Label1: TLabel;
private
{ Private declarations }
public
class procedure showme();
class procedure closeme();
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
class procedure TForm1.showme();
begin
Form1 := TForm1.Create(Application);
Form1.Show;
end;
class procedure TForm1.closeme();
begin
Form1.Free;
end;
end.
EDIT (FIX):
All answers ware helpfull, but what i've done is, that the GDI+ was shutdown BEFORE the dll unload... that appear's to be the problem.
new unitLoadDll.pas
unit unitLoadDLL;
interface
uses Windows, Dialogs;
type
TShowme = procedure();
TCloseme = procedure();
var
showme : TShowme = nil;
closeme : TCloseme = nil;
DllHandle : THandle;
function LoadLib : Boolean;
procedure UnloadLib;
implementation
function LoadLib : Boolean;
begin
if DllHandle = 0 then begin
DllHandle := LoadLibrary('C:\Users\Ja\Desktop\dupa\dll\Win32\Debug\Project1.dll');
if DllHandle > 0 then begin
@showme := GetProcAddress(DllHandle,'showme');
@closeme := GetProcAddress(DllHandle,'closeme');
end
else begin
MessageDlg('Select Image functionality is not available', mtInformation, [mbOK], 0);
end;
end;
Result := DllHandle <> 0;
end;
procedure UnloadLib;
begin
if DLLHandle <> 0 then begin
FreeLibrary(DLLHandle);
DllHandle := 0;
end;
end;
initialization
LoadLib;
finalization
UnloadLib;
end.
new unit1.pas
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Winapi.GDIPOBJ;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
unitLoadDLL;
procedure TForm1.Button1Click(Sender: TObject);
begin
showme();
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
closeme();
end;
end.
in unit1.pas i moved the Winapi.GDIPOBJ to "uses" just after interface directive, and it worked...
Thank you all for your answers! See you soon! very soon...
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(1)
如果双方都导入 sharemem 有帮助吗?
您没有使用包,因此双方可能都有一个自己的实例(所有 RTL 状态)以及 VMT 表(尽管这只是某些 IS 和 AS 情况下的问题)。并且内存管理器处于 RTL 状态:-)
Does it help if you import sharemem on both sides?
You are not using packages, so both sides probably have an own instance all RTL state, as well as VMT tables (though that is only a problem with certain IS and AS cases). And the memory manager is RTL state :-)