| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как подавить создание компонента [D6, Win2k]

Страницы:   < 1 2 >

Другой Дмитрий ©   (2005-05-13 09:18:00) 

Мой компонент должен быть в приложении один.
При его создании в конструкторе проверяю глобальную переменную.
Если она nil, то присваиваю ей self. А вот если она не nil? А вот если она не nil, то компонент не должен создаваться вообще.
Как это можно реализовать?

---

Igorek   (2005-05-13 12:56:00) [21]

Юрий Зотов ©   (13.05.05 12:29) [8]
Другое дело, когда надо обойтись без Exception
Трудно представить, когда такое надо - слишком неочевидное поведение IDE (без сообщения в данном случае).
Кроме того при Вашем варианте возникнут проблемы с дублированием имени компонента.

---

Юрий Зотов   (2005-05-13 12:29:00) [22]

Вообще говоря, если NewInstance при попытке повторного создания все равно возбуждает Exception, то все эти навороты ни к чему. Достаточно сделать так, как изначально и делал автор (через глобальную переменную), а при при попытке повторного создания просто возбудить Exception в конструкторе. При этом только что созданный второй экземпляр будет удален автоматически.

Другое дело, когда надо обойтись без Exception - тогда да, тогда нужна связка NewInstance/FreeInstance. Но и здесь вместо регистрации класа можно просто использовать глобальную переменную.

implementation

var
 Singleton: TSingleton;

procedure TSingleton.FreeInstance;
begin
 Singleton := nil;
 Inherited
end;

class function TSingleton.NewInstance: TObject;
begin
 if Singleton = nil then
 begin
   Result := Inherited NewInstance;
   Singleton := TSingleton(Result)
 end
 else
   Result := Singleton
end;


---

Igorek   (2005-05-13 12:15:00) [23]

Другой Дмитрий   (13.05.05 11:55) [6]
См. "Прерывание создания компонента" на http://delphiworld.narod.ru/

---

Другой Дмитрий   (2005-05-13 11:55:00) [24]

Создаешь/удаляешь в секциях инициализации/финализации. В палитру не публикуешь. Будет твой модуль где-то в uses - создастся, иначе нет.

Должен быть в палитре. У него куча свойств с редакторами для настройки приложения.

---

Priest   (2005-05-13 11:48:00) [25]

Что-то у меня в момент запуска выдаёт исключение в строке
RegisterClass( TPersistentClass(ClassType) );

Вот я сделал пример, правда не смог запустить
var
S1,S2:TdmSingleton;
begin
S1:=TdmSingleton.Create;
S2:=TdmSingleton.Create;
S1.Free;
end.

Когда вызывается S1:=TdmSingleton.Create; то всё успешно срабатывает. Когда вызываю S2:=TdmSingleton.Create; то в методе
TdmSingleton.NewInstance создаётся исключение и вызывается деструктор с последующим FreeInstance. Так как экземпляра нет, то и удалять не чего :)). А вот когда сработает строка S1.Free; Вызовится FreeInstance и экземпляр не удалится???

---

Igorek   (2005-05-13 11:38:00) [26]

Другой Дмитрий   (13.05.05 9:18)
Создаешь/удаляешь в секциях инициализации/финализации. В палитру не публикуешь. Будет твой модуль где-то в uses - создастся, иначе нет.

---

Style   (2005-05-13 11:24:00) [27]

>>Нужен чтобы нельзя его выло удалить?

Полагается что он не создан и удалять нечего..

---

Priest   (2005-05-13 11:19:00) [28]

А кусок кода
procedure TdmSingleton.FreeInstance;
begin
if(GetClass(ClassName) = nil) then
begin
  Inherited FreeInstance;
end;
end;

Нужен чтобы нельзя его выло удалить?

---

Style   (2005-05-13 10:43:00) [29]

поищи информацию о синглетонах..
нада копать в сторону классового метода
   class function NewInstance: TObject; override;


 TdmSingleton = class(TdmRoot)
 private
   { Private declarations }
 public
   class function NewInstance: TObject; override;
   procedure FreeInstance; override;

   constructor Create(AOwner: TComponent); override;
   { Public declarations }
 end;

implementation

uses CommonConst;

{$R *.dfm}

{ TdmSingleton }

constructor TdmSingleton.Create(AOwner: TComponent);
begin
 inherited;
 RegisterClass( TPersistentClass(ClassType) );
end;

procedure TdmSingleton.FreeInstance;
begin
 if(GetClass(ClassName) = nil) then
 begin
   Inherited FreeInstance;
 end;
end;

class function TdmSingleton.NewInstance: TObject;
begin
 if(GetClass(ClassName) = nil) then
 begin
   Result := Inherited NewInstance;
 end
 else
   raise Exception.Create(Format(ESingletonClass, [ClassName]));
end;


---

Страницы:   < 1 2 >

Наверх