| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Как подавить создание компонента [D6, Win2k]
Другой Дмитрий © (2005-05-13 09:18:00)Мой компонент должен быть в приложении один.
При его создании в конструкторе проверяю глобальную переменную.
Если она nil, то присваиваю ей self. А вот если она не nil? А вот если она не nil, то компонент не должен создаваться вообще.
Как это можно реализовать?
Igorek (2005-05-13 23:44:00) [1]Юрий Зотов © (13.05.05 14:25) [13]
С компонентом они возникают - но элементарно устраняются перекрытием SetName.
Мне не удалось решить это перекрытием SetName.
Style © (13.05.05 14:03) [10]
А с помощью RegisterClass хотел наоборот обойти ииспользование глобальной переменной, ну ни люблю я их 8).. а не получилось...
type
TMyComp = class(TComponent)
class function NewInstance: TObject; override;
procedure FreeInstance; override;
end;
implementation
type
// ['{70904F4E-3682-460B-9C1B-C02DC85620E9}'] - генерим гуид (Ctrl+Shift+G) :)))
T70904F4E3682460B9C1BC02DC85620E9 //убираем минусы и добавляем T
= class(TPersistent)end;
TDummy = T70904F4E3682460B9C1BC02DC85620E9;
class function TMyComp.NewInstance: TObject;
begin
if (GetClass(TDummy.ClassName) = nil) then
begin
RegisterClass(TPersistentClass(TDummy));
Result := inherited NewInstance;
end
else
raise Exception.Create(Format('Уже есть %s', [ClassName]));
end;
procedure TMyComp.FreeInstance;
begin
UnRegisterClass(TPersistentClass(TDummy));
inherited;
end;
procedure Register;
begin
RegisterComponents('!test', [TMyComp]);
end;
Style (2005-05-13 16:56:00) [2]
> В run-time нет автоматической регистрации класса и назначения
> Name.
Вот потому и про Name не я задумывался...
Юрий Зотов (2005-05-13 16:27:00) [3]> Style © (13.05.05 16:13) [26]
> и особой разницы не вижу...
В run-time нет автоматической регистрации класса и назначения Name.
Style (2005-05-13 16:13:00) [4]>>Уже обсуждалось (см. [8], [9] и [13]). Придется перекрывать еще и SetName.
А, ну понял, Извеняюсь... Я просто в RunTime пытаюсь этот класс использовать и особой разницы не вижу...
Юрий Зотов (2005-05-13 16:06:00) [5]> Style © (13.05.05 15:59) [24]
Уже обсуждалось (см. [8], [9] и [13]). Придется перекрывать еще и SetName.
Style (2005-05-13 15:59:00) [6]>>Именно так. Что и требовалось.
class function TdmSingleton.NewInstance: TObject;
begin
if(not Assigned(p)) then
begin
Result := Inherited NewInstance;
end
else
result := p;
end;
Просто мне кажеться что лучше проверить на nil чем
выделять и освобождать память.
Юрий Зотов (2005-05-13 15:52:00) [7]> Style © (13.05.05 15:47) [22]
> NewInstance будет все равно выполнен, и затем выполнится
> FreeInstance потому что был вызван Exception в конструкторе.
Именно так. Что и требовалось.
Style (2005-05-13 15:47:00) [8]2 Другой Дмитрий [21]
О, точно молодец...
2 ЮЗ
>>В VCL такого полно
Я просто предположил... Действительно перед каждым raise ComponentState не проверят.
>> constructor TMyComp.Create(AOwner: TComponent);
>> begin
>> inherited;
>> if Comp = nil then
>> Comp := Self
>> else
>> raise Exception.Create('Already exists')
>> end;
>>
Юрий, а так NewInstance будет все равно выполнен, и затем выполнится FreeInstance потому что был вызван Exception в конструкторе...
Другой Дмитрий (2005-05-13 15:15:00) [9]Кстати у меня AV было потому что в деструкторе не присваивал MyGlobalComp:=nil. Всем спасибо. Завожу новую тему.
Другой Дмитрий (2005-05-13 15:07:00) [10]Style © (13.05.05 14:51) [17]
Я так понимаю в DesignTime не желательно делать raise...
попробуй следующее...
Так лучше. Теперь осталась одна проблема:
при повторном помещении компонента на форму dmSingleton1 переименовывается в dmSingleton2, если еще раз положить то dmSingleton2 переименовывается в dmSingleton1 и т.д.
Юрий Зотов © (13.05.05 15:00) [18]
Вот нормалньно работающее решение:
Так попробовал работает без замечаний!
Юрий Зотов (2005-05-13 15:02:00) [11]> Style © (13.05.05 14:51) [17]
> Я так понимаю в DesignTime не желательно делать raise...
Без проблем. В VCL такого полно.
Юрий Зотов (2005-05-13 15:00:00) [12]Вот нормалньно работающее решение:
type
TMyComp = class(TComponent)
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
implementation
var
Comp: TMyComp;
{ TMyComp }
constructor TMyComp.Create(AOwner: TComponent);
begin
inherited;
if Comp = nil then
Comp := Self
else
raise Exception.Create('Already exists')
end;
destructor TMyComp.Destroy;
begin
if Comp = Self then
Comp := nil;
inherited
end;
Style (2005-05-13 14:51:00) [13]Я так понимаю в DesignTime не желательно делать raise...
попробуй следующее...
constructor TdmSingleton.Create(AOwner: TComponent);
begin
if p = nil then
begin
inherited;
p := self;
end
else
if not (csDesigning in ComponentState) then
raise Exception.Create('Уже есть')
else
MessageBox(0, pchar('Уже есть'), 'Ошибка', 0);
end;
Style (2005-05-13 14:46:00) [14]>>2. В данном случае глобальная переменная занимает 4 байта. >>Код вызова RegisterClass, нескольких вызовов GetClass и >>проверок на nil наверняка займет гораздо больше, да и >>работать будет медленнее - поэтому никаких преимуществ это >>решение не дает. А раз так, то и нет смысла усложнять код.
Вспомнил, вообще я пытался сделать следующее. Хотелось бы что бы наследники TdmSingleton не падали в Exception. т.е. класс - является синглетоном по своему имени... А наследник TdmApplication = class(TdmSingleton) - имеет другое имя. Поэтому один экземпляр создать можно.
Наверное надо будет лучше создать Глобальный TStringList. И написать свои методы AddClassObject, GetClassObject...
Другой Дмитрий (2005-05-13 14:42:00) [15]Style © (13.05.05 14:14) [12]
У меня без AV работает
Создал новые run-time и design-time пакеты.
Внес туда предложенный код, исправил только TdmRoot на TComponent. Зарегистрировал.
Помещаю компонент на форму, запускаю. Все о'к.
Помещаю второй компонент - вылетает 'Уже есть'. После нажатия на ОК - первый компонент исчезает. При попытке добавить новый - Ошибка 'Privileged instruction' а иногда AV.
Мож у меня чего с самой Delphi не так?
Юрий Зотов (2005-05-13 14:33:00) [16]> Style © (13.05.05 14:03) [10]
> с помощью RegisterClass хотел наоборот обойти ииспользование
> глобальной переменной, ну ни люблю я их
1. Если унести глобальную переменную в секцию implementation, то она становится безопасной. Это вполне нормальное решение.
2. В данном случае глобальная переменная занимает 4 байта. Код вызова RegisterClass, нескольких вызовов GetClass и проверок на nil наверняка займет гораздо больше, да и работать будет медленнее - поэтому никаких преимуществ это решение не дает. А раз так, то и нет смысла усложнять код.
Юрий Зотов (2005-05-13 14:25:00) [17]> Igorek © (13.05.05 12:56) [9]
> Трудно представить, когда такое надо - слишком неочевидное
> поведение IDE (без сообщения в данном случае).
Мне тоже. Но всяко бывает, может, когда-то это и надо.
> возникнут проблемы с дублированием имени компонента.
Действительно, возникают. Я использовал этот механизм для некомпонентских классов - там, сами понимате, никаких проблем нет. С компонентом они возникают - но элементарно устраняются перекрытием SetName.
Интересно, однако, и то, что вариант [1] для компонента из палитрыне работает совсем. Вероятно, дело в том, что RegisterComponents сама вызывает RegisterClass(es) - после чего, конечно, все проверки GetClass на nil, конечно, становятся в design-time бессмысленными. Проверьте сами [1] и вот это:
type
TMyComp = class(TComponent)
public
constructor Create(AOwner: TComponent); override;
end;
constructor TMyComp.Create(AOwner: TComponent);
begin
inherited;
if GetClass(ClassName) <> nil then
ShowMessage('Registered')
end;
> Другой Дмитрий (13.05.05 09:18)
Вывод из всей этой дискусии - делайте так, как и делали, без лишних заморочек - а чтобы подавить создание второго экземпляра просто возбуждайте Exception в конструкторе, вот и все.
Style (2005-05-13 14:14:00) [18]У меня без AV работает
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DataRoot;
type
TdmSingleton = class(TdmRoot)
private
{ Private declarations }
public
class function NewInstance: TObject; override;
constructor Create(AOwner: TComponent); override;
{ Public declarations }
end;
var
P: pointer;
implementation
uses CommonConst;
{$R *.dfm}
{ TdmSingleton }
constructor TdmSingleton.Create(AOwner: TComponent);
begin
if p = nil then
begin
inherited;
p := self;
end
else
raise Exception.Create('Уже есть');
end;
class function TdmSingleton.NewInstance: TObject;
begin
if(not Assigned(p)) then
begin
Result := Inherited NewInstance;
end
else
result := p;
end;
initialization
p := nil;
Другой Дмитрий (2005-05-13 14:07:00) [19]Пока остановился на коде конструктора
if MyGlobalComp<>nil then raise Exception.Create('Уже есть');
inherited Create(Aowner);
Только не пойму, почему вылетает вместо 'Уже есть' - 'AV in rtl60.bpl'?
Style (2005-05-13 14:03:00) [20]Сорри, немного поторопился не все проверил...
А с помощью RegisterClass хотел наоборот обойти ииспользование глобальной переменной, ну ни люблю я их 8).. а не получилось...
| |
Страницы: 