Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
VFP Collection
Message
 
 
To
All
General information
Forum:
Visual FoxPro
Category:
Object Oriented Programming
Title:
VFP Collection
Miscellaneous
Thread ID:
00502866
Message ID:
00502866
Views:
54
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
Next
Reply
Map
View

Click here to load this message in the networking platform