 |
BorlandTalk.com
Borland discussion newsgroups
|
| View previous topic :: View next topic |
| Author |
Message |
Ralf Mimoun
Guest
|
 Posted: Sun Dec 04, 2005 1:06 am Post subject: Singleton TDataModule |
 |
|
Hi all,
after hammering with my head for some hours against the wall (and keyboard
and monitor), I need your advice. What I need is a TDataModule with
singleton pattern. That's easy. But I must be able to inherit from that
thing. All the TSingleton examples I found don't work. They base on
NewInstance, which works fine (means: for the second .Create, the stored
instance is used), but nonetheless I get an exception after calling .Create
the second time that a component of the class of my datamodule exists.
Is there such a beast like an inheriteable singleton datamodule? If yes, can
you please post some code snippets or hints?
Ralf
|
|
| Back to top |
|
 |
Marc Rohloff [TeamB]
Guest
|
| Posted: Sun Dec 04, 2005 1:21 am Post subject: Re: Singleton TDataModule |
|
|
On Sun, 4 Dec 2005 02:06:06 +0100, Ralf Mimoun wrote:
| Quote: | after hammering with my head for some hours against the wall (and keyboard
and monitor), I need your advice. What I need is a TDataModule with
singleton pattern. That's easy. But I must be able to inherit from that
thing. All the TSingleton examples I found don't work. They base on
NewInstance, which works fine (means: for the second .Create, the stored
instance is used), but nonetheless I get an exception after calling .Create
the second time that a component of the class of my datamodule exists.
Is there such a beast like an inheriteable singleton datamodule? If yes, can
you please post some code snippets or hints?
|
You would have to base your NewInstance code on some sort of array
indexed by the class type instead of a single global variable.
--
Marc Rohloff [TeamB]
marc rohloff -at- myrealbox -dot- com
|
|
| Back to top |
|
|
Ralf Mimoun
Guest
|
| Posted: Sun Dec 04, 2005 1:29 am Post subject: Re: Singleton TDataModule |
|
|
Marc,
Marc Rohloff [TeamB]" <"on request wrote:
....
| Quote: | You would have to base your NewInstance code on some sort of array
indexed by the class type instead of a single global variable.
|
Of course, and that's how all the TSingleton implementations allowing
inheritance are based on. I guess that the problem is in the more complex
Create constructor of datamodules.
Ralf
|
|
| Back to top |
|
|
Marc Rohloff [TeamB]
Guest
|
| Posted: Sun Dec 04, 2005 4:22 am Post subject: Re: Singleton TDataModule |
|
|
On Sun, 4 Dec 2005 02:29:59 +0100, Ralf Mimoun wrote:
| Quote: | Of course, and that's how all the TSingleton implementations allowing
inheritance are based on. I guess that the problem is in the more complex
Create constructor of datamodules.
|
It might help if you post the code of your implementation.
--
Marc Rohloff [TeamB]
marc rohloff -at- myrealbox -dot- com
|
|
| Back to top |
|
|
Charles McAllister
Guest
|
| Posted: Sun Dec 04, 2005 4:47 am Post subject: Re: Singleton TDataModule |
|
|
Ralf Mimoun wrote:
| Quote: | Hi all,
after hammering with my head for some hours against the wall (and keyboard
and monitor), I need your advice. What I need is a TDataModule with
singleton pattern. That's easy. But I must be able to inherit from that
thing. All the TSingleton examples I found don't work. They base on
NewInstance, which works fine (means: for the second .Create, the stored
instance is used), but nonetheless I get an exception after calling .Create
the second time that a component of the class of my datamodule exists.
Is there such a beast like an inheriteable singleton datamodule? If yes, can
you please post some code snippets or hints?
Ralf
|
Stop hammering. Here's an inheritable singleton pattern:
Full source is uploaded in the attachments group.
Note: if you use this in a design-time package, AOwner should be nil, not Application!!!
unit dmBaseSingleton;
interface
uses
SysUtils, Classes;
type
TBaseSingletonDataModule = class(TDataModule)
private
public
class function Singleton(AOwner: TComponent): TBaseSingletonDataModule;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
implementation
{$R *.dfm}
var
_BaseSingletonDataModule: TBaseSingletonDataModule = nil;
_BaseSingletonInternalCreate: Boolean = False;
{ TBaseSingletonDataModule }
constructor TBaseSingletonDataModule.Create(AOwner: TComponent);
begin
Assert(_BaseSingletonInternalCreate);
inherited;
end;
destructor TBaseSingletonDataModule.Destroy;
begin
_BaseSingletonDataModule := nil;
inherited;
end;
class function TBaseSingletonDataModule.Singleton(AOwner: TComponent): TBaseSingletonDataModule;
begin
if not Assigned(_BaseSingletonDataModule) then
begin
_BaseSingletonInternalCreate := True;
try
// Self is the correct ClassType since we're in a class method, this
// allows for descendant singletons...
_BaseSingletonDataModule := Self.Create(AOwner);
finally
_BaseSingletonInternalCreate := False;
end;
end;
Result := _BaseSingletonDataModule;
end;
initialization
finalization
_BaseSingletonDataModule.Free;
end.
|
|
| Back to top |
|
|
Charles McAllister
Guest
|
| Posted: Sun Dec 04, 2005 4:57 am Post subject: Re: Singleton TDataModule |
|
|
Charles McAllister wrote:
| Quote: | Stop hammering. Here's an inheritable singleton pattern:
Full source is uploaded in the attachments group.
Note: if you use this in a design-time package, AOwner should be nil,
not Application!!!
Forgot to mention that the example only allows you to write one descendant. not very useful huh? |
You'll have to extend the example to using an array or list of internal global variables, one for
each type of descendant, instead of just the one _BaseSingletonDataModule variable. For example,
use the ClassName function inside the Singleton method to index into your list.
|
|
| Back to top |
|
|
danny heijl
Guest
|
| Posted: Sun Dec 04, 2005 10:03 am Post subject: Re: Singleton TDataModule |
|
|
Below is an inheritable implementation I found on the net, written by
Lucian Radulescu (but the link where I found it seems dead now).
//******************************************************************************
//
// Copyright © 2002 by Lucian Radulescu
// mailto : [email]lucian (AT) ez-delphi (DOT) com[/email]
// http : http://www.ez-delphi.com/
//
//******************************************************************************
//
// Adapted singleton class from Borland Comunity
//
// My prototype allows for inheritance, such as:
//
// type
//
// // TApplication
// TApplication = class( TSingleton )
// protected
// procedure InitializeInstance; override;
// procedure FinalizeInstance; override;
// end;
//
// // TScreen
// TScreen = class( TSingleton )
// protected
// procedure InitializeInstance; override;
// procedure FinalizeInstance; override;
// end;
//
// all internal members (data/objects) will be created/destroyed
// in InitializeInstance / FinalizeInstance
//
// var
// A1, A2: TApplication;
// S1, S2: TScreen;
// begin
// A1 := TApplication.Create;
// A2 := TApplication.Create;
// S1 := TScreen.Create;
// S2 := TScreen.Create;
// ... // note, my code : A1=A2 and S1=S2 and A1 <> S1
// A1.Free;
// A2.Free;
// S2.Free;
// S1.Free;
// end;
//
// To optimize the code I would suggest using this approach for
// creation of objects inheriting from TSingleton:
//
// function Application: TApplication;
//
// implementation
//
// var
// _Application: TApplication = nil;
//
// function Application: TApplication;
// begin
// if _Application = nil then
// _Application := TApplication.Create;
// Result := _Application;
// end;
// ...
// finalization
// if _Application <> nil then
// _Application.Free;
// end;
//
//
--------------------------------------------------------------------------
unit singleton;
interface
uses
Classes;
type
// you can inherit from TSingleton and create different singleton objects
TSingleton = class
private
FRef: Integer;
protected
procedure InitializeInstance; virtual;
procedure FinalizeInstance; virtual;
public
class function NewInstance: TObject; override;
procedure FreeInstance; override;
end;
implementation
// TSingleton
------------------------------------------------------------------
var
Singletons: TStringList = nil;
procedure TSingleton.FreeInstance;
var
Index: Integer;
Instance: TSingleton;
begin
Singletons.Find( ClassName, Index );
Instance := TSingleton( Singletons.Objects[Index] );
Dec( Instance.FRef );
if Instance.FRef = 0 then
begin
Singletons.Delete( Index );
Instance.FinalizeInstance;
// at this point, Instance = Self. We want to call TObject.FreeInstance
inherited FreeInstance;
end;
end;
procedure TSingleton.FinalizeInstance;
begin
end;
procedure TSingleton.InitializeInstance;
begin
end;
class function TSingleton.NewInstance: TObject;
var
Index: Integer;
begin
if Singletons = nil then begin
Singletons := TStringList.Create;
Singletons.Sorted := true;
Singletons.Duplicates := dupError;
end;
if not Singletons.Find( ClassName, Index ) then
begin
Result := inherited NewInstance;
TSingleton( Result ).FRef := 1;
TSingleton( Result ).InitializeInstance;
Singletons.AddObject( ClassName, Result );
end
else
begin
Result := Singletons.Objects[Index];
Inc( TSingleton( Result ).FRef );
end;
end;
procedure CleanupSingletons;
var
i: integer;
begin
if Singletons <> nil then
begin
for i := Pred(Singletons.Count) downto 0 do
if Assigned(Singletons.Objects[i]) then
Singletons.Objects[i].Free;
Singletons.Free;
end;
end;
initialization
finalization
CleanupSingletons;
end.
|
|
| Back to top |
|
|
Ralf Mimoun
Guest
|
| Posted: Sun Dec 04, 2005 12:20 pm Post subject: Re: Singleton TDataModule |
|
|
Marc,
Marc Rohloff [TeamB]" <"on request wrote:
....
| Quote: | It might help if you post the code of your implementation.
|
It's the code from Lucian Radulescu that Danny posted, I only changed
TObject to TDataModule.
Ralf
|
|
| Back to top |
|
|
danny heijl
Guest
|
| Posted: Mon Dec 05, 2005 7:51 am Post subject: Re: Singleton TDataModule |
|
|
Ralf Mimoun schreef:
| Quote: | It's the code from Lucian Radulescu that Danny posted, I only changed
TObject to TDataModule.
|
The original code crashed at shutdown because list entries were getting
deleted from top to bottom, so this change is necessary:
procedure CleanupSingletons;
var
i: integer;
begin
if Singletons <> nil then
begin
for i := Pred(Singletons.Count) downto 0 do // downto!!
if Assigned(Singletons.Objects[i]) then
Singletons.Objects[i].Free;
Singletons.Free;
end;
end;
Danny
---
|
|
| Back to top |
|
|
Marc Rohloff [TeamB]
Guest
|
| Posted: Mon Dec 05, 2005 4:20 pm Post subject: Re: Singleton TDataModule |
|
|
"Ralf Mimoun" <nospam (AT) rad-on (DOT) de> wrote:
| Quote: | but nonetheless I get an exception after calling .Create
the second time that a component of the class of my datamodule exists.
|
This is because whatever you pass as the owner for your datamodule gets the datamodule added twice to its list of components and there is aname conflict, just like you can't add two buttons called 'Button1' to a form.
There are two solutions
1) Pass 'nil' as the owner to your Create call
2) Clear the data module's name property:
TSingleton = class(TDataModule)
protected
procedure Loaded; override;
end;
procedure TSingleton.Loaded;
begin
inherited;
Name := '';
end;
If you clear the name however dynamic name resolution will no longer work.
--
Marc Rohloff [TeamB]
|
|
| Back to top |
|
|
Ralf Mimoun
Guest
|
| Posted: Tue Dec 06, 2005 1:10 am Post subject: Re: Singleton TDataModule |
|
|
Marc Rohloff [TeamB] wrote:
| Quote: | "Ralf Mimoun" <nospam (AT) rad-on (DOT) de> wrote:
but nonetheless I get an exception after calling .Create
the second time that a component of the class of my datamodule
exists.
This is because whatever you pass as the owner for your datamodule
gets the datamodule added twice to its list of components and there
is aname conflict, just like you can't add two buttons called
'Button1' to a form.
|
Arrrgh... thank you very much. I'll try it tomorrow.
Ralf
|
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
