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.
Related
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.
I have created a simple DataSnap client/server application with the wizard in Delphi XE8 using the echostring and reversestring sample methods. When I put "ReportMemoryLeaksOnShutdown := True" in the Server dpr and call the echostring and/or reversestring methods from the client the result is good but when I close the server application (after closing the client) I always get 2 or more unknown memory leaks. Is this a known bug which I can't find on the internet or is there a solution?
Server code:
unit ServerMethodsUnit;
interface
uses System.SysUtils, System.Classes, System.Json,
Datasnap.DSServer, Datasnap.DSAuth, DataSnap.DSProviderDataModuleAdapter;
type
{$METHODINFO ON}
TServerMethods = class(TDataModule)
private
{ Private declarations }
public
{ Public declarations }
function EchoString(Value: string): string;
function ReverseString(Value: string): string;
end;
{$METHODINFO OFF}
implementation
{%CLASSGROUP 'FMX.Controls.TControl'}
{$R *.dfm}
uses System.StrUtils;
function TServerMethods.EchoString(Value: string): string;
begin
Result := Value;
end;
function TServerMethods.ReverseString(Value: string): string;
begin
Result := System.StrUtils.ReverseString(Value);
end;
end.
dfm
object ServerContainer: TServerContainer
OldCreateOrder = False
Height = 271
Width = 415
object DSServer1: TDSServer
Left = 96
Top = 11
end
object DSTCPServerTransport1: TDSTCPServerTransport
Server = DSServer1
Filters = <>
Left = 96
Top = 73
end
object DSServerClass1: TDSServerClass
OnGetClass = DSServerClass1GetClass
Server = DSServer1
Left = 200
Top = 11
end
end
dfm project file
program DataSnap_Server;
uses
FMX.Forms,
Web.WebReq,
IdHTTPWebBrokerBridge,
ServerMainForm in 'ServerMainForm.pas' {Form2},
ServerMethodsUnit in 'ServerMethodsUnit.pas' {ServerMethods: TDataModule},
ServerContainerUnit in 'ServerContainerUnit.pas' {ServerContainer: TDataModule};
{$R *.res}
begin
ReportMemoryLeaksOnShutdown := True;
Application.Initialize;
Application.CreateForm(TForm2, Form2);
Application.CreateForm(TServerContainer, ServerContainer);
Application.Run;
end.
client side code generated source
//
// Created by the DataSnap proxy generator.
// 14-5-2015 22:45:56
//
unit ClientClassesUnit;
interface
uses System.JSON, Data.DBXCommon, Data.DBXClient, Data.DBXDataSnap, Data.DBXJSON, Datasnap.DSProxy, System.Classes, System.SysUtils, Data.DB, Data.SqlExpr, Data.DBXDBReaders, Data.DBXCDSReaders, Data.DBXJSONReflect;
type
TServerMethodsClient = class(TDSAdminClient)
private
FEchoStringCommand: TDBXCommand;
FReverseStringCommand: TDBXCommand;
public
constructor Create(ADBXConnection: TDBXConnection); overload;
constructor Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean); overload;
destructor Destroy; override;
function EchoString(Value: string): string;
function ReverseString(Value: string): string;
end;
implementation
function TServerMethodsClient.EchoString(Value: string): string;
begin
if FEchoStringCommand = nil then
begin
FEchoStringCommand := FDBXConnection.CreateCommand;
FEchoStringCommand.CommandType := TDBXCommandTypes.DSServerMethod;
FEchoStringCommand.Text := 'TServerMethods.EchoString';
FEchoStringCommand.Prepare;
end;
FEchoStringCommand.Parameters[0].Value.SetWideString(Value);
FEchoStringCommand.ExecuteUpdate;
Result := FEchoStringCommand.Parameters[1].Value.GetWideString;
end;
function TServerMethodsClient.ReverseString(Value: string): string;
begin
if FReverseStringCommand = nil then
begin
FReverseStringCommand := FDBXConnection.CreateCommand;
FReverseStringCommand.CommandType := TDBXCommandTypes.DSServerMethod;
FReverseStringCommand.Text := 'TServerMethods.ReverseString';
FReverseStringCommand.Prepare;
end;
FReverseStringCommand.Parameters[0].Value.SetWideString(Value);
FReverseStringCommand.ExecuteUpdate;
Result := FReverseStringCommand.Parameters[1].Value.GetWideString;
end;
constructor TServerMethodsClient.Create(ADBXConnection: TDBXConnection);
begin
inherited Create(ADBXConnection);
end;
constructor TServerMethodsClient.Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean);
begin
inherited Create(ADBXConnection, AInstanceOwner);
end;
destructor TServerMethodsClient.Destroy;
begin
FEchoStringCommand.DisposeOf;
FReverseStringCommand.DisposeOf;
inherited;
end;
end.
Own source
unit ClientMainForm;
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;
Edit1: TEdit;
Button2: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
ClientModuleUnit;
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := ClientModule.ServerMethodsClient.EchoString(Edit1.Text);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Label1.Caption := ClientModule.ServerMethodsClient.ReverseString(Edit1.Text);
end;
end.
Memory leak looks like always exist, or, we doing something wrong.
What I checked:
I move all server app code into the one unit.
I try server app without FMX - with VCL.
I try to create TDSServer, TDSTCPServerTransport, TDSServerClass in runtime with parents Self and Nil.
I try with TServerMethod class owner TPersistance and TComponent (Delphi help says to use it).
I try with compiled server app as 32 bit and 64 bit application in Delphi XE7 Update 1 and in Delphi XE8.
EurekaLog 7.2.2 cannot catch details about memory leak also.
For avoid catching Access Violation by EurekaLog need to use DSServer1.Stop before exit.
As we could see Access Violation when you using EurekaLog happens there
Basically it's in
System.TObject.InheritsFrom(???)
System._IsClass($64AE4E0,TDSServerTransport)
Datasnap.DSCommonServer.TDSCustomServer.StopTransports
Datasnap.DSCommonServer.TDSCustomServer.Stop
Datasnap.DSServer.TDSServer.Stop
Datasnap.DSServer.TDSServer.Destroy
System.TObject.Free
System.Classes.TComponent.DestroyComponents
System.Classes.TComponent.Destroy
System.Classes.TDataModule.Destroy
System.TObject.Free
System.Classes.TComponent.DestroyComponents
FMX.Forms.DoneApplication
System.SysUtils.DoExitProc
System._Halt0
:00408da8 TObject.InheritsFrom + $8
Server app:
unit ufmMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Datasnap.DSServer, Datasnap.DSTCPServerTransport, Datasnap.DSAuth, DataSnap.DSProviderDataModuleAdapter, Datasnap.DSCommonServer,
IPPeerServer;
type
{$METHODINFO ON}
TServerMethods = class(TComponent)
private
{ Private declarations }
public
{ Public declarations }
function EchoString(Value: string): string;
end;
{$METHODINFO OFF}
TfmMain = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
DSServer1: TDSServer;
DSTCPServerTransport1: TDSTCPServerTransport;
DSServerClass1: TDSServerClass;
procedure DSServerClass1GetClass(DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
end;
var
fmMain: TfmMain;
implementation
{$R *.dfm}
uses System.StrUtils;
function TServerMethods.EchoString(Value: string): string;
begin
Result := Value;
end;
procedure TfmMain.DSServerClass1GetClass(DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
begin
PersistentClass := TServerMethods;
end;
procedure TfmMain.FormCreate(Sender: TObject);
begin
DSServer1 := TDSServer.Create(nil);
DSServer1.Name := 'DSServer1';
DSServer1.AutoStart := False;
DSTCPServerTransport1 := TDSTCPServerTransport.Create(nil);
DSTCPServerTransport1.Server := DSServer1;
DSServerClass1 := TDSServerClass.Create(nil);
DSServerClass1.Server := DSServer1;
DSServerClass1.OnGetClass := DSServerClass1GetClass;
DSServer1.Start;
end;
procedure TfmMain.FormDestroy(Sender: TObject);
begin
DSServer1.Stop;
DSServerClass1.Free;
DSTCPServerTransport1.Free;
DSServer1.Free;
end;
end.
I guess it is a known bug for XE8 by now, I think it's pretty serious, at least serious enough for us NOT to use XE8 before Embarcadero has given us an answer on what's going on.
We had a similar issue in XE2, as far as I remember it was on heavy callbacks.
This Eurekalog doesn't tell me much, it looks like deep inside datasnap, sorry I don't know how to make the log more readable.
EDIT:
I reported this issue to Embarcadero and got this response today:
//
Hi Henrik,
Part of the memory leaks are due to a bug in the System.Collections.Generics.pas, we are looking at releasing a fix this issue in very near future.
brgds
Roy.
//
Thought you might wanna know :)
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.
Is it possible in Delphi 7 to create an abstract class that can be inherited through the Visual Form Inheritance technique? If so, please, provide an example.
The task is this. I want to create a form that will serve as a base form for two other forms that will inherit all the properties of that form. The two inheriting forms will be used for adding new stuff to the database (creating a product item, for example) and editing that stuff. So, I guess the base form should be thought of as an abstract class that should have okay and cancel buttons and things like that which all inheriting classes will share. Well, it is obviously an abstract class, because there is no other use of the form other than being a form to base other forms on.
Here's a simple diagram to make the point clearer:
First of all we need to define what abstract class means. There appear to me to be two competing definitions:
An abstract class is one that cannot be instantiated. This is the most commonly used definition.
An abstract class is one that contains more than one abstract method.
Since Delphi no language mechanism for enforcing definition 1, it would appear that definition 2 is the definition that applies to this question.
And the answer to the question is that classes that contain abstract methods can be used with Visual Form Inheritance.
Modern versions of Delphi do allow you to decorate classes with the abstract keyword. However, this has no effect. You can still instantiate such a class. It is my understanding that the abstract keyword was added for the benefit of the Delphi .net compiler.
Again, in modern versions of Delphi, you can configure the compiler to treat instantiation of classes with abstract methods as a compilation error. That's probably the closest you can get in Delphi to definition 1.
However, even that does not fully adhere to definition 1 since those classes can be instantiated through RTTI or virtual constructors. And the mechanism by which a designed component is instantiated is a perfect example.
Take this class for example:
type
TForm1 = class(TForm)
public
procedure Boo; virtual; abstract;
end;
Even if you set the option for W2000 Constructing instance containing abstract method to Error, you can still let the framework instantiate the class. It's only if you write TForm1.Create that the compiler objects.
You use the term abstract, but reading your question, I seriously doubt you really mean it the way abstract within Delphi is defined. I think you mean the term abstract in the general plain spoken way: you want to design a form with parts that have to be altered or added by descendants. Abstract methods in Delphi mean class routines without implementation. It does not matter though, because it is perfectly possible to design a base form, with or without abstract methods.
You can create a setup as shown in your picture/diagram as follows:
Design a form TBaseForm with 2 Edits, 2 Labels, 2 Buttons and 1 ActionList,
Add 3 actions to the ActionList: Create, Save and Cancel,
Assign the Cancel action to CancelButton.Action in advance,
Save the form,
Design a new form, inherited from TBaseForm, with the menu command: File > New > Other > [Project Name] > BaseForm
You will have a new form that has the edits, labels, buttons and actions,
Assign the Save action to the other button's action property,
Give it a "Edit Item" caption,
Save the form, and repeat it for the "Create New Item"-form.
The base form may have abstract methods, if you want to. When you create a TBaseForm instance at runtime, the compiler will give a warning constructing instance of 'TBaseForm' containing abstract method 'TBaseForm.MethodName'. It remains a warning, until you invoke the method at runtime which will produce an abstract error. Creating a descendant form which implements that method, then there will be no warning. Creating forms with abstract methods in the designer does not produce warnings. Runtime errors then may still occur though.
No, you cannot create an "abstract" base form in Delphi Visual Form Inheritance in the strict Delphi sense of the word "abstract".
However, from your description it doesn't sound like you actually need a strictly abstract base form. You don't mention a requirement for defining abstract methods at all.
It sounds like you just need a base form from which you create multiple differently specialized descendants that can share UI and implementation with the base form.
That's what VFI is for, so yes, you can do that.
I have Succeed to create a Demo with a BaseForm has Abstract Methodes and is work as charm ...
my IDE is Rad Studio RIO
my BaseForm code:
unit UBaseForm;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.ExtCtrls, Vcl.StdCtrls;
type
TBaseForm = class(TForm)
Lbl_IndexPage: TLabel;
procedure Abstracted_Event(Sender: TObject); virtual; abstract;
procedure Abstracted_Proc; virtual; abstract;
function Abstracted_Func: string; virtual; abstract;
private
{ Private declarations }
public
{ Public declarations }
end;
procedure Get_SubForm(var Ref; AFormClass: TFormClass;
aOwner: TComponent; aParent: TWinControl);
var
BaseForm: TBaseForm;
implementation
{$R *.dfm}
procedure Get_SubForm(var Ref; AFormClass: TFormClass;
aOwner: TComponent; aParent: TWinControl);
var
Instance: TBaseForm;
begin
if not Assigned(TBaseForm(Ref)) then
begin
Instance := TBaseForm(AFormClass.NewInstance);
TBaseForm(Ref) := Instance;
Instance.Create(aOwner);
end
else Instance := TBaseForm(Ref);
Instance.Parent := aParent;
Instance.Align := alClient;
Instance.BorderStyle := bsNone;
Instance.OnShow := Instance.Abstracted_Event;
Instance.Show;
end;
end.
in my APP i have three Forms can inherit all the properties of that BaseForm Above Even the Methodes ...
unit UFirstPage;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
UBaseForm,
Vcl.StdCtrls, Vcl.ExtCtrls;
type
TFrmFirstPage = class(TBaseForm)
Pnl_1: TPanel;
Edt_Abst_Msg_Event: TEdit;
Pnl_2: TPanel;
Pnl_3: TPanel;
Btn_Get_Abstract_Func: TButton;
Btn_Get_Abstract_Proc: TButton;
procedure Btn_Get_Abstract_FuncClick(Sender: TObject);
procedure Btn_Get_Abstract_ProcClick(Sender: TObject);
published
procedure Abstracted_Event(Sender: TObject); override;
procedure Abstracted_Proc; override;
function Abstracted_Func: string; override;
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmFirstPage: TFrmFirstPage;
implementation
{$R *.dfm}
{ TFrmFirstPage }
{$REGION ' Overridden Abstract Methodes ..'}
procedure TFrmFirstPage.Abstracted_Event(Sender: TObject);
begin
inherited;
Pnl_1.Color := clBlue; Pnl_2.Color := clGray; Pnl_3.Color := clRed;
Edt_Abst_Msg_Event.Text := 'All this Properties can changed using [Abstracted_Event] | (Owner Form is: ['+ Self.ClassName +'])';
end;
function TFrmFirstPage.Abstracted_Func: string;
begin
Result := 'I''m Just an Override of Abstracted_Func ['+ Self.ClassName +']';
end;
procedure TFrmFirstPage.Abstracted_Proc;
begin
inherited;
ShowMessage('I''m Just an Override of Abstracted_Proc ['+ Self.ClassName +']');
end;
{$ENDREGION}
procedure TFrmFirstPage.Btn_Get_Abstract_FuncClick(Sender: TObject);
begin
ShowMessage(Abstracted_Func);
end;
procedure TFrmFirstPage.Btn_Get_Abstract_ProcClick(Sender: TObject);
begin
Abstracted_Proc;
end;
end.
my Second Form:
unit USecondPage;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
UBaseForm,
Vcl.StdCtrls;
type
TFrmSecondPage = class(TBaseForm)
Lbl_Abst_Msg_Event: TLabel;
Lbl_1: TLabel;
Lbl_2: TLabel;
Lbl_3: TLabel;
Btn_Do_Abst_Proc: TButton;
Btn_Get_Abst_Func: TButton;
procedure Btn_Do_Abst_ProcClick(Sender: TObject);
procedure Btn_Get_Abst_FuncClick(Sender: TObject);
published
procedure Abstracted_Event(Sender: TObject); override;
procedure Abstracted_Proc; override;
function Abstracted_Func: string; override;
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmSecondPage: TFrmSecondPage;
implementation
{$R *.dfm}
{ TFrmSecondPage }
{$REGION ' Overridden Abstract Methodes ..'}
procedure TFrmSecondPage.Abstracted_Event(Sender: TObject);
begin
inherited;
Lbl_1.Font.Color := clBlue; Lbl_2.Font.Color := clGray; Lbl_3.Font.Color := clRed;
Lbl_Abst_Msg_Event.Caption := 'All this Properties can changed using [Abstracted_Event] | (Owner Form is: ['+ Self.ClassName +'])';
end;
function TFrmSecondPage.Abstracted_Func: string;
begin
Result := 'I''m Just an Override of Abstracted_Func ['+ Self.ClassName +']';
end;
procedure TFrmSecondPage.Abstracted_Proc;
begin
inherited;
ShowMessage('I''m Just an Override of Abstracted_Proc ['+ Self.ClassName +']');
end;
{$ENDREGION}
procedure TFrmSecondPage.Btn_Do_Abst_ProcClick(Sender: TObject);
begin
Abstracted_Proc;
end;
procedure TFrmSecondPage.Btn_Get_Abst_FuncClick(Sender: TObject);
begin
ShowMessage(Abstracted_Func);
end;
end.
my third Form:
unit UThirdPage;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
UBaseForm,
Vcl.StdCtrls;
type
TFrmThirdPage = class(TBaseForm)
published
procedure Abstracted_Event(Sender: TObject); override;
procedure Abstracted_Proc; override;
function Abstracted_Func: string; override;
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmThirdPage: TFrmThirdPage;
implementation
{$R *.dfm}
{ TFrmThirdPage }
{$REGION ' Overridden Abstract Methodes ..'}
procedure TFrmThirdPage.Abstracted_Event(Sender: TObject);
begin
inherited;
// your Code Goes Here ..
// call this methode or fill it with code Not a Mandatory :)
// The Mandatory thing is to implement this Methodes Exactly where BASEFORM HAS & without Missing any one of them from the Base Class...
// Enjoy ...
end;
function TFrmThirdPage.Abstracted_Func: string;
begin
// your Code Goes Here ..
// call this methode or fill it with code Not a Mandatory :)
// Enjoy ...
end;
procedure TFrmThirdPage.Abstracted_Proc;
begin
inherited;
// your Code Goes Here ..
// call this methode or fill it with code Not a Mandatory :)
// Enjoy ...
end;
{$ENDREGION}
end.
my Main Form:
unit UMain;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
Vcl.ExtCtrls,
// My Abstracted Views ..
UFirstPage,
USecondPage,
UThirdPage;
type
TFrmMain = class(TForm)
Pnl_ToolBar: TPanel;
Pnl_StatusBar: TPanel;
Btn_Previous: TButton;
Btn_Next: TButton;
Notebook_SubForms: TNotebook;
Pnl_First_PAGE: TPanel;
Pnl_Second_PAGE: TPanel;
Pnl_Third_PAGE: TPanel;
procedure FormCreate(Sender: TObject);
procedure Notebook_SubFormsPageChanged(Sender: TObject);
procedure Btn_NextClick(Sender: TObject);
procedure Btn_PreviousClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmMain: TFrmMain;
implementation
uses
// My Abstracted Base Template ..
UBaseForm;
{$R *.dfm}
procedure TFrmMain.Btn_NextClick(Sender: TObject);
begin
case Notebook_SubForms.PageIndex of
0:begin
Notebook_SubForms.PageIndex := 1;
end;
1:begin
Notebook_SubForms.PageIndex := 2;
end;
2:begin
Notebook_SubForms.PageIndex := 0;
end;
end;
end;
procedure TFrmMain.Btn_PreviousClick(Sender: TObject);
begin
case Notebook_SubForms.PageIndex of
0:begin
Notebook_SubForms.PageIndex := 2;
end;
1:begin
Notebook_SubForms.PageIndex := 0;
end;
2:begin
Notebook_SubForms.PageIndex := 1;
end;
end;
end;
procedure TFrmMain.FormCreate(Sender: TObject);
begin
Get_SubForm(FrmFirstPage, TFrmFirstPage, Self, Pnl_First_PAGE);
end;
procedure TFrmMain.Notebook_SubFormsPageChanged(Sender: TObject);
begin
case Notebook_SubForms.PageIndex of
0:begin
Get_SubForm(FrmFirstPage, TFrmFirstPage, Self, Pnl_First_PAGE);
if Assigned(FrmSecondPage) then FreeAndNil(FrmSecondPage);
if Assigned(FrmThirdPage) then FreeAndNil(FrmThirdPage);
end;
1:begin
Get_SubForm(FrmSecondPage, TFrmSecondPage, Self, Pnl_Second_PAGE);
if Assigned(FrmFirstPage) then FreeAndNil(FrmFirstPage);
if Assigned(FrmThirdPage) then FreeAndNil(FrmThirdPage);
end;
2:begin
Get_SubForm(FrmThirdPage, TFrmThirdPage, Self, Pnl_Third_PAGE);
if Assigned(FrmSecondPage) then FreeAndNil(FrmSecondPage);
if Assigned(FrmSecondPage) then FreeAndNil(FrmSecondPage);
end;
end;
end;
end.
When Compile 0 error and 0 Warning..
Result:
link to download the whole demo from my Github Repo here.
the Demo can work Also in Delphi 7 (i test it) :)
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 :-)