Array of Any for dynamics procedure parameters

[mk-soft]

Maybe someone could use it...

Code: Select all

;-TOP

; Comment : Array of Any
; Author  : mk-soft
; Version : v1.06
; Create  : 07.04.2018
; Update  : 

; ***************************************************************************************

Structure AnyArray
  Type.l
  Size.l
  StructureUnion
    aVal.a[0]
    bVal.b[0]
    cVal.c[0]
    uVal.u[0]
    wVal.w[0]
    iVal.i[0]
    lVal.l[0]
    qVal.q[0]
    fVal.f[0]
    dVal.d[0]
    *pData[0]
    *sVal.String[0]
  EndStructureUnion
EndStructure

Procedure AllocateArray(Type, Size = 1)
  Protected *mem.AnyArray, index, uBound
  Select Type
    Case #PB_Ascii
      *mem = AllocateMemory(Size + SizeOf(AnyArray))
    Case #PB_Byte
      *mem = AllocateMemory(Size + SizeOf(AnyArray))
    Case #PB_Character
      *mem = AllocateMemory(Size * SizeOf(Character) + SizeOf(AnyArray)); Compilermode Ascii == 1 and Unicode = 2
    Case #PB_Word
      *mem = AllocateMemory(Size * 2 + SizeOf(AnyArray))
    Case #PB_Unicode
      *mem = AllocateMemory(Size * 2 + SizeOf(AnyArray))
    Case #PB_Integer
      *mem = AllocateMemory(Size * SizeOf(Integer) + SizeOf(AnyArray)) ; On x86 == 4 and x64 == 8
    Case #PB_Long
      *mem = AllocateMemory(Size * 4 + SizeOf(AnyArray))
    Case #PB_Quad
      *mem = AllocateMemory(Size * 8 + SizeOf(AnyArray))
    Case #PB_Float
      *mem = AllocateMemory(Size * 4 + SizeOf(AnyArray))
    Case #PB_Double
      *mem = AllocateMemory(Size * 8 + SizeOf(AnyArray))
    Case #PB_Array ; Array of Pointer (pData)
      *mem = AllocateMemory(Size * SizeOf(Integer) + SizeOf(AnyArray))
    Case #PB_String ; Array of String (sVal\s) 
      *mem = AllocateMemory(Size * SizeOf(Integer) + SizeOf(AnyArray))
      If *mem
        uBound = size - 1
        For index = 0 To uBound
          *mem\sVal[index] = AllocateStructure(String) ; Strings must be initialize
        Next
      EndIf
  EndSelect
  If *mem
    *mem\Type = Type
    *mem\Size = Size
  EndIf
  ProcedureReturn *mem
EndProcedure

Procedure ReleaseArray(*Mem.AnyArray)
  Protected index, uBound
  If *Mem
    If *Mem\Type = #PB_String
      uBound = *Mem\Size - 1
      For index = 0 To uBound
        FreeStructure(*Mem\sVal[index]) ; Strings must be release
      Next
    EndIf
    FreeMemory(*Mem)
  EndIf
EndProcedure

; ***************************************************************************************

;- Example

CompilerIf #PB_Compiler_IsMainFile
  
  Procedure MyFunction(*Data.AnyArray)
    Protected index, uBound
    uBound = *data\Size - 1
    Select *data\Type
      Case #PB_Ascii
        Debug "Array of Unsigned Byte (Ascii)"
        For index = 0 To uBound
          Debug *Data\aVal[index]
        Next
      Case #PB_Word
        Debug "Array of Word"
        For index = 0 To uBound
          Debug *Data\wVal[index]
        Next
      Case #PB_String
        Debug "Array of String"
        For index = 0 To uBound
          Debug *Data\sVal[index]\s
        Next
    EndSelect
  EndProcedure
  
  ; Define data
  Define *srcA.AnyArray
  Define *srcW.AnyArray
  Define *srcS.AnyArray
  Define index
  
  ; Allocate arrays
  *srcA = AllocateArray(#PB_Ascii, 20)
  *srcW = AllocateArray(#PB_Word, 10)
  *srcs = AllocateArray(#PB_String, 10)
  
  ; Fill arrays
  For index = 0 To 19
    *srcA\aVal[index] = index + 100
  Next
  
  For index = 0 To 9
    *srcW\wVal[index] = index + 1000
  Next
  
  *srcs = AllocateArray(#PB_String, 10)
  For index = 0 To 9
    *srcS\sVal[index]\s = "Index " + index
  Next index
  
  ; Output arrays
  MyFunction(*srcA)
  MyFunction(*srcW)
  MyFunction(*srcS)
  
  ; Free arrays
  ReleaseArray(*srcA)
  ReleaseArray(*srcW)
  ReleaseArray(*srcS)
  
CompilerEndIf