examples/Delphi/Singlton.pas

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

unit Singlton;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, StPtrns, ExtCtrls;

type
  TSingleData = class(TStSingleton)
    public
    { Public declarations }
     TheData : integer;
end;

type
  TSingletonForm = class(TForm)
    Panel1: TPanel;
    Display1: TEdit;
    CnR1: TButton;
    Set1: TButton;
    CnR2: TButton;
    Display2: TEdit;
    Set2: TButton;
    CnR3: TButton;
    Display3: TEdit;
    Set3: TButton;
    Create1: TButton;
    Create2: TButton;
    Create3: TButton;
    Free1: TButton;
    Free2: TButton;
    Free3: TButton;
    Counter: TEdit;
    Label1: TLabel;
    Ref1: TEdit;
    Ref2: TEdit;
    Ref3: TEdit;
    procedure CnR1Click(Sender: TObject);
    procedure CnR2Click(Sender: TObject);
    procedure CnR3Click(Sender: TObject);
    procedure Set1Click(Sender: TObject);
    procedure Set2Click(Sender: TObject);
    procedure Set3Click(Sender: TObject);
    procedure Create1Click(Sender: TObject);
    procedure Create2Click(Sender: TObject);
    procedure Create3Click(Sender: TObject);
    procedure Free1Click(Sender: TObject);
    procedure Free2Click(Sender: TObject);
    procedure Free3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure UpdateDisplays;
  public
    { Public declarations }
  end;

var
  SingletonForm: TSingletonForm;

implementation
var
  SingleCounter : integer;
  MySingleton1:  TSingleData;
  MySingleton2:  TSingleData;
  MySingleton3:  TSingleData;

{$R *.DFM}


procedure TSingletonForm.CnR1Click(Sender: TObject);
begin
  if (MySingleton1 <> nil) then
    Display1.Text := IntToStr(MySingleton1.TheData);
end;

procedure TSingletonForm.CnR2Click(Sender: TObject);
begin
  if (MySingleton2 <> nil) then
    Display2.Text := IntToStr(MySingleton2.TheData);
end;

procedure TSingletonForm.CnR3Click(Sender: TObject);
begin
  if (MySingleton3 <> nil) then
    Display3.Text := IntToStr(MySingleton3.TheData);
end;

procedure TSingletonForm.Set1Click(Sender: TObject);
begin
  if (MySingleton1 = nil) then
    exit;
  MySingleton1.TheData := Strtoint(Display1.text);
  UpdateDisplays;
end;

procedure TSingletonForm.Set2Click(Sender: TObject);
begin
  if (MySingleton2 = nil) then
    exit;
  MySingleton2.TheData := Strtoint(Display2.text);
  UpdateDisplays;
end;

procedure TSingletonForm.Set3Click(Sender: TObject);
begin
  if (MySingleton3 = nil) then
    exit;
  MySingleton3.TheData := Strtoint(Display3.text);
  UpdateDisplays;
end;

procedure TSingletonForm.Create1Click(Sender: TObject);
begin
  if (MySingleton1 = nil) then begin
    MySingleton1 :=   TSingleData.create;
    SingleCounter := SingleCounter + 1;
    Counter.Text := Inttostr(SingleCounter);
    Display1.Text := IntToStr(MySingleton1.TheData);
    Ref1.Text := 'ref exists';
  end
end;

procedure TSingletonForm.Create2Click(Sender: TObject);
begin
  if (MySingleton2 = nil) then begin
    MySingleton2 :=   TSingleData.create;
    SingleCounter := SingleCounter + 1;
    Counter.Text := Inttostr(SingleCounter);
    Display2.Text := IntToStr(MySingleton2.TheData);
    Ref2.Text := 'ref exists';
  end
end;

procedure TSingletonForm.Create3Click(Sender: TObject);
begin
  if (MySingleton3 = nil) then begin
    MySingleton3 :=   TSingleData.create;
    SingleCounter := SingleCounter + 1;
    Counter.Text := Inttostr(SingleCounter);
    Display3.Text := IntToStr(MySingleton3.TheData);
    Ref3.Text := 'ref exists';
  end
end;

procedure TSingletonForm.Free1Click(Sender: TObject);
begin
  if (MySingleton1 = nil) then
    exit;
  MySingleton1.free;
  MySingleton1 := nil;
  if (SingleCounter > 0) then
    SingleCounter := SingleCounter - 1;
  Counter.Text := Inttostr(SingleCounter);
  Display1.Text := '(empty)';
  Ref1.Text := 'ref is nil';
end;

procedure TSingletonForm.Free2Click(Sender: TObject);
begin
  if (MySingleton2 = nil) then
    exit;
  MySingleton2.free;
  MySingleton2 := nil;
  if (SingleCounter > 0) then
    SingleCounter := SingleCounter - 1;
  Counter.Text := Inttostr(SingleCounter);
  Display2.Text := '(empty)';
  Ref2.Text := 'ref is nil';
end;

procedure TSingletonForm.Free3Click(Sender: TObject);
begin
  if (MySingleton3 = nil) then
    exit;
  MySingleton3.free;
  MySingleton3 := nil;
  if (SingleCounter > 0) then
    SingleCounter := SingleCounter - 1;
  Counter.Text := Inttostr(SingleCounter);
  Display3.Text := '(empty)';
  Ref3.Text := 'ref is nil';
end;

procedure TSingletonForm.FormCreate(Sender: TObject);
begin
  SingleCounter := 0;
end;

procedure TSingletonForm.UpdateDisplays;
begin
  if (MySingleton1 <> nil) then
    Display1.Text := IntToStr(MySingleton1.TheData);
  if (MySingleton2 <> nil) then
    Display2.Text := IntToStr(MySingleton2.TheData);
  if (MySingleton3 <> nil) then
    Display3.Text := IntToStr(MySingleton3.TheData);
end;

end.
1	torben	2671	(* *** BEGIN LICENSE BLOCK ***
2			* Version: MPL 1.1
3			*
4			* The contents of this file are subject to the Mozilla Public License Version
5			* 1.1 (the "License"); you may not use this file except in compliance with
6			* the License. You may obtain a copy of the License at
7			* http://www.mozilla.org/MPL/
8			*
9			* Software distributed under the License is distributed on an "AS IS" basis,
10			* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
11			* for the specific language governing rights and limitations under the
12			* License.
13			*
14			* The Original Code is TurboPower SysTools
15			*
16			* The Initial Developer of the Original Code is
17			* TurboPower Software
18			*
19			* Portions created by the Initial Developer are Copyright (C) 1996-2002
20			* the Initial Developer. All Rights Reserved.
21			*
22			* Contributor(s):
23			*
24			* *** END LICENSE BLOCK *** *)
25
26			unit Singlton;
27
28			interface
29
30			uses
31			Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
32			StdCtrls, StPtrns, ExtCtrls;
33
34			type
35			TSingleData = class(TStSingleton)
36			public
37			{ Public declarations }
38			TheData : integer;
39			end;
40
41			type
42			TSingletonForm = class(TForm)
43			Panel1: TPanel;
44			Display1: TEdit;
45			CnR1: TButton;
46			Set1: TButton;
47			CnR2: TButton;
48			Display2: TEdit;
49			Set2: TButton;
50			CnR3: TButton;
51			Display3: TEdit;
52			Set3: TButton;
53			Create1: TButton;
54			Create2: TButton;
55			Create3: TButton;
56			Free1: TButton;
57			Free2: TButton;
58			Free3: TButton;
59			Counter: TEdit;
60			Label1: TLabel;
61			Ref1: TEdit;
62			Ref2: TEdit;
63			Ref3: TEdit;
64			procedure CnR1Click(Sender: TObject);
65			procedure CnR2Click(Sender: TObject);
66			procedure CnR3Click(Sender: TObject);
67			procedure Set1Click(Sender: TObject);
68			procedure Set2Click(Sender: TObject);
69			procedure Set3Click(Sender: TObject);
70			procedure Create1Click(Sender: TObject);
71			procedure Create2Click(Sender: TObject);
72			procedure Create3Click(Sender: TObject);
73			procedure Free1Click(Sender: TObject);
74			procedure Free2Click(Sender: TObject);
75			procedure Free3Click(Sender: TObject);
76			procedure FormCreate(Sender: TObject);
77			private
78			{ Private declarations }
79			procedure UpdateDisplays;
80			public
81			{ Public declarations }
82			end;
83
84			var
85			SingletonForm: TSingletonForm;
86
87			implementation
88			var
89			SingleCounter : integer;
90			MySingleton1: TSingleData;
91			MySingleton2: TSingleData;
92			MySingleton3: TSingleData;
93
94			{$R *.DFM}
95
96
97
98			procedure TSingletonForm.CnR1Click(Sender: TObject);
99			begin
100			if (MySingleton1 <> nil) then
101			Display1.Text := IntToStr(MySingleton1.TheData);
102			end;
103
104			procedure TSingletonForm.CnR2Click(Sender: TObject);
105			begin
106			if (MySingleton2 <> nil) then
107			Display2.Text := IntToStr(MySingleton2.TheData);
108			end;
109
110			procedure TSingletonForm.CnR3Click(Sender: TObject);
111			begin
112			if (MySingleton3 <> nil) then
113			Display3.Text := IntToStr(MySingleton3.TheData);
114			end;
115
116			procedure TSingletonForm.Set1Click(Sender: TObject);
117			begin
118			if (MySingleton1 = nil) then
119			exit;
120			MySingleton1.TheData := Strtoint(Display1.text);
121			UpdateDisplays;
122			end;
123
124			procedure TSingletonForm.Set2Click(Sender: TObject);
125			begin
126			if (MySingleton2 = nil) then
127			exit;
128			MySingleton2.TheData := Strtoint(Display2.text);
129			UpdateDisplays;
130			end;
131
132			procedure TSingletonForm.Set3Click(Sender: TObject);
133			begin
134			if (MySingleton3 = nil) then
135			exit;
136			MySingleton3.TheData := Strtoint(Display3.text);
137			UpdateDisplays;
138			end;
139
140			procedure TSingletonForm.Create1Click(Sender: TObject);
141			begin
142			if (MySingleton1 = nil) then begin
143			MySingleton1 := TSingleData.create;
144			SingleCounter := SingleCounter + 1;
145			Counter.Text := Inttostr(SingleCounter);
146			Display1.Text := IntToStr(MySingleton1.TheData);
147			Ref1.Text := 'ref exists';
148			end
149			end;
150
151			procedure TSingletonForm.Create2Click(Sender: TObject);
152			begin
153			if (MySingleton2 = nil) then begin
154			MySingleton2 := TSingleData.create;
155			SingleCounter := SingleCounter + 1;
156			Counter.Text := Inttostr(SingleCounter);
157			Display2.Text := IntToStr(MySingleton2.TheData);
158			Ref2.Text := 'ref exists';
159			end
160			end;
161
162			procedure TSingletonForm.Create3Click(Sender: TObject);
163			begin
164			if (MySingleton3 = nil) then begin
165			MySingleton3 := TSingleData.create;
166			SingleCounter := SingleCounter + 1;
167			Counter.Text := Inttostr(SingleCounter);
168			Display3.Text := IntToStr(MySingleton3.TheData);
169			Ref3.Text := 'ref exists';
170			end
171			end;
172
173			procedure TSingletonForm.Free1Click(Sender: TObject);
174			begin
175			if (MySingleton1 = nil) then
176			exit;
177			MySingleton1.free;
178			MySingleton1 := nil;
179			if (SingleCounter > 0) then
180			SingleCounter := SingleCounter - 1;
181			Counter.Text := Inttostr(SingleCounter);
182			Display1.Text := '(empty)';
183			Ref1.Text := 'ref is nil';
184			end;
185
186			procedure TSingletonForm.Free2Click(Sender: TObject);
187			begin
188			if (MySingleton2 = nil) then
189			exit;
190			MySingleton2.free;
191			MySingleton2 := nil;
192			if (SingleCounter > 0) then
193			SingleCounter := SingleCounter - 1;
194			Counter.Text := Inttostr(SingleCounter);
195			Display2.Text := '(empty)';
196			Ref2.Text := 'ref is nil';
197			end;
198
199			procedure TSingletonForm.Free3Click(Sender: TObject);
200			begin
201			if (MySingleton3 = nil) then
202			exit;
203			MySingleton3.free;
204			MySingleton3 := nil;
205			if (SingleCounter > 0) then
206			SingleCounter := SingleCounter - 1;
207			Counter.Text := Inttostr(SingleCounter);
208			Display3.Text := '(empty)';
209			Ref3.Text := 'ref is nil';
210			end;
211
212			procedure TSingletonForm.FormCreate(Sender: TObject);
213			begin
214			SingleCounter := 0;
215			end;
216
217			procedure TSingletonForm.UpdateDisplays;
218			begin
219			if (MySingleton1 <> nil) then
220			Display1.Text := IntToStr(MySingleton1.TheData);
221			if (MySingleton2 <> nil) then
222			Display2.Text := IntToStr(MySingleton2.TheData);
223			if (MySingleton3 <> nil) then
224			Display3.Text := IntToStr(MySingleton3.TheData);
225			end;
226
227			end.