>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