Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Process Any Array with same function

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Process Any Array with same function

    Code:
    ' 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 AS LONG, nElements AS LONG, OutString AS STRING, I AS LONG, 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
        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)
        MSGBOX "Passed Array LB, UB=" & STR$(LB) & STR$(UB)
        MSGBOX OutString, %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
        ' 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 **


    ------------------
    Michael Mattias
    Tal Systems Inc.
    Racine WI USA
    mailto:[email protected][email protected]</A>
    www.talsystems.com
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com
Working...
X