ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Forum AtoutFox : SingletonPattern : Re: OLE IDispatch 901   

Sujet

rss Flux RSS des derniers messages

Vous devez vous identifier pour pouvoir poser une question ou répondre.

jeu. 20 août 2015, 19h27
eddymaue
atoutfox.public.association

SingletonPattern : Re: OLE IDispatch 901

* SingletonPattern
* Clase para la implementacion del pattern Singleton en VFP
*
* Autor: Victor Espina
* Fecha: Abril 2012
*
* Uso:
* Para la implementacion de esta clase se requiere definir dos clases
* a) Una clase basada en SingletonPattern
* b) La clase real que se desea implementar como Singleton, la cual
puede
* estar basada en cualquier clase base o subclase.
*
* Ejemplo:
* Supongamos que tenemos una clase llamada AppContextClass que queremos
* implementar como singleton. Lo unico que se debe hacer es declarar
* una clase basada en SingletonPattern y configurar su propiedad
className:
*
* DEFINE CLASS appContext AS SingletonPattern
* className = "appContextClass"
* ENDDEFINE
*
* Luego, cuando se desee crear una instancia de AppContextClass, se
hace:
*
* oSingletonInstance = CREATE("appContext")
*
* Y se lograra el efecto de que todas las instancias de appContext
apuntaran a
* una unica instancia de appContextClass.
*
*
DEFINE CLASS SingletonPattern AS Custom
*
className = ""

* Constructor
* El parametro plInstance es utilizado por el metodo createInstance()
en el caso
* de que la clase real sea una subclase de SingletonPattern, para
indicar que se
* debe crear la instancia directamente
PROCEDURE Init(plInstanceMode)
IF plInstanceMode
RETURN
ENDIF
IF EMPTY(THIS.className) && Si no se indica una clase real se
asume
THIS.className = THIS.Class && esta misma clase
ENDIF
IF NOT THIS.checkInstance() && Se verifica si ya existe una
instancia de
THIS.createInstance() && la clase. Si no es si, se crea
ENDIF
ENDPROC

* checkInstance
* Determina si ya existe una instancia creada para la clase real
PROCEDURE checkInstance
IF NOT ISNULL(THIS.getInstance()) && Si podemos obtener una
referencia a la instancia
RETURN .T. && es porque la misma existe
ENDIF
IF !PEMSTATUS(_Screen,THIS.className, 5) && Si no existe la
propiedad asociada a la clase
_Screen.addProperty(THIS.className, NULL) && en _Screen, se crea
ENDIF
RETURN .F.
ENDPROC

* createInstance
* Crea una instancia de la clase real
PROCEDURE createInstance
LOCAL oInstance
IF LOWER(THIS.Class) == LOWER(THIS.className) && La clase real es
una subclase directa de SingletonPattern ?
oInstance = CREATE(THIS.className, .T.)
ELSE
oInstance = CREATE(THIS.className)
ENDIF
STORE oInstance TO ("_Screen." + THIS.className)
ENDPROC

* getInstance
* Devuelve una referencia a la instancia unica de la clase real
PROCEDURE getInstance
IF !PEMSTATUS(_Screen,THIS.ClassName,5) OR TYPE("_Screen." +
THIS.className)<>"O"
RETURN NULL
ENDIF
RETURN EVAL("_Screen." + THIS.className)
ENDPROC

* releaseInstance
* Libera la instancia unica de la clase real
PROCEDURE releaseInstance
IF THIS.checkInstance()
STORE NULL TO ("_Screen." + THIS.className)
ENDIF
ENDPROC

* Accesor para la propiedad THIS
* Este accesor decide si devuelve una referencia al controlador
Singleton o a la clase real
PROCEDURE THIS_Access(cMember)
IF
INLIST(LOWER(cMember),"classname","checkinstance","createinstance","getinstance","class")
RETURN THIS
ELSE
RETURN EVAL("_Screen." + THIS.className)
ENDIF
ENDPROC
*
ENDDEFINE

--
Merci de partager avec moi votre immense savoir que je me ferai plaisir
d'absorber...
il va de soi que je vais vous en laisser un peu
Politesse et savoir vivre oblige ;0)
Permalink : http://www.atoutfox.org/nntp.asp?ID=0000016664
20 088 messages dans le forum • Liste complète des messages

Publicité

Les pubs en cours :


www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2024.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3