Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
VFP Collection
Message
 
Information générale
Forum:
Visual FoxPro
Catégorie:
Programmation Orientée Object
Titre:
Divers
Thread ID:
00502866
Message ID:
00502906
Vues:
15
Hi!

Look to Files section here for my class with collection property. Maybe it will be interesting for you.

You cannot prevent the single step of the loop for empty array in VFP, just because empty array in VFP is, anyway, an array with 1 element. You can, however, raise an error in case you try to use FOR EACH loop over an empty array, that will give programmers better errors tracking to avoid places where loop over an empty VFP collection is attempted.

>I wanted a collection object that could work with a FOR/EACH and got it to work in a way. I got it to work if at least one member was added. I did this by creating a second array that holds the names of the members while the collection itself is single dimensioned and holds just the object members. However it still executes once even if the collection is length 0. See the code below. (Please note many defensive coding techniques and other prudent lines of code have not been added yet :o)
>
>My questions are:
>1. No way to skip the execution of a VFP collection like VB, XMLDom with zero based lengths since VFP's arrays must be a length of 1?
>2. Maybe a bug in 7 I don't know but when several objects were added to the collection only one shows up in the locals window.
>3. No matter what I tried, I could not get shortcuts to collection members working. That is for instance instead of MyObject.oCollection.Items(1) or .Items("My Member") I could not shortcut it without Items. Anyone know if it's possible?
>
>CLEAR all
>RELEASE all
>SET asserts on
>
>LOCAL o
>o = CREATEOBJECT("msxml.domdocument")
>o.loadXML('')
>MESSAGEBOX(o.xml)
>FOR EACH oNode IN o.DocumentElement.ChildNodes
>   MESSAGEBOX("This doesn't execute")
>ENDFOR
>
>o = CREATEOBJECT("collection")
>o.AddItem("My Own ClAsa", "myclass", "myclass.prg")
>o.AddItem("MSXMLDOM", "msxml.domdocument")
>o.AddItem("MY chEcKbox", "checkbox")
>
>LOCAL i
>i = 0
>FOR each oItem IN o.Items
>	i = i + 1
>	IF PEMSTATUS(oItem,"Name",5)
>		MESSAGEBOX("Item " + ALLTRIM(STR(i)) + " " + oItem.Name)
>	ELSE
>		MESSAGEBOX("COM object")
>	ENDIF
>ENDFOR
>
>FOR i = 1 TO o.Length
>	IF PEMSTATUS(o.Items(i),"Name",5)
>		MESSAGEBOX("Item " + ALLTRIM(STR(i)) + " " + o.Items(i).Name)
>	ELSE
>		MESSAGEBOX("COM object")
>	ENDIF
>ENDFOR
>
>o.CaseSensitive = .T.
>
>LOCAL lcName
>lcName = IIF(NOT ISNULL(o.Items("my checCKBOX")),;
>	o.Items("my checCKBOX").Name,"Object is NULL")
>MESSAGEBOX("access a memeber with case sensitivity on with wrong case" ;
>	+ CHR(13) + "Name = " + lcName)
>lcName = IIF(NOT ISNULL(o.Items("MY chEcKbox")),;
>	o.Items("MY chEcKbox").Name,"Object is NULL")
>MESSAGEBOX("access a memeber with case sensitivity on with correct case" ;
>	+ CHR(13) + "Name = " + lcName)
>
>MESSAGEBOX("remove item with wrong case with case sensitive on")
>o.RemoveItem("my cheCKBOX")
>MESSAGEBOX("o.Length="+ALLTRIM(STR(o.Length)))
>
>MESSAGEBOX("remove item with correct case with case sensitive on")
>o.RemoveItem("MY chEcKbox")
>MESSAGEBOX("o.Length="+ALLTRIM(STR(o.Length)))
>
>MESSAGEBOX("RemoveAll items")
>o.RemoveAll
>MESSAGEBOX("o.Length="+ALLTRIM(STR(o.Length)))
>* VFP 7 Collection Object
>************************************
>DEFINE Class Collection AS SESSION
>Length = 0
>CaseSensitive = .F.
>DIMENSION Items[1]
>Items[1] = NULL
>DIMENSION ItemNames[1]
>ItemNames[1] = NULL
>************************************
>FUNCTION Length_Access AS INTEGER
>	LOCAL lnLength
>	IF ISNULL(This.Items[1])
>		lnLength = 0
>	ELSE
>		lnLength = ALEN(This.Items)
>	ENDIF
>	RETURN lnLength
>ENDFUNC
>************************************
>FUNCTION AddItem(ObjectName AS CHARACTER,;
>	 ClassName AS CHARACTER, LibraryName AS CHARACTER) AS VOID
>	LOCAL lnLength
>	lnLength = This.Length + 1
>	DIMENSION This.Items[lnLength], This.ItemNames[lnLength]
>	This.ItemNames[lnLength] = ObjectName
>	IF VARTYPE(LibraryName) = "C"
>		This.Items[lnLength] = NEWOBJECT(ClassName, LibraryName)
>	ELSE
>		This.Items[lnLength] = CREATEOBJECT(ClassName)
>	ENDIF
>ENDFUNC
>************************************
>FUNCTION Items_Access(vMember AS Variant) AS OBJECT
>	LOCAL lnLength, loObject
>	IF ISNULL(This.Items[1])  && Cant use This.Length here
>		RETURN NULL
>	ELSE
>		lnLength = ALEN(This.Items)
>	ENDIF
>	DO CASE
>	CASE VARTYPE(vMember) = "C"
>		LOCAL lnIndex
>		IF NOT This.CaseSensitive
>			lnIndex = ASCAN(This.ItemNames, vMember,1,0,1,03)
>		ELSE
>			lnIndex = ASCAN(This.ItemNames,vMember,1,0,1)
>		ENDIF
>		IF lnIndex > 0
>			RETURN This.Items(lnIndex)
>		ELSE
>			RETURN NULL
>		ENDIF
>	CASE VARTYPE(vMember) = "N"
>		IF NOT vMember > lnLength OR vMember = 0  && VFP collections not zero based
>			RETURN This.Items(vMember)
>		ELSE
>			RETURN NULL
>		ENDIF
>	OTHERWISE
>		RETURN NULL
>	ENDCASE
>ENDFUNC
>************************************
>FUNCTION RemoveItem(vMember AS Variant) AS VOID
>	LOCAL lnLength
>	lnLength = This.Length
>	IF NOT lnLength = 0
>		DO CASE
>		CASE VARTYPE(vMember) = "C"
>			LOCAL lnIndex
>			IF NOT This.CaseSensitive
>				lnIndex = ASCAN(This.ItemNames, vMember,1,0,1,03)
>			ELSE
>				lnIndex = ASCAN(This.ItemNames,vMember,1,0,1)
>			ENDIF
>			IF lnIndex > 0
>				ADEL(This.Items,lnIndex)
>				ADEL(This.ItemNames,lnIndex)
>				DIMENSION This.Items[lnLength-1]
>				DIMENSION This.ItemNames[lnLength-1]
>			ENDIF
>		CASE VARTYPE(vMember) = "N"
>			IF NOT vMember > lnLength OR vMember = 0
>				ADEL(This.Items,vMember)
>				ADEL(This.ItemNames,vMember)
>				DIMENSION This.Items[lnLength-1]
>				DIMENSION This.ItemNames[lnLength-1]
>			ENDIF
>		ENDCASE
>	ENDIF
>ENDFUNC
>************************************
>FUNCTION RemoveAll AS VOID
>	DIMENSION This.Items[1], This.ItemNames[1]
>	This.Items(1) = NULL
>	This.ItemNames[1] = NULL
>ENDFUNC
>************************************
>FUNCTION ERROR(nError AS INTEGER, cMethod AS INTEGER, nLine AS INTEGER) AS VOID
>	* Return type to be modified as needed
>	LOCAL lcError, lcLine
>	lcError = ALLTRIM(STR(nError))
>	lcLine  = ALLTRIM(STR(nLine))
>	ASSERT .F. MESSAGE "Error No " + lcError + ", " ;
>		+ "Line No " + lcLine + ", Method " + cMethod + CHR(13) + MESSAGE(0)
>ENDFUNC
>************************************
>FUNCTION Destroy AS VOID
>	DIMENSION This.Items[1]
>	This.Items = NULL
>ENDFUNC
>************************************
>* FUNCTION This_Access(cMember AS VARIANT) AS VARIANT
>	* Is this method supposed to fire on properties and method names?
>	* When the property Length is queried the cMember parameter is filled 
>	* with "length"
>	* IF PARAMETERS() = 1 AND NOT PEMSTATUS(This, cMember, 5)
>		* RETURN This.Items
>	* ENDIF
>*	RETURN This	
>* ENDFUNC
>************************************
>ENDDEFINE
Vlad Grynchyshyn, Project Manager, MCP
vgryn@yahoo.com
ICQ #10709245
The professional level of programmer could be determined by level of stupidity of his/her bugs

It is not appropriate to say that question is "foolish". There could be only foolish answers. Everybody passed period of time when knows nothing about something.
Précédent
Répondre
Fil
Voir

Click here to load this message in the networking platform