mem arrays

[James D Jarvis]

Other folks using mem and posting about it got me reading the documentation on the _mem commands and I realized it
was a possible solution to a limitation in QB.

I've always wanted to use arrays inside a programmer defined record type. The functions and subs here are an attempt to do so. Currently only supports one dimensional arrays of 2 byte integers.

Code: (Select All)

'mem array functions and subs
Type rectype
    array As _MEM 'this could of course be just one of many entries inside a larger record but this demo code is cleaner with the array alone here
End Type

Dim rec As rectype
Dim r2 As rectype
rec.array = _MemNew(20) 'make a 20 byte mem block to hold an intger array with 10 elements
r2.array = _MemNew(20)
Print "I've always wanted to uses arrays inside record types but that isn't a standard option"
Print "the functions and subs this program uses are made to handle arrays inside such records"
'I chose to do this without creating seperate reference arrays  to establish the arrays as all the routines...
' required to access the arrays don't have to ever look at a seperately defined array
Print
Print "Made 2 integer arays"
Print "Offset", "Size"
Print rec.array.OFFSET, rec.array.SIZE, "Rec"
Print r2.array.OFFSET, r2.array.SIZE, "R2"
Print
'build 2 integer arrays
For x = 1 To 10
    xx% = Int(x * 2)
    x2% = Int(x)
    miput_array xx%, rec.array, x
    miput_array x2%, r2.array, x
Next x
Print "Here are their values"
'manually read the arrays rec.array and r2.array  and print the values
For x = 1 To 10
    n = Int(miget(rec.array, x))
    m = Int(miget(r2.array, x))
    Print n, m
Next
Input "press enter to continue", kk$
'directly setting the first elelemnt in array in r2 to the vale 123
Print "Changed the 1st vlaue of the array r2"
xx% = 123
_MemPut r2.array, r2.array.OFFSET, xx%
'trying out iget function
Print iget(r2, 1)
'trying out        miget function
Print miget(r2.array, 1)
Print
print_iarray r2.array, 1, 10

Input "press enter to continue", kk$
Print
Print "Appending the array at r2 to have 2 more elements"

mem_iappend r2.array, 2
s = iarray_len(r2.array)
For x = 1 To s
    Print miget(r2.array, x);
Next x
Print "array length "; iarray_len(r2.array)
Print "let's fill elements 11 and 12..."
x2% = 11
miput_array x2%, r2.array, 11
x2% = 12
miput_array x2%, r2.array, 12
print_iarray r2.array, 1, s

Print: Print

Print "taking these values"
print_iarray rec.array, 1, 6
Print "and replacing elements 4 to 9 in the last array."
quick_iacopy rec.array, r2.array, 1, 6, 4
print_iarray r2.array, 1, 12


'cleaning up
_MemFree rec.array
_MemFree r2.array

'================================================================================================
'functions and subs to handle arrays inside a memory block
'
'currently only supports 2 byte intgers
'================================================================================================
Sub quick_iacopy (ra As _MEM, rb As _MEM, a1 As Integer, a2 As Integer, b As Integer)
    'take elements a1 to a2 form integer arrai ra and repalce in integer array rb starting at element b
    _MemCopy ra, ra.OFFSET + (a1 - 1) * 2, (a2 + 1 - a1) * 2 To rb, rb.OFFSET + (b - 1) * 2
End Sub

Sub print_iarray (r As _MEM, x1, x2)
    'print elements x1 to x2 in an integer array
    If x1 < x2 Then 'print order is lower element # to higher element #
        For n = x1 To x2
            x = _MemGet(r, r.OFFSET + (n - 1) * 2, Integer)
            Print x;
        Next
        Print
    End If
    If x1 > x2 Then 'print order is higher elelemnt # to lower element #
        For n = x1 To x2 Step -1
            x = _MemGet(r, r.OFFSET + (n - 1) * 2, Integer)
            Print x;
        Next
        Print
    End If
End Sub

Sub miput_array (n As Integer, r As _MEM, e)
    'this puts a 2 byte integer into the array r at element e
    If e > 0 And e <= r.SIZE / 2 Then 'if element is outside array size program will not check incorrect offset but will still return a 0
        _MemPut r, r.OFFSET + ((e - 1) * 2), n
    End If
End Sub

Function iget (r As rectype, e)
    'get elelent e out of the array in the record    ... probably retirng this function as it isn't as robust as miget
    iget = _MemGet(r.array, r.array.OFFSET + (e - 1) * 2, Integer)
End Function

Function miget (r As _MEM, e)
    'mem integer get,  grab element out of the array at r
    miget = _MemGet(r, r.OFFSET + (e - 1) * 2, Integer)
End Function

Sub mem_iappend (r As _MEM, n)
    'add n elements to an integer array
    SA$ = Str$(r.SIZE)
    s = Val(_Trim$(SA$))
    Dim temp As _MEM
    temp = _MemNew(s)
    _MemCopy r, r.OFFSET, r.SIZE To temp, temp.OFFSET
    _MemFree r 'now ths is strange, if you don't do this the address of the offset will change after the next command, not a big deal but a curisotiy
    r = _MemNew(s + n * 2)
    _MemCopy temp, temp.OFFSET, temp.SIZE To r, r.OFFSET
    _MemFree temp
End Sub

Function iarray_len (r As _MEM)
    ll% = Int(Val(_Trim$(Str$(r.SIZE))) / 2)
    iarray_len = ll%
End Function