Tweet
'
Code:
'http://www.powerbasic.com/support/pbforums/showthread.php?t=24103
' FILE: PROCESSS_ANY_ARRAY.BAS
' AUTHOR: Michael Mattias Racine WI
' 7/18/02 WORKS GOOD!!
' 8/15/03 Tested that it gets UBOUND and LBOUND of passed array correctly.. it does.
' Compiler: Pb/Win 7.0
#Compile Exe
'
'
'===[Windows API Header Files]=========================================
' If you don't need all of the functionality supported by these APIs
' (and who does?), you can selectively turn off various modules by putting
' the following constants in your program BEFORE you #include "win32api.inc":
'
' %NOGDI = 1 ' no GDI (Graphics Device Interface) functions
' %NOMMIDS = 1 ' no Multimedia ID definitions
'
%NOMMIDS = 1
#Include "WIN32API.INC"
' ====================================================
' FUNCTION TO DETECT DATATYPE AND PROCESS ACCORDINGLY
' ====================================================
Function ProcessAnyArray (AD() As Word ) As Long
'
Local DT, nElements, I As Long
Local s, OutString, Caption As String
'
DT= ArrayAttr( AD(), 1&) ' Ignores type in function header; reads parameter
nElements = ArrayAttr(AD(),4&) ' *AS IT DARN WELL SHOULD!!*
If DT = %VarClass_Lng Then
Caption = "LONG array Detected"
ReDim MyLong(nElements -1) As Long At VarPtr(AD(0))
' Build the output string
For I = LBound(myLong,1) To UBound(MyLong, 1)
OutString = OutString & Str$(MyLong(I)) & ","
Next
ElseIf DT = %VarClass_Sng Then
Caption = "SINGLE array detected"
ReDim MySingle(nelements -1) As Single At VarPtr(AD(0))
For I = LBound(mySingle,1) To UBound(MySingle, 1)
OutString = OutString & Str$(MySingle(I)) & ", "
Next
ElseIf DT = %VarClass_Str Then '<<< tried %VarClass_Fix but no good
Caption = "String array detected"
ReDim MyString(nelements -1) As String At VarPtr(AD(0))
For I = LBound(myString,1) To UBound(MyString, 1)
OutString = OutString & MyString(I) & ", "
Next
'
Else
Caption = "Other array detected"
OutString = "Unsupported datatype=" & Str$(DT)
End If
Local LB As Long, UB As Long
LB = LBound(AD,1): UB = UBound(AD,1)
s$ = Using$("Passed Array LB=#, UB=#,", LB, UB) & $CrLf & _
OutString
MsgBox s, _
%MB_ICONEXCLAMATION, _
"ArrayAttr DEMO: " & Caption
'
End Function
'
Function PBMain () As Long
'
Local Stat As Long, I As Long
'
ReDim X(10) As Long
For I = 0 To 5
X(I) = I * 100
Next
ReDim Y(90) As Single
For I = 0 To 10
Y(I) = -.1 * I
Next
'
ReDim Strng(10) As String * 10
For I = 0 To 10
Strng(I) = "String"& Str$(i)
Next
'Now try a string array
Stat = ProcessAnyArray (ByVal VarPtr(Strng(0))) '<<< no good, not with StrPtr either
'
' process an array of LONGS:
Stat = ProcessAnyArray (ByVal VarPtr (X()))
' now process an array of SINGLEs with the same function:
Stat = ProcessAnyArray (ByVal VarPtr (Y()))
' now give the function something for which it is not prepared:
Dim Z (4 To 999) As Cur
Stat = ProcessAnyArray (ByVal VarPtr (Z()))
'
'
End Function
' ** END OF FILE **
'
Comment