How Do You Get An Array From A Class Object?

[colin glenn]

Oh, mods!

        PROPERTY GET myArray(BYVAL vCount AS LONG) AS LONG
            LOCAL pCount AS LONG PTR
            pCount = vCount
            @pCount = UBOUND(myArray)
            PROPERTY = VARPTR(myArray(0))
        END PROPERTY
        PROPERTY SET myArray(BYVAL vCount AS LONG, BYVAL vArray AS LONG)
            LOCAL hPointer AS myStructure POINTER, aIndex AS LONG
            hPointer = vArray
            REDIM myArray(vCount)
            FOR aIndex = 0 TO UBOUND(myArray)
                myArray(aIndex) = @hPointer[aIndex]
            NEXT aIndex
        END PROPERTY

Main Body:

• Replace:
  • object1.myArraysize = UBOUND(ThisArray)
  • object1.myArray = VARPTR(ThisArray(0))
• With:
  • object1.myArray(UBOUND(ThisArray)) = VARPTR(ThisArray(0))

• Replace:
  • vCount = object2.myArraysize
  • REDIM OtherArray(vCount)
  • vArray = object2.myArray
• With:
  • vArray = object2.myArray(VARPTR(vCount))
  • REDIM OtherArray(vCount)

And condense the number of calls for the properties.

[colin glenn]

Well, this works, though it leaves me wondering if I've overlooked something:

#COMPILE EXE
#DIM ALL

#INCLUDE "WIN32API.INC"

TYPE myStructure
    element1    AS INTEGER
    element2    AS INTEGER
    element3    AS INTEGER
END TYPE

CLASS OutterClass
    INSTANCE myArray()  AS myStructure
    CLASS METHOD CREATE
        #DEBUG PRINT "Outter Class Created"
        DIM myArray(0)
    END METHOD
    CLASS METHOD destroy
        #DEBUG PRINT "Outter Class Destroyed"
    END METHOD
    INTERFACE OutterInterface
        INHERIT IUNKNOWN
        PROPERTY GET myArraysize() AS LONG
            PROPERTY = UBOUND(myArray)
        END PROPERTY
        PROPERTY SET myArraysize(BYVAL vCount AS LONG)
            REDIM myArray(vCount)
        END PROPERTY
        PROPERTY GET myArray() AS LONG
            PROPERTY = VARPTR(myArray(0))
        END PROPERTY
        PROPERTY SET myArray(BYVAL vArray AS LONG)
            LOCAL hPointer AS myStructure POINTER, aIndex AS LONG
            hPointer = vArray
            FOR aIndex = 0 TO UBOUND(myArray)
                myArray(aIndex) = @hPointer[aIndex]
            NEXT aIndex
        END PROPERTY
        METHOD VerifyArray()
        ' print verifications
            LOCAL aIndex AS LONG
            FOR aIndex = 0 TO 3
                #DEBUG PRINT "myArray:" & FORMAT$(aIndex) _
                    & "=" & FORMAT$(myArray(aIndex).element1) _
                        & ":" & FORMAT$(myArray(aIndex).element2) _
                            & ":" & FORMAT$(myArray(aIndex).element3)
            NEXT aIndex
        END METHOD
        METHOD SayHello(BYVAL Index AS LONG)
            #DEBUG PRINT "Hello: " & FORMAT$(Index)
        END METHOD
    END INTERFACE
END CLASS

FUNCTION PBMAIN () AS LONG
LOCAL ThisArray() AS myStructure, aIndex AS LONG
LOCAL OtherArray() AS myStructure, vCount AS LONG
LOCAL vArray AS myStructure POINTER
    LOCAL object1, object2 AS OutterInterface
    LET object1 = CLASS "OutterClass"
    object1.sayhello 1
    LET object2 = object1
    object1.sayhello 2
' dim and fill the array
    DIM ThisArray(3)
    FOR aIndex = 0 TO 3
        ThisArray(aIndex).element1 = aIndex + 1
        ThisArray(aIndex).element2 = (aIndex + 1) * 10
        ThisArray(aIndex).element3 = (aIndex + 1) * 20
    NEXT aIndex
' print verifications
    FOR aIndex = 0 TO 3
        #DEBUG PRINT "ThisArray:" & FORMAT$(aIndex) _
            & "=" & FORMAT$(ThisArray(aIndex).element1) _
                & ":" & FORMAT$(ThisArray(aIndex).element2) _
                    & ":" & FORMAT$(ThisArray(aIndex).element3)
    NEXT aIndex
' store the array
    object1.myArraysize = UBOUND(ThisArray)
    object1.myArray = VARPTR(ThisArray(0))
    object1.verifyarray
' destroy first pointer to the class object
    LET object1 = NOTHING
    object2.sayhello 2
    #DEBUG PRINT IIF$(ISTRUE ISOBJECT(object1), "Is still an object", "No longer an object")
' retrieve the array
    vCount = object2.myArraysize
    REDIM OtherArray(vCount)
    vArray = object2.myArray
    FOR aIndex = 0 TO vCount
        OtherArray(aIndex) = @vArray[aIndex]
    NEXT aIndex
' print verifications
    FOR aIndex = 0 TO 3
        #DEBUG PRINT "OtherArray:" & FORMAT$(aIndex) _
            & "=" & FORMAT$(OtherArray(aIndex).element1) _
                & ":" & FORMAT$(OtherArray(aIndex).element2) _
                    & ":" & FORMAT$(OtherArray(aIndex).element3)
    NEXT aIndex
    LET object2 = NOTHING
END FUNCTION

:headache:

[colin glenn]

This is the closest I've gotten to where the compiler won't complain on either compile or debug, but it's got the flaw where the returned variant has the correct number of dimensions, but the values are empty:

#COMPILE EXE
#DIM ALL

#INCLUDE "WIN32API.INC"

TYPE myStructure
    element1    AS INTEGER
    element2    AS INTEGER
    element3    AS INTEGER
END TYPE

CLASS OutterClass
    INSTANCE myArray()  AS myStructure
    CLASS METHOD CREATE
        #DEBUG PRINT "Outter Class Created"
    END METHOD
    CLASS METHOD destroy
        #DEBUG PRINT "Outter Class Destroyed"
    END METHOD
    INTERFACE OutterInterface
        INHERIT IUNKNOWN
        PROPERTY GET myArray() AS VARIANT
            LOCAL rArray AS VARIANT
            LET rArray = myArray()
            PROPERTY = rArray
        END PROPERTY
        PROPERTY SET myArray(BYVAL vArray AS VARIANT)
            DIM myArray(0)
            LET myArray() = vArray
        END PROPERTY
        METHOD SayHello(BYVAL Index AS LONG)
            #DEBUG PRINT "Hello: " & STR$(Index)
        END METHOD
    END INTERFACE
END CLASS

FUNCTION PBMAIN () AS LONG
LOCAL ThisArray() AS myStructure, ThatVariant AS VARIANT, aIndex AS LONG
LOCAL OtherArray() AS myStructure, OtherVariant AS VARIANT
    LOCAL object1, object2 AS OutterInterface
    LET object1 = CLASS "OutterClass"
    object1.sayhello 1
    LET object2 = object1
    object1.sayhello 2
' dim and fill the array
    DIM ThisArray(3)
    FOR aIndex = 0 TO 3
        ThisArray(aIndex).element1 = aIndex + 1
        ThisArray(aIndex).element2 = (aIndex + 1) * 10
        ThisArray(aIndex).element3 = (aIndex + 1) * 20
    NEXT aIndex
' print verifications
    FOR aIndex = 0 TO 3
        #DEBUG PRINT "ThisArray(1):" & STR$(aIndex) & "=" & STR$(ThisArray(aIndex).element1)
        #DEBUG PRINT "ThisArray(2):" & STR$(aIndex) & "=" & STR$(ThisArray(aIndex).element2)
        #DEBUG PRINT "ThisArray(3):" & STR$(aIndex) & "=" & STR$(ThisArray(aIndex).element3)
    NEXT aIndex
' store the array
    LET ThatVariant = ThisArray()
    object1.myArray = ThatVariant
    LET object1 = NOTHING
    object2.sayhello 2
    #DEBUG PRINT IIF$(ISTRUE ISOBJECT(object1), "Is still an object", "No longer an object")
    OtherVariant = object2.myArray
    DIM OtherArray(0)
    LET OtherArray() = OtherVariant
' print verifications
    FOR aIndex = 0 TO 3
        #DEBUG PRINT "OtherArray(1):" & STR$(aIndex) & "=" & STR$(OtherArray(aIndex).element1)
        #DEBUG PRINT "OtherArray(2):" & STR$(aIndex) & "=" & STR$(OtherArray(aIndex).element2)
        #DEBUG PRINT "OtherArray(3):" & STR$(aIndex) & "=" & STR$(OtherArray(aIndex).element3)
    NEXT aIndex
    LET object2 = NOTHING
END FUNCTION