Write a non-visible component that allows only one instance of itself at design time (Views: 27)
Problem/Question/Abstract: How to write a non-visible component that allows only one instance of itself at design time Answer: Adapted singleton class from Borland Comunity. My prototype allows for inheritance, such as: { ... } type {TApplication} TApplication = class(TSingleton) protected procedure InitializeInstance; override; procedure FinalizeInstance; override; end; {TScreen} TScreen = class(TSingleton) protected procedure InitializeInstance; override; procedure FinalizeInstance; override; end; All internal members (data/objects) will be created/ destroyed in InitializeInstance/ FinalizeInstance { ... } var A1, A2: TApplication; S1, S2: TScreen; begin A1 := TApplication.Create; A2 := TApplication.Create; S1 := TScreen.Create; S2 := TScreen.Create; { ... } {Note, my code: A1 = A2 and S1 = S2 and A1 <> S1} A1.Free; A2.Free; S2.Free; S1.Free; end; To optimize the code I would suggest using this approach for creation of objects inheriting from TSingleton: unit singleton; interface uses Classes; type {you can inherit from TSingleton and create different singleton objects} TSingleton = class private FRef: Integer; protected procedure InitializeInstance; virtual; procedure FinalizeInstance; virtual; public class function NewInstance: TObject; override; procedure FreeInstance; override; end; implementation var Singletons: TStringList = nil; procedure TSingleton.FreeInstance; var Index: Integer; Instance: TSingleton; begin Singletons.Find(ClassName, Index); Instance := TSingleton(Singletons.Objects[Index]); Dec(Instance.FRef); if Instance.FRef = 0 then begin Singletons.Delete(Index); Instance.FinalizeInstance; {at this point, Instance = Self. We want to call TObject.FreeInstance} inherited FreeInstance; end; end; procedure TSingleton.FinalizeInstance; begin end; procedure TSingleton.InitializeInstance; begin end; class function TSingleton.NewInstance: TObject; var Index: Integer; begin if Singletons = nil then begin Singletons := TStringList.Create; Singletons.Sorted := true; Singletons.Duplicates := dupError; end; if not Singletons.Find(ClassName, Index) then begin Result := inherited NewInstance; TSingleton(Result).FRef := 1; TSingleton(Result).InitializeInstance; Singletons.AddObject(ClassName, Result); end else begin Result := Singletons.Objects[Index]; Inc(TSingleton(Result).FRef); end; end; procedure CleanupSingletons; var i: integer; begin if Singletons <> nil then begin for i := 0 to Pred(Singletons.Count) do if Assigned(Singletons.Objects[i]) then Singletons.Objects[i].Free; Singletons.Free; end; end; initialization finalization CleanupSingletons; end. |