Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to write a non-visible component that allows only one instance of itself at Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
19-Dec-02
Category
VCL-General
Language
Delphi 2.x
Views
115
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Tomas Rutkauskas

How to write a non-visible component that allows only one instance of itself at 
design time

Answer:

Adapted singleton class from Borland Comunity. My prototype allows for inheritance, 
such as:

1   { ... }
2   type
3     {TApplication}
4     TApplication = class(TSingleton)
5     protected
6       procedure InitializeInstance; override;
7       procedure FinalizeInstance; override;
8     end;
9   
10    {TScreen}
11    TScreen = class(TSingleton)
12    protected
13      procedure InitializeInstance; override;
14      procedure FinalizeInstance; override;
15    end;
16  
17  //All internal members (data/objects) will be created/ destroyed in 
18  InitializeInstance/ FinalizeInstance
19  
20  { ... }
21  var
22    A1, A2: TApplication;
23    S1, S2: TScreen;
24  begin
25    A1 := TApplication.Create;
26    A2 := TApplication.Create;
27    S1 := TScreen.Create;
28    S2 := TScreen.Create;
29    { ... }
30    {Note, my code: A1 = A2 and S1 = S2 and A1 <> S1}
31    A1.Free;
32    A2.Free;
33    S2.Free;
34    S1.Free;
35  end;
36  
37  //To optimize the code I would suggest using this approach for  creation of objects 
38  inheriting from TSingleton:
39  
40  unit singleton;
41  
42  interface
43  
44  uses
45    Classes;
46  
47  type
48    {you can inherit from TSingleton and create different singleton objects}
49    TSingleton = class
50    private
51      FRef: Integer;
52    protected
53      procedure InitializeInstance; virtual;
54      procedure FinalizeInstance; virtual;
55    public
56      class function NewInstance: TObject; override;
57      procedure FreeInstance; override;
58    end;
59  
60  implementation
61  
62  var
63    Singletons: TStringList = nil;
64  
65  procedure TSingleton.FreeInstance;
66  var
67    Index: Integer;
68    Instance: TSingleton;
69  begin
70    Singletons.Find(ClassName, Index);
71    Instance := TSingleton(Singletons.Objects[Index]);
72    Dec(Instance.FRef);
73    if Instance.FRef = 0 then
74    begin
75      Singletons.Delete(Index);
76      Instance.FinalizeInstance;
77      {at this point, Instance = Self. We want to call TObject.FreeInstance}
78      inherited FreeInstance;
79    end;
80  end;
81  
82  procedure TSingleton.FinalizeInstance;
83  begin
84  end;
85  
86  procedure TSingleton.InitializeInstance;
87  begin
88  end;
89  
90  class function TSingleton.NewInstance: TObject;
91  var
92    Index: Integer;
93  begin
94    if Singletons = nil then
95    begin
96      Singletons := TStringList.Create;
97      Singletons.Sorted := true;
98      Singletons.Duplicates := dupError;
99    end;
100   if not Singletons.Find(ClassName, Index) then
101   begin
102     Result := inherited NewInstance;
103     TSingleton(Result).FRef := 1;
104     TSingleton(Result).InitializeInstance;
105     Singletons.AddObject(ClassName, Result);
106   end
107   else
108   begin
109     Result := Singletons.Objects[Index];
110     Inc(TSingleton(Result).FRef);
111   end;
112 end;
113 
114 procedure CleanupSingletons;
115 var
116   i: integer;
117 begin
118   if Singletons <> nil then
119   begin
120     for i := 0 to Pred(Singletons.Count) do
121       if Assigned(Singletons.Objects[i]) then
122         Singletons.Objects[i].Free;
123     Singletons.Free;
124   end;
125 end;
126 
127 initialization
128 
129 finalization
130   CleanupSingletons;
131 
132 end.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC