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

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

Singleton [D5, Win2k]

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

Fktrc ©   (2004-11-23 05:10:00) 

Можно ли в Delphi создать единственный экземпляр класса на все приложение? Т.е. чтобы при попытках создать второй выдавалась либо ошибка компиляции, либо рантайм ошибка. По-моему, такие объекты называют singleton, хотя могу и ошибаться.
Пока приходит в голову только создание какого-л именованного объекта ядра в конструкторе объекта. Но нет ли другого способа, изящнее?

---

Reindeer Moss Eater   (2004-11-23 10:37:00) [41]

Пока приходит в голову только создание какого-л именованного объекта ядра в конструкторе объекта. Но нет ли другого способа, изящнее?

Есть один класс и один его конструктор и один паскалевский модуль в котором все это реализовано. И глобальные переменные модуля на весь процесс.

Какие ядра? Какие пушки?
Есть способ не изящнее, а проще.

---

Amoeba   (2004-11-23 10:33:00) [42]

На сайте "Королевство дельфи" http://www.delphikingdom.comнайдешь статью, специально посвященную этому вопросу.

---

Bel   (2004-11-23 10:30:00) [43]

:)  Только сейчас увидел, что в FreeInstance косяк со счетчиком. Ну да ладно, сам разберешься.

---

Bel   (2004-11-23 10:23:00) [44]

Держи, разбирайся. Когда-то сам копался с этим.

unit uSingleton;

interface

type
  TSingleton = class (TObject)
  private
    FCount: Integer;
  public
    class function NewInstance: TObject; override;
    procedure FreeInstance; override;
    function Test1(SomeText: String): Integer;
    function Test2(SomeText: String): Integer;
  end;

implementation

uses Dialogs, SysUtils;

var
  gSingle: TSingleton;

class function TSingleton.NewInstance: TObject;
begin
  if gSingle <> nil then begin
    Result := gSingle;
    Inc(gSingle.FCount);
  end else begin
    Result := inherited NewInstance;
    gSingle := TSingleton(Result);
    gSingle.FCount := 1;
  end;
end;

procedure TSingleton.FreeInstance;
begin
  if FCount = 0 then begin
    inherited;
    gSingle := nil;
  end else
    Dec(FCount);
end;

function TSingleton.Test1(SomeText: String): Integer;
begin
  ShowMessage(SomeText + ': Test1 adr: ' + IntToStr(Integer(Self)) + ' counter: ' + IntToStr(FCount));
  Result := 1;
end;

function TSingleton.Test2(SomeText: String): Integer;
begin
  ShowMessage(SomeText + ': Test2 adr: ' + IntToStr(Integer(Self)) + ' counter: ' + IntToStr(FCount));
  Result := 2;
end;

end.

---

Fktrc   (2004-11-23 09:53:00) [45]

2Bel
Примерчик перекрытия методов NewInstance и FreeInstance или ссылку на таковой можете дать? А я пока по гуглю и яндексу побегаю...

---

Bel   (2004-11-23 09:45:00) [46]

Можно.
Можно еще вместо ошибки при попытке создания второго экземпляра подменить его уже созданным первым экземпляром. Надо перекрыть методы NewInstance и FreeInstance. Ну, и счетчик ссылок на объект.

---

MBo   (2004-11-23 07:19:00) [47]

Один из путей реализован в модуле ClipBrd для ClipBoard

---

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

Наверх