Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Miscellaneous handy goodies
#7
This version might be easier to read with the $NoPrefix turned on:

Code: (Select All)
Option Explicit
$NoPrefix
$Console:Only

Title "Overloaded Functions - AS ANY"

Dim As MEM test(1 To 17)

Dim As Long longtest: longtest = 435
Dim As Single singletest: singletest = 1.2
Dim As Float floattest: floattest = 4.65
Dim As String * 21 stringtest: stringtest = "This is a string test"
Dim As Offset offsettest: offsettest = 1234567
'Dim As Long imagetest: imagetest = _LoadImage(".\face no background.png", 32) 'replace with an image that you have
'Dim As Long soundtest: soundtest = _SndOpen(".\Dalshabet With. Bigtone.mp3") 'replace with a song that you have
Dim As String * 13 stringarraytest(1 To 3)
stringarraytest(1) = "Array test 1"
stringarraytest(2) = "Array test 2"
stringarraytest(3) = "Array test 3"
Dim As Unsigned Offset unsignedoffsetarraytest(1 To 2)
unsignedoffsetarraytest(1) = 123456789
unsignedoffsetarraytest(2) = 787970792
Dim As Unsigned Offset unsignedoffsettest: unsignedoffsettest = 1234523
Dim As Float floatarraytest(1 To 3)
floatarraytest(1) = 3.56
floatarraytest(2) = 14.7548
floatarraytest(3) = 56.24124
Dim As Double doublearraytest(1 To 3)
doublearraytest(1) = 1.25
doublearraytest(2) = 2.34
doublearraytest(3) = 5.52
Dim As Single singlearraytest(1 To 3)
singlearraytest(1) = 2.12
singlearraytest(2) = 6.87
singlearraytest(3) = 9.65
Dim As Unsigned Byte unsignedbytearraytest(1 To 4)
unsignedbytearraytest(1) = 255
unsignedbytearraytest(2) = 124
unsignedbytearraytest(3) = 98
unsignedbytearraytest(4) = 34
'test(1) = MEMImage(imagetest)
test(2) = Mem(singletest)
test(3) = Mem(floattest)
test(4) = Mem(stringtest)
test(5) = Mem(offsettest)
test(6) = Mem(longtest)
Dim As Double doubletest: doubletest = 2.578
test(7) = Mem(doubletest)
'test(7) = MEMSound(soundtest, 1) 'Left channel
'test(8) = MEMSound(soundtest, 2) 'Right channel
test(9) = Mem(stringarraytest())
test(10) = Mem(unsignedoffsetarraytest())
test(11) = Mem(unsignedoffsettest)
test(12) = Mem(floatarraytest())
test(13) = Mem(doublearraytest())
test(14) = Mem(singlearraytest())
test(15) = Mem(unsignedbytearraytest())
test(16) = MemNew(4)
MemPut test(16), test(16).OFFSET, longtest As LONG
test(17) = MemNew(14)
MemPut test(17), test(17).OFFSET, "This is a test"

Call anyArg(test())
Dim As Unsigned Integer x
For x = LBound(test) To UBound(test)
    If MemExists(test(x)) Then
        MemFree test(x)
    End If
Next

Erase test

Sub anyArg (args() As MEM)
    Dim As Unsigned Integer x, y
    Dim As Unsigned Offset z
    Dim As Unsigned Long size, elementsize
    For x = LBound(args) To UBound(args)
        If MemExists(args(x)) Then
            z = 0
            size = Val(Str$(args(x).SIZE))
            elementsize = Val(Str$(args(x).ELEMENTSIZE))
            If ReadBit(args(x).TYPE, 7) And ReadBit(args(x).TYPE, 13) = 0 Then '_BYTE, INTEGER, LONG, _INTEGER64
                If ReadBit(args(x).TYPE, 10) Then
                    If ReadBit(args(x).TYPE, 16) Then
                        Select Case args(x).ELEMENTSIZE
                            Case 1
                                Dim As Unsigned Byte unsignedbytearray(1 To (size / elementsize))
                                For y = LBound(unsignedbytearray) To UBound(unsignedbytearray)
                                    MemGet args(x), args(x).OFFSET + z, unsignedbytearray(y)
                                    z = z + args(x).ELEMENTSIZE
                                    Print unsignedbytearray(y), "UBYTE ARRAY"
                                Next
                                Exit Select
                            Case 2
                                Dim As Unsigned Integer unsignedintarray(1 To (size / elementsize))
                                For y = LBound(unsignedintarray) To UBound(unsignedintarray)
                                    MemGet args(x), args(x).OFFSET + z, unsignedintarray(y)
                                    z = z + args(x).ELEMENTSIZE
                                    Print unsignedintarray(y), "USHORT ARRAY"
                                Next
                                Exit Select
                            Case 4
                                Dim As Unsigned Long unsignedlongarray(1 To (size / elementsize))
                                For y = LBound(unsignedlongarray) To UBound(unsignedlongarray)
                                    MemGet args(x), args(x).OFFSET + z, unsignedlongarray(y)
                                    z = z + args(x).ELEMENTSIZE
                                    Print unsignedlongarray(y), "ULONG ARRAY"
                                Next
                                Exit Select
                            Case 8
                                Dim As Unsigned Integer64 unsignedint64array(1 To (size / elementsize))
                                For y = LBound(unsignedint64array) To UBound(unsignedint64array)
                                    MemGet args(x), args(x).OFFSET + z, unsignedint64array(y)
                                    z = z + args(x).ELEMENTSIZE
                                    Print unsignedint64array(y), "UINT64 ARRAY"
                                Next
                                Exit Select
                        End Select
                    Else
                        Select Case args(x).SIZE
                            Case 1
                                Print MemGet(args(x), args(x).OFFSET, Unsigned Byte), "UBYTE"
                                Exit Select
                            Case 2
                                Print MemGet(args(x), args(x).OFFSET, Unsigned Integer), "USHORT"
                                Exit Select
                            Case 4
                                Print MemGet(args(x), args(x).OFFSET, Unsigned Long), "ULONG"
                                Exit Select
                            Case 8
                                Print MemGet(args(x), args(x).OFFSET, Unsigned Integer64), "UINT64"
                                Exit Select
                        End Select
                    End If
                Else
                    If ReadBit(args(x).TYPE, 16) Then
                        Select Case args(x).ELEMENTSIZE
                            Case 1
                                Dim As Byte bytearray(1 To (size / elementsize))
                                For y = LBound(bytearray) To UBound(bytearray)
                                    MemGet args(x), args(x).OFFSET + z, bytearray(y)
                                    z = z + args(x).ELEMENTSIZE
                                    Print bytearray(y), "BYTE ARRAY"
                                Next
                                Exit Select
                            Case 2
                                Dim As Integer intarray(1 To (size / elementsize))
                                For y = LBound(intarray) To UBound(intarray)
                                    MemGet args(x), args(x).OFFSET + z, intarray(y)
                                    z = z + args(x).ELEMENTSIZE
                                    Print unsignedintarray(y), "SHORT ARRAY"
                                Next
                                Exit Select
                            Case 4
                                Dim As Long longarray(1 To (size / elementsize))
                                For y = LBound(longarray) To UBound(longarray)
                                    MemGet args(x), args(x).OFFSET + z, longarray(y)
                                    z = z + args(x).ELEMENTSIZE
                                    Print longarray(y), "LONG ARRAY"
                                Next
                                Exit Select
                            Case 8
                                Dim As Integer64 int64array(1 To (size / elementsize))
                                For y = LBound(int64array) To UBound(int64array)
                                    MemGet args(x), args(x).OFFSET + z, int64array(y)
                                    z = z + args(x).ELEMENTSIZE
                                    Print int64array(y), "INT64 ARRAY"
                                Next
                                Exit Select
                        End Select
                    Else
                        Select Case args(x).SIZE
                            Case 1
                                Print MemGet(args(x), args(x).OFFSET, Byte), "BYTE"
                                Exit Select
                            Case 2
                                Print MemGet(args(x), args(x).OFFSET, Integer), "SHORT"
                                Exit Select
                            Case 4
                                Print MemGet(args(x), args(x).OFFSET, Long), "LONG"
                                Exit Select
                            Case 8
                                Print MemGet(args(x), args(x).OFFSET, Integer64), "INT64"
                                Exit Select
                        End Select
                    End If
                End If
            ElseIf ReadBit(args(x).TYPE, 8) Then 'SINGLE, DOUBLE, FLOAT
                If ReadBit(args(x).TYPE, 16) Then
                    Select Case args(x).ELEMENTSIZE
                        Case 4
                            Dim As Single singlearray(1 To (size / elementsize))
                            For y = LBound(singlearray) To UBound(singlearray)
                                MemGet args(x), args(x).OFFSET + z, singlearray(y)
                                z = z + args(x).ELEMENTSIZE
                                Print singlearray(y), "SINGLE ARRAY"
                            Next
                            Exit Select
                        Case 8
                            Dim As Double doublearray(1 To (size / elementsize))
                            For y = LBound(doublearray) To UBound(doublearray)
                                MemGet args(x), args(x).OFFSET + z, doublearray(y)
                                z = z + args(x).ELEMENTSIZE
                                Print doublearray(y), "DOUBLE ARRAY"
                            Next
                            Exit Select
                        Case 32
                            Dim As Float floatarray(1 To (size / elementsize))
                            For y = LBound(floatarray) To UBound(floatarray)
                                MemGet args(x), args(x).OFFSET + z, floatarray(y)
                                z = z + args(x).ELEMENTSIZE / 2
                                Print floatarray(y), "FLOAT ARRAY"
                            Next
                            Exit Select
                    End Select
                Else
                    Select Case args(x).SIZE
                        Case 4
                            Print MemGet(args(x), args(x).OFFSET, Single), "SINGLE"
                            Exit Select
                        Case 8
                            Print MemGet(args(x), args(x).OFFSET, Double), "DOUBLE"
                            Exit Select
                        Case 32
                            Print MemGet(args(x), args(x).OFFSET, Float), "FLOAT"
                            Exit Select
                    End Select
                End If
            ElseIf ReadBit(args(x).TYPE, 9) Then 'STRING
                If ReadBit(args(x).TYPE, 16) Then
                    Dim As String stringarray(1 To (size / elementsize))
                    For y = LBound(stringarray) To UBound(stringarray)
                        stringarray(y) = Space$(args(x).ELEMENTSIZE)
                        MemGet args(x), (args(x).OFFSET) + (y * args(x).ELEMENTSIZE - args(x).ELEMENTSIZE), stringarray(y)
                        Print stringarray(y), "STRING ARRAY"
                    Next
                Else
                    Dim As String stringtest: stringtest = Space$(args(x).ELEMENTSIZE)
                    MemGet args(x), args(x).OFFSET, stringtest
                    Print stringtest
                End If
            ElseIf ReadBit(args(x).TYPE, 13) And ReadBit(args(x).TYPE, 7) Then '_OFFSET
                If ReadBit(args(x).TYPE, 10) Then
                    If ReadBit(args(x).TYPE, 16) Then
                        Dim As Unsigned Offset unsignedoffsetarray(1 To (size / elementsize))
                        For y = LBound(unsignedoffsetarray) To UBound(unsignedoffsetarray)
                            MemGet args(x), args(x).OFFSET + z, unsignedoffsetarray(y)
                            z = z + args(x).ELEMENTSIZE
                            Print unsignedoffsetarray(y), "ULONG_PTR ARRAY"
                        Next
                    Else
                        Print MemGet(args(x), args(x).OFFSET, Unsigned Offset), "ULONG_PTR"
                    End If
                Else
                    If ReadBit(args(x).TYPE, 16) Then
                        Dim As Offset offsetarray(1 To (size / elementsize))
                        For y = LBound(offsetarray) To UBound(offsetarray)
                            MemGet args(x), args(x).OFFSET + z, offsetarray(y)
                            z = z + args(x).ELEMENTSIZE
                            Print unsignedoffsetarray(y), "LONG_PTR ARRAY"
                        Next
                    Else
                        Print MemGet(args(x), args(x).OFFSET, Offset), "LONG_PTR"
                    End If
                End If
            ElseIf args(x).TYPE = 0 And args(x).SIZE > 0 Then 'MEMSOUND
                If Not SndPlaying(args(x).SOUND) Then
                    SndPlay (args(x).SOUND)
                End If
                Print "SOUND", args(x).SIZE, args(x).ELEMENTSIZE
            ElseIf ReadBit(args(x).TYPE, 14) Then
                Print args(x).SIZE, "MEM"
                'todo
            End If
            If ReadBit(args(x).TYPE, 11) Then 'MEMIMAGE
                Screen args(x).IMAGE
            End If
        End If
    Next
End Sub
Tread on those who tread on you

Reply


Messages In This Thread
Miscellaneous handy goodies - by grymmjack - 12-28-2022, 01:44 AM
RE: Miscellaneous handy goodies - by grymmjack - 12-28-2022, 01:46 AM
RE: Miscellaneous handy goodies - by SMcNeill - 12-28-2022, 03:55 AM
RE: Miscellaneous handy goodies - by madscijr - 12-28-2022, 11:56 PM
RE: Miscellaneous handy goodies - by OldMoses - 12-28-2022, 01:41 PM
RE: Miscellaneous handy goodies - by mdijkens - 12-28-2022, 03:37 PM
RE: Miscellaneous handy goodies - by SpriggsySpriggs - 12-28-2022, 08:02 PM
RE: Miscellaneous handy goodies - by mnrvovrfc - 03-27-2023, 06:22 PM
RE: Miscellaneous handy goodies - by aurel - 04-02-2023, 05:01 PM



Users browsing this thread: 1 Guest(s)