Форум: "Потрепаться";
Текущий архив: 2002.09.09;
Скачать: [xml.tar.bz2];

Вниз

SINGLE TONE   Найти похожие ветки 

← →
J_S   (2002-08-14 14:04) [0]

Как запретить порождение второй переменной такого же типа без проверок типа: If List is TStringList then...?
Т.е. имеецца ли какая либо директива или еще что-то вроде этого для таких целей?

---

← →
MBo   (2002-08-14 14:13) [1]

не совсем понятно: либо надо проверять на nil (или Assigned), либо сделать свой Singleton-класс?

---

← →
J_S   (2002-08-14 14:39) [2]

Скорее сделать Singletone-класс.

---

← →
MBo   (2002-08-14 14:43) [3]

в implementation модуля с классом заводишь счетчик
var ObjCount:Integer=0; (можно и Boolean)

в конструкторе объекта делаешь, например
if ObjCount=0 then
Inc(ObjCount)
else
Raise;

в деструкторе
Dec(ObjCount)

---

← →
vuk   (2002-08-14 14:57) [4]

to MBo:
Оно конечно да... Только вот здесь все зависит от желаемой логики работы. В Вашем случае просто не создастся второй экземпляр и конструктор просто ничего не вернет. Можно сделать хитрее - чтобы конструктор всегда возвращал экземпляр уже существующего экземпляра (если он есть). Делается через перекрытие NewInstance.

---

← →
Игорь Шевченко   (2002-08-14 14:58) [5]

Я бы сделал функцию, возвращающую ссылку на объект данного класса и внутреннюю переменную...Если объекта нет, то он создается и возвращается, если есть, то просто возвращается. Или метод класса: class function GetInstance : TMyObject

---

← →
Alx2   (2002-08-14 15:05) [6]

А начало ветки разноцветней светофора :)

---

← →
J_S   (2002-08-14 17:13) [7]

2vuk,Игорь Шевченко:
Можно несколько подробнее?..

---

← →
MBo   (2002-08-14 17:14) [8]

>J_S
Растолкуй задачу поподробнее

---

← →
McSimm   (2002-08-14 17:18) [9]

Например, как это сделано в модуле Printers :

var
FPrinter: TPrinter = nil;
....
function Printer: TPrinter;
begin
if FPrinter = nil then FPrinter := TPrinter.Create;
Result := FPrinter;
end;

---

← →
Игорь Шевченко   (2002-08-14 17:27) [10]

J_S © (14.08.02 17:13)

Хотелось бы узнать подробнее про задачу

---

← →
vuk   (2002-08-14 17:49) [11]

>чтобы конструктор всегда возвращал экземпляр уже существующего
>экземпляра (если он есть).
Блин! Это у меня масло масленое маслом получилось. :o) На самом деле следует читать так:

чтобы конструктор всегда возвращал ссылку на уже существующий
экземпляра (если он есть).
На самом деле тот метод, что предложил Игорь Шевченко, скорее всего, более правильный. То о чем писал я - это скорее эксперимент по изменению стандартного поведения конструктора. Тем не менее эксперимент по такому созданию синглетона можно считать удачным. :o)
Схема действий примерно такая:

program TrueSingleton;
{$APPTYPE CONSOLE}
uses SysUtils;

type
TSingletonObject = class(TObject)
protected
FInitialized : boolean;
FTestProp: string;
public
class function NewInstance: TObject; override;

constructor Create;
destructor Destroy; override;

property TestProp : string read FTestProp write FTestProp;
end;

var
FSingletonInstance : TSingletonObject = nil;
{ TSingletonClass }

constructor TSingletonObject.Create;
begin
inherited Create;
if not FInitialized then
begin
TestProp := "New Singleton";
FInitialized := true;
end;
end;

destructor TSingletonObject.Destroy;
begin
inherited Destroy;
FSingletonInstance := nil;
end;

class function TSingletonObject.NewInstance: TObject;
begin
if FsingletonInstance = nil then
begin
Result := inherited NewInstance;
FSingletonInstance := TSingletonObject(Result);
end else
Result := FSingletonInstance;
end;

var
s, s1 : TSingletonObject;
begin
s := TSingletonObject.Create;
s.TestProp := "New Value";
s1 := TSingletonObject.Create;
writeln( s1.TestProp );
readln;
end.


---

← →
Юрий Зотов   (2002-08-14 21:51) [12]

Осмелюсь предложить несколько иную реализацию той же идеи, на мой взгляд, более простую, экономную и удобную.

Итак, глобальный объект TMyObject:
1. Может быть создан как обычным вызовом конструктора, так и вызовом функции MyObject.
2. Допускает свое уничтожение и последующее пересоздание произвольное число раз.
3. Может либо не существовать вообще, либо существовать лишь в единственном экземпляре - независимо от способа и количества попыток его создания.
4. Не создается до первого обращения к себе а при первом вызове функции MyObject (самом первом, или первом после уничтожения - неважно) создается автоматически.
5. Автоматически уничтожается при выгрузке своего модуля.
6. Не содержит никаких дополнительных полей для поддержки всей этой функциональности.

Короче говоря, с ним можно работать, как с Clipboard - просто писать MyObject везде, где нужно, и больше ни о чем не думать.

============== Модуль самого объекта ==============


unit Unit2;

interface

type
TMyObject = class(TObject)
public
class function NewInstance: TObject; override;
procedure FreeInstance; override;
end;

function MyObject: TMyObject;

implementation

var
_MyObject: TMyObject = nil;

function MyObject: TMyObject;
begin
Result := TMyObject.Create
end;

{ TMyObject }

procedure TMyObject.FreeInstance;
begin
_MyObject := nil;
inherited
end;

class function TMyObject.NewInstance: TObject;
begin
if _MyObject = nil then
begin
Result := inherited NewInstance;
_MyObject := TMyObject(Result)
end
else Result := _MyObject
end;

initialization
finalization
_MyObject.Free
end.


============== Тестирующая форма ==============


type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.Add(IntToStr(Integer(TMyObject.Create)))
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ListBox1.Items.Add(IntToStr(Integer(MyObject)))
end;


---

← →
vuk   (2002-08-14 22:06) [13]

to Юрий Зотов:
То что я писал, я восстанавливал по памяти и основной целью было показать суть подхода. Когда я делал подобную реализацию первый раз у меня и было что-то подобное. Правда там заодно была решена еще одна проблемка. С наследованием. Если создается наследник подобного класса, то логично было бы, чтобы наследник тоже мог создаваться один раз, но подсчет количества его экземпляров проводился отдельно. Для этого достаточно созданный экземпляр хранить не в переменной, а в StringList, где String-имя класса, а Object - созданный экземпляр.

---

← →
MrBeer   (2002-08-14 23:35) [14]

Nebolshoe zamechanie - u singleton konstruktor obichno kladut v protected chastj.

---

← →
Юрий Зотов   (2002-08-14 23:44) [15]

> Если создается наследник подобного класса, то логично было бы,
> чтобы наследник тоже мог создаваться один раз,

Это зависит от задачи. Не менее логично может быть, чтобы любой экземпляр, удовлетворяющий условию "is TMyObject" (хоть сам этот класс, хоть его потомок) мог быть создан только один раз. Тогда список как раз не нужен и приведенный модуль Unit2 полностью решает такую задачу.

Немного изменим модуль тестирующей формы:


unit Unit1;

interface

uses
SysUtils, Classes, Controls, Forms, StdCtrls, Unit2;

type
TMyObjectChild = class(TMyObject)
private
FAddress: pointer;
public
constructor Create;
end;

TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

{ TMyObjectChild }

constructor TMyObjectChild.Create;
begin
inherited;
FAddress := Self
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.Add(IntToStr(Integer(MyObject)))
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ListBox1.Items.Add(IntToStr(Integer(TMyObjectChild.Create.FAddress)))
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Caption := MyObject.ClassName
end;

end.


Нажимаем Button1, затем Button3 (или просто Button3). Получаем - TMyObject. Далее, сколько ни нажимай Button2, объект класса TMyObjectСhild создан не будет.

Перезапускаем программу и нажимаем Button2, затем Button3. Получаем - TMyObjectСhild. Далее, сколько ни нажимай Button1, объект класса TMyObject тоже создан не будет.

---

← →
Юрий Зотов   (2002-08-14 23:53) [16]

> u singleton konstruktor obichno kladut v protected chastj

Зачем? Понизить видимость все равно не удастся, только получим лишнее замечание компилятора. Да в этой задаче и не нужно вовсе замещать никакой конструктор - он же может быть и статическим, а тогда недалеко и до проблем. Есть виртуальный NewInstance - самое то, что нужно.

---

← →
MrBeer   (2002-08-15 02:23) [17]

>Понизить видимость все равно не удастся, только получим лишнее >замечание компилятора.

Ya smotrel eto na C++. Ponizitj vidimost" deistvitelno ne udayotsja (hotya v hint-e konstruktor bolshe ne pokazivaetsja).

P.S. Schitaju chto esli nuzhen singleton to ne nado davatj useru vizivatj konstruktor => nado ponizitj vidimostj. Zhalj chto delphi eto ne pozvolyaet.

---

← →
MrBeer   (2002-08-15 02:23) [18]

P.S. D5 compiler zamechanie ne delaet.

---

← →
Юрий Зотов   (2002-08-15 02:36) [19]

> ne nado davatj useru vizivatj konstruktor

Замещаем NewInstance - и пусть вызывает конструктор, сколько ему захочется. Пусть хоть обвызывается - все равно будет один экземпляр.


> D5 compiler zamechanie ne delaet.

Проверил. Для статического конструктора (потомок TObject) - точно, не делает. А для виртуального (потомок TComponent) - делает.

---

Страницы: 1 вся ветка

Форум: "Потрепаться";
Текущий архив: 2002.09.09;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.5 MB
Время: 0.007 c