'
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 [B]ElseIf DT = %VarClass_Str Then '<<< tried %VarClass_Fix but no good[/B] [B] Caption = "String array detected"[/B] [B] ReDim MyString(nelements -1) As String At VarPtr(AD(0))[/B] [B] For I = LBound(myString,1) To UBound(MyString, 1)[/B] [B] OutString = OutString & MyString(I) & ", "[/B] [B] Next[/B] ' 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 ' [B]ReDim Strng(10) As String * 10[/B] [B] For I = 0 To 10[/B] [B] Strng(I) = "String"& Str$(i)[/B] [B] Next [/B] [B] 'Now try a string array[/B] [B] Stat = ProcessAnyArray (ByVal VarPtr(Strng(0))) '<<< no good, not with StrPtr either[/B] [B] ' [/B] ' 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