Bug when redimensioning multi-dimension arrays?

[bplus]

I'm thinking this should now resize on both dimentsions, up or down, while preserving the original data:

Code: (Select All)

'Expanded upon by Steve-the-AMAZING(tm) from what bplus had originally  



REDIM Grid(1 TO 5, 1 TO 5) AS LONG

' LoadInitialValues

FOR y = 1 TO 5

    FOR x = 1 TO 5

        counter = counter + 1

        Grid(x, y) = counter

    NEXT

NEXT

ShowArrayValues Grid()

Redim2D Grid(), 0, 6, 3, 4



ShowArrayValues Grid()

END



SUB Redim2D (arr() AS LONG, xlb AS LONG, xub, ylb AS LONG, yub AS LONG) ' xpr x per row

    DIM AS LONG lbx, lby, ubx, uby

    lbx = LBOUND(arr, 1)

    lby = LBOUND(arr, 2)

    ubx = UBOUND(arr, 1)

    uby = UBOUND(arr, 2)

    DIM c(lbx TO ubx, lby TO uby) AS LONG

    FOR y = lby TO uby

        FOR x = lbx TO uby

            c(x, y) = arr(x, y)

        NEXT

    NEXT

    REDIM arr(xlb TO xub, ylb TO yub) ' fixed

    'ReDim _Preserve arr(xpr, r)  'nope

    'ReDim _Preserve arr(lbx To xpr, lby To r)

    'ReDim _Preserve arr(lbx To xpr, lby To r) As Long ' nope

    FOR y = lby TO uby

        IF y >= ylb AND y <= yub THEN

            FOR x = lbx TO uby

                IF x >= xlb AND x <= xub THEN arr(x, y) = c(x, y)

            NEXT

        END IF

    NEXT

END SUB



SUB ShowArrayValues (arr() AS LONG)

    PRINT "Array Values:": PRINT

    FOR y = LBOUND(arr, 2) TO UBOUND(arr, 2)

        PRINT USING "Row ##  "; y,

        FOR x = LBOUND(arr, 1) TO UBOUND(arr, 1)

            PRINT USING " ##"; arr(x, y);

        NEXT

        PRINT

    NEXT

    PRINT

END SUB

hmm... amazing ;-)) what happened to 5th value on row 3 and 4

Code: (Select All)

'Expanded upon by Steve-the-AMAZING(tm) from what bplus had originally  Wink
ReDim Grid(1 To 5, 1 To 5) As Long
' LoadInitialValues
For y = 1 To 5
    For x = 1 To 5
        counter = counter + 1
        Grid(x, y) = counter
    Next
Next
ShowArrayValues Grid()
Redim2D Grid(), 0, 6, 3, 4
ShowArrayValues Grid()
Redim2D Grid(), 1, 5, 1, 5
ShowArrayValues Grid()

End
Sub Redim2D (arr() As Long, xlb As Long, xub, ylb As Long, yub As Long) ' xpr x per row
    Dim As Long lbx, lby, ubx, uby
    lbx = LBound(arr, 1)
    lby = LBound(arr, 2)
    ubx = UBound(arr, 1)
    uby = UBound(arr, 2)
    Dim c(lbx To ubx, lby To uby) As Long
    For y = lby To uby
        For x = lbx To uby
            c(x, y) = arr(x, y)
        Next
    Next
    ReDim arr(xlb To xub, ylb To yub) ' fixed
    'ReDim _Preserve arr(xpr, r)  'nope
    'ReDim _Preserve arr(lbx To xpr, lby To r)
    'ReDim _Preserve arr(lbx To xpr, lby To r) As Long ' nope
    For y = lby To uby
        If y >= ylb And y <= yub Then
            For x = lbx To uby
                If x >= xlb And x <= xub Then arr(x, y) = c(x, y)
            Next
        End If
    Next
End Sub
Sub ShowArrayValues (arr() As Long)
    Print "Array Values:": Print
    For y = LBound(arr, 2) To UBound(arr, 2)
        Print Using "Row ##  "; y,
        For x = LBound(arr, 1) To UBound(arr, 1)
            Print Using " ##"; arr(x, y);
        Next
        Print
    Next
    Print
End Sub