DLL 中的 FMX 形式 (firemonkey/delphi)

发布于 2024-12-24 00:57:33 字数 4630 浏览 1 评论 0原文

我试图在 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 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

强者自强 2024-12-31 00:57:33

如果双方都导入 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 :-)

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文