Interface DLL form app crashing - delphi

I have problem with host application, which loads DLL form and interfaceing some function and properties.
The purpose is load a dll, show name as module name, set connection to ADOTable component and show form with data. Everything is working fine. But after close the host app a host app crashed and I get windows that hostapp.exe stopped working.
I do not know whether it is by freeing library or setting nil for interface.
Do you have any solution? Thanks.
Interface CODE
unit u_baseplugin_intf;
interface
uses Data.Win.ADODB, Data.DB;
type
IBaseModuleInterface = interface
['{060A9C46-B3CF-4BA4-B025-2DC1D9F45076}']
function GetModuleName: Ansistring;stdcall;
procedure SetConn(sConn:TAdoConnection);stdcall;
procedure showF;stdcall;
procedure freeF;stdcall;
property ModuleName: Ansistring read GetModuleName;
property Connection : TAdoConnection write SetConn;
end;
implementation
end.
DLL code
library profileslist;
uses
System.SysUtils,
System.Classes,
u_baseplugin_intf,
u_profileslist in 'u_profileslist.pas' {Form_DLL};
{$R *.res}
function LoadModule:IBaseModuleInterface;stdcall;
begin
result:=TForm_DLL.Create(nil);
end;
exports
LoadModule;
begin
end.
DLL Form code
unit u_profileslist;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls,
u_baseplugin_intf, Data.DB,Data.Win.ADODB;
type
TForm_DLL = class(TForm, IBaseModuleInterface)
DBGrid1: TDBGrid;
ADOTable1: TADOTable;
DataSource1: TDataSource;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
{Interface methods implementation}
function GetModuleName: AnsiString;stdcall;
procedure SetConn(sConn:TAdoConnection);stdcall;
public
{ Public declarations }
{Interface methods implementation}
procedure ShowF;stdcall;
procedure FreeF;stdcall;
end;
var
Form_DLL: TForm_DLL;
implementation
{$R *.dfm}
{Interface methods implementation}
function TForm_DLL.GetModuleName;
begin
Result := 'Profiles list';
end;
procedure TForm_DLL.SetConn(sConn: TAdoConnection);
begin
AdoTable1.Connection:=sConn;
end;
procedure TForm_DLL.ShowF;
begin
ShowModal;
end;
procedure TForm_DLL.FreeF;
begin
FreeAndNil(Form_DLL);
end;
{Form_DLL methods implementation}
procedure TForm_DLL.FormClose(Sender: TObject; var Action: TCloseAction);
begin
AdoTable1.Active:=false;
end;
procedure TForm_DLL.FormShow(Sender: TObject);
begin
AdoTable1.Active:=true;
end;
end.
HOST app code
program hostapp;
uses
Vcl.Forms,
u_hostapp in 'u_hostapp.pas' {Form1},
u_baseplugin_intf in 'u_baseplugin_intf.pas';
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Host app FORM code
unit u_hostapp;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
u_baseplugin_intf,
Data.Win.ADODB, Data.DB;
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TModuleInterface = function:IBaseModuleInterface; stdcall;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
aModuleIntf : IBaseModuleInterface;
dllHandle : cardinal;
procedure LoadModule( aLibName : pWideChar );
var
lModule : TModuleInterface;
begin
dllHandle := LoadLibrary(aLibName) ;
if dllHandle <> 0 then
begin
#lModule := GetProcAddress(dllHandle, 'LoadModule') ;
if Assigned (lModule) then
aModuleIntf := lModule //call the function
else
begin
ShowMessage('GetModuleIntf not found.') ;
FreeLibrary(dllHandle) ;
end;
end
else
begin
ShowMessage(aLibName+' not found.') ;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
aModuleIntf.Connection:=AdoConnection1;
aModuleIntf.ShowF;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
aModuleIntf.Connection:=nil;
aModuleIntf.freeF;
aModuleIntf:=nil;
FreeLibrary(dllHandle);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LoadModule('profileslist.dll');
Label1.Caption:=aModuleIntf.ModuleName;
end;
end.

You never assign to Form_DLL. This means that when you call FreeF, you then perform FreeAndNil(Form_DLL). Since Form_DLL is nil, this does nothing, and the form still exists.
Fix that by changing LoadModule:
function LoadModule:IBaseModuleInterface;stdcall;
begin
Assert(not Assigned(Form_DLL));
Form_DLL:=TForm_DLL.Create(nil);
result:=Form_DLL;
end;
Although, I'd probably change the design completely by removing Form_DLL altogether. The host app maintains a reference to the form, on which the call to Free can be made. In other words, remove Form_DLL and implement FreeF like this:
procedure TForm_DLL.FreeF;
begin
Free; // or Destroy
end;
Or even better, use reference counted interfaces on the implementing object and let aModuleIntf:=nil take the form down.

Related

Does class(TInterfacedObject) need a destructor in Delphi?

I run in this situation where Destroy() is never called.
unit Unit2;
interface
type
// Interface
ITest = Interface(IInterface)
function IsTrue() : Boolean;
end;
TmyClass = class(TInterfacedObject, ITest)
public
// Interface implementation
function IsTrue() : Boolean;
constructor Create();
destructor Destroy(); override;
end;
implementation
constructor TmyClass.Create();
begin
inherited Create();
end;
destructor TmyClass.Destroy();
begin
inherited Destroy();
end;
published
// Property
property IsItTrue: Boolean read IsTrue;
end.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms,
Vcl.Dialogs, Vcl.StdCtrls, unit2;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
fMyClass: TmyClass;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
fMyClass.Free; // if refcount = 0 this works, if refcount <> 0 pointer error.
//or
fMyClass := Nil; // no error but Destroy wil not be executed
Close();
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
fMyClass := TMyClass.Create();
end;
end.
Reading this article, there is only a constructor but no destructor implemented.
Is there any particular reason for this?
And should I release (if needed) all other objects that will be defined in myClass by implementing a finalization section?
The most likely reason for the destructor not being called would be because you don't assign your object to an interface variable.
procedure Test1;
var
vMyObj : TObject;
begin
vMyObj := myclass.Create;
end; <-Destructor NOT called here
procedure Test2;
var
vMyIntf : IInterface;
begin
vMyIntf := myclass.Create;
end; <-Destructor IS called here.
If that's the case, I invite you to read this answer for more information.
Your fMyClass variable is an object reference, not an interface, so it does not participate in TInterfaceObject's reference counting.
You need to change this:
fMyClass: TmyClass;
to this:
fMyClass: ITest;
And then you can get rid of fMyClass.Free; altogether:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms,
Vcl.Dialogs, Vcl.StdCtrls, unit2;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
fMyClass: ITest;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
fMyClass := nil; // no error and Destroy will be executed
Close();
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
fMyClass := TMyClass.Create();
end;
end.
fMyClass := nil; will invoke reference counting only if fMyClass is an interface variable, not an object reference, and you can't call Free() on an interface variable.

TJclStringList crashes on Free

Create a simple VCL application:
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
type
TForm1 = class(TForm)
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
JclStringLists;
var
MyList1: TJclStringList;
MyList2: TJclStringList;
procedure TForm1.FormDestroy(Sender: TObject);
begin
MyList1.Free;
MyList2.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
MyList1 := TJclStringList.Create;
MyList2 := TJclStringList.Create;
MyList1.LoadFromFile('C:\ONE.txt');
MyList2.LoadFromFile('C:\TWO.txt');
Self.Caption := Self.Caption + ' ' + IntToStr(MyList1.Count);
Self.Caption := Self.Caption + ' ' + IntToStr(MyList2.Count);
end;
end.
It crashes in the TForm1.FormDestroy event-handler when attempting to free the MyList1 object instance. Why?
TJclStringList is a reference counted type (it's declared in JCLStringLists.pas as type TJclStringList = class(TJclInterfacedStringList, IInterface, IJclStringList) and implements both _AddRef and _Release to handle reference counting), so you shouldn't be creating them as objects at all, and you shouldn't manually free them - they will automatically be free'd when the reference to them goes out of scope. (This also means you should not declare them as global variables, because you then don't maintain control over their lifetime.)
The JclStringLists unit provides several functions that will properly create an instance of the interface for you. You can see them in that unit, just above the implementation keyword:
function JclStringList: IJclStringList; overload;
function JclStringListStrings(AStrings: TStrings): IJclStringList; overload;
function JclStringListStrings(const A: array of string): IJclStringList; overload;
function JclStringList(const A: array of const): IJclStringList; overload;
function JclStringList(const AText: string): IJclStringList; overload;
The proper way to use TJclStringList to do what you want is something like this:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, JCLStringLists;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
MyList1, MyList2: IJCLStringList; // Note I and not T in type.
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
MyList1 := JclStringList;
MyList1.LoadFromFile('C:\Work\Data\FirstName.txt');
MyList2 := JclStringList
MyList2.LoadFromFile('C:\Work\Data\LastName.txt');
// Only to demonstrate that both files got loaded by the code above.
Self.Caption := Format('First: %d Last: %d', [MyList1.Count, MyList2.Count]);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
// Do NOT free the JclStringLists here - they will automatically be released when
// the form is destroyed because the reference count will reach zero (as long as
// you don't have any other references to those variables, which by putting them into
// the private section is unlikely.
end;
end.

Delphi Form in DLL works, but Delphi Frame - not

I am trying to create a Form and a Frame in Delphi-made DLL using handles only. The form appears in host application normally, but the frame doesn't appear at all.
What could be wrong?
Below I provide a piece of code that creates both Frame and Window:
library DLL1;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
System.SysUtils,
System.Classes,
DllMain in 'DllMain.pas',
Winapi.Windows,
Vcl.Forms,
Vcl.Controls {DLLFrame1: TFrame},
DllForm in 'DllForm.pas' {Form1};
{$R *.res}
type
TSingleton = class
private
fra: TDLLFrame1;
frm: TForm1;
class var __instance: TSingleton;
class function __getInstance(): TSingleton; static;
public
class property Instance: TSingleton read __getInstance;
procedure CreateDLLFrame(AppHandle, ParentWindow: HWND);
procedure CreateDLLForm(AppHandle, ParentWindow: HWND);
procedure DestroyDLLFrame();
procedure DestroyDLLForm();
end;
procedure CreateDLLFrame(AppHandle, ParentWindow: HWND); stdcall;
begin
TSingleton.Instance.CreateDLLFrame(AppHandle, ParentWindow);
end;
procedure CreateDLLForm(AppHandle, ParentWindow: HWND); stdcall;
begin
TSingleton.Instance.CreateDLLForm(AppHandle, ParentWindow);
end;
procedure DestroyDLLFrame(); stdcall;
begin
TSingleton.Instance.DestroyDLLFrame();
end;
procedure DestroyDLLForm(); stdcall;
begin
TSingleton.Instance.DestroyDLLForm();
end;
exports
CreateDLLFrame,
CreateDLLForm,
DestroyDLLFrame,
DestroyDLLForm;
procedure TSingleton.CreateDLLFrame(AppHandle, ParentWindow: HWND);
begin
Application.Handle := AppHandle;
fra := TDLLFrame1.CreateParented(ParentWindow);
fra.Show();
end;
procedure TSingleton.DestroyDLLForm();
begin
frm.Free();
end;
procedure TSingleton.DestroyDLLFrame();
begin
fra.Free();
end;
procedure TSingleton.CreateDLLForm(AppHandle, ParentWindow: HWND);
begin
Application.Handle := AppHandle;
frm := TForm1.CreateParented(ParentWindow);
frm.Show();
end;
class function TSingleton.__getInstance(): TSingleton;
begin
if __instance = nil then
__instance := TSingleton.Create();
Result := __instance;
end;
end.
The DLLFrame:
unit DllMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TDLLFrame1 = class(TFrame)
mmoText: TMemo;
pnlSend: TPanel;
edtSend: TEdit;
btnSend: TButton;
private
public
constructor Create(AOwner: TComponent); override;
end;
implementation
{$R *.dfm}
{ TDLLFrame1 }
constructor TDLLFrame1.Create(AOwner: TComponent);
begin
inherited;
if AOwner = nil then
MessageBox(0, 'Frame owner is NIL', 'Debug', 0)
else
MessageBox(0, PWideChar(AOwner.Name), 'Debug', 0);
end;
end.
Delphi TFrame descend from TWinControl (and thus, TControl), they have an Owner and they have a Parent (often these are the same). The Owner controls the Frame's lifetime while the Parent controls where it's displayed (i.e. which Window handle is to be used). For example, in a VCL app with 2 form units and a frame unit, you could instantiate a Frame having it's owner be the Application object or the the first Form while having it's parent be the second form; the Frame would be displayed on the second form even though it's owner was the first frame.
What is the difference between Owner and Parent of a control?
This little example doesn't use DLLs, but it shows how the frame won't be displayed without a Parent being assigned:
unit CreateFrameAtRunTimeForm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm2 = class(TForm)
Label1: TLabel;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
uses CreateFrameAtRunTimeFrame;
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
var
F : TFrame3;
begin
F := TFrame3.Create(self);
F.Name := 'Frame'+Random(1000000).ToString;
F.Panel1.Caption := 'Frame '+F.Name;
F.Left := 200;
F.Top := 100;
end;
procedure TForm2.Button2Click(Sender: TObject);
var
F : TFrame3;
begin
F := TFrame3.Create(self);
F.Name := 'Frame'+Random(1000000).ToString;
F.Panel1.Caption := 'Frame '+F.Name;
F.Left := 200;
F.Top := 100;
F.Parent := self;
end;
end.
I'm sure your problem is that the Frame doesn't have a Parent control and I don't think it's possible to set one if you are only passing window handles around.

Again over interfaces in Delphi

In order to understand interfaces I've realized a small application with a form, a data module with a simple database.
here is the form
The data module contains only a connection, a table and a TDataSource component.
The interface unit is this:
unit databaseInterface;
interface
uses
MSAccess;
type
IDBTest = interface
['{5B8CF4FF-66F7-402D-8E18-0159CB22F805}']
procedure SetTable(table: TMSTable);
function SetPriorRecord: Boolean;
function SetNextRecord: Boolean;
end;
implementation
end.
and it's implementation is this:
unit databaseImplementation;
interface
uses
databaseInterface, database, MSAccess;
type
TDBTest = class(TInterfacedObject, IDBTest)
protected
DBTable: TMSTable;
FbtnPriorStatus: Boolean;
procedure SetTable(Table: TMSTable);
function SetPriorRecord: Boolean;
function SetNextRecord: Boolean;
public
property Table: TMSTable read DBTable write SetTable;
end;
implementation
{ TDBTest }
procedure TDBTest.SetTable(Table: TMSTable);
begin
if DBTable <> Table then begin
DBTable := Table;
DBTable.Open;
end;
end;
function TDBTest.SetPriorRecord: Boolean;
begin
if not DBTable.Bof then begin
DBTable.Prior;
Result := DBTable.Bof;
end else
Result := True;
end;
function TDBTest.SetNextRecord: Boolean;
begin
if not DBTable.Eof then begin
DBTable.Next;
Result := DBTable.Eof;
end else
Result := True;
end;
end.
Now, this is the question. The code of my form is as below:
unit main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.ExtCtrls, databaseInterface, databaseImplementation, JvExMask,
JvToolEdit, JvMaskEdit, JvCheckedMaskEdit, JvDatePickerEdit,
Vcl.StdCtrls, Vcl.Mask, Vcl.DBCtrls, JvDBDatePickerEdit, JvExControls,
JvButton, JvTransparentButton, database;
type
TfrmMain = class(TForm)
pnlCommands: TPanel;
pnlData: TPanel;
pnlMessages: TPanel;
bvlIcons: TBevel;
bvlNavigation: TBevel;
lblId: TLabel;
lblFirstName: TLabel;
lblLastName: TLabel;
lblBirthday: TLabel;
edtId: TDBEdit;
edtFirstName: TDBEdit;
edtLastName: TDBEdit;
dtpBirthday: TJvDBDatePickerEdit;
btnPrior: TJvTransparentButton;
btnNext: TJvTransparentButton;
procedure btnNextClick(Sender: TObject);
procedure btnPriorClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
DBTest: IDBTest;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
procedure TfrmMain.FormCreate(Sender: TObject);
begin
DBTest := TDBTest.Create;
end;
procedure TfrmMain.FormActivate(Sender: TObject);
begin
DBTest.SetTable(dmAuthors.tblAuthors);
end;
procedure TfrmMain.btnPriorClick(Sender: TObject);
begin
btnPrior.Enabled := not DBTest.SetPriorRecord;
btnNext.Enabled := True;
end;
procedure TfrmMain.btnNextClick(Sender: TObject);
begin
btnNext.Enabled := not DBTest.SetNextRecord;
btnPrior.Enabled := True;
end;
end.
So I call the methods SetPriorRecord and SetNextRecord when the user click over the related button and then, accordingly with the status of the table (BOF or EOF), I disable or enable buttons.
I wonder if there is a way to set buttons status via interface, decoupling this operation from the form; for example binding buttons in any way or something else, but I don't know how to do it, if it is possible!
I hope I was clear in my explication of the problem.
The existing interface is not sufficient. You need to pass in some means of letting the client know the state of the table, but without exposing the TDataSet's detailed logic (preferably). A callback to an event handler would work; a way to trigger TAction would work; as would an anonymous method. You basically need to return a flag of some kind signifying BOF, EOF, or somewhere in between; possibly also a record# and record count.
I've modified the application interface in this way:
unit databaseInterface;
interface
uses
MSAccess;
type
IDBTest = interface
['{5B8CF4FF-66F7-402D-8E18-0159CB22F805}']
procedure SetTable(table: TMSTable);
procedure SetPriorRecord;
procedure SetNextRecord;
function GetIsBof: Boolean;
function GetIsEof: Boolean;
property IsBof: Boolean read GetIsBof;
property IsEof: Boolean read GetIsEof;
end;
implementation
end.
and this is the interface implementation:
unit databaseImplementation;
interface
uses
databaseInterface, database, MSAccess;
type
TDBTest = class(TInterfacedObject, IDBTest)
protected
DBTable: TMSTable;
FIsBof: Boolean;
FIsEof: Boolean;
procedure SetTable(Table: TMSTable);
procedure SetPriorRecord;
procedure SetNextRecord;
function GetIsBof: Boolean;
function GetIsEof: Boolean;
procedure SetCursorStatus;
public
property Table: TMSTable read DBTable write SetTable;
property IsBof: Boolean read GetIsBof;
property IsEof: Boolean read GetIsEof;
end;
implementation
{ TDBTest }
procedure TDBTest.SetTable(Table: TMSTable);
begin
if DBTable <> Table then begin
DBTable := Table;
DBTable.Open;
end;
end;
procedure TDBTest.SetPriorRecord;
begin
try
DBTable.Prior;
finally
SetCursorStatus;
end;
end;
procedure TDBTest.SetNextRecord;
begin
try
DBTable.Next;
finally
SetCursorStatus;
end;
end;
procedure TDBTest.SetCursorStatus;
begin
FIsBof := DBTable.Bof;
FIsEof := DBTable.Eof;
end;
function TDBTest.GetIsBof: Boolean;
begin
Result := FIsBof;
end;
function TDBTest.GetIsEof: Boolean;
begin
Result := FIsEof;
end;
end.
So the form code become this:
unit main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Mask, Vcl.DBCtrls, JvExMask, JvToolEdit,
JvMaskEdit, JvCheckedMaskEdit, JvDatePickerEdit, JvDBDatePickerEdit,
JvExControls, JvButton, JvTransparentButton, database, databaseInterface,
databaseImplementation;
type
TfrmMain = class(TForm)
pnlCommands: TPanel;
pnlData: TPanel;
pnlMessages: TPanel;
bvlIcons: TBevel;
bvlNavigation: TBevel;
lblId: TLabel;
lblFirstName: TLabel;
lblLastName: TLabel;
lblBirthday: TLabel;
edtId: TDBEdit;
edtFirstName: TDBEdit;
edtLastName: TDBEdit;
dtpBirthday: TJvDBDatePickerEdit;
btnPrior: TJvTransparentButton;
btnNext: TJvTransparentButton;
procedure btnNextClick(Sender: TObject);
procedure btnPriorClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
DBTest: IDBTest;
procedure SetNavButtonsStatus;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
procedure TfrmMain.FormCreate(Sender: TObject);
begin
DBTest := TDBTest.Create;
end;
procedure TfrmMain.FormActivate(Sender: TObject);
begin
DBTest.SetTable(dmAuthors.tblAuthors);
end;
{ Begin table navigation ----------------------------------------------------- }
procedure TfrmMain.btnPriorClick(Sender: TObject);
begin
DBTest.SetPriorRecord;
SetNavButtonsStatus;
end;
procedure TfrmMain.btnNextClick(Sender: TObject);
begin
DBTest.SetNextRecord;
SetNavButtonsStatus;
end;
procedure TfrmMain.SetNavButtonsStatus;
begin
btnPrior.Enabled := not DBTest.IsBof;
btnNext.Enabled := not DBTest.IsEof
end;
{ End table navigation ------------------------------------------------------- }
end.
Now I think buttons are decoupled, but I'm not sure abot the solution I've found. Can It be good?

FMX form in a DLL (firemonkey/delphi)

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...
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 :-)

Resources