Redim [PRESERVE] MyArrayOfArrays (somenumber) AS VARIANT LET MyArrayofArrays(subscript) = LongArray()
Tweet
INIT:
REDIM AofA (number) AS LONG ' holds handles
ADD:
'add LONG array "L()" to AofA() at end:
LOCAL pl AS LONG PTR
nEl = ARRAYATTR(L(),4) ' element count of new array L()
GLOBALMEM ALLOC (nEl+1) * 4 to Hmem ' 4 = SIZEOF(LONG), but compiler won't accept that
GLOBALMEM LOCK hMem TO pL ' pointer to start of block
@pl = nel ' store element count at offset zero
INCR pl ' up we go
CopyMemory BYVAL pL, VARPTR(L(LBOUND (L,1))), nel * 4
' there's that pesky old SIZEOF(LONG) thing again. Darn, that would be handy wouldn't it?
GLOBALMEM UNLOCK hMem
REDIM PRESERVE AofA (UBOUND(AofA,1) + 1)
AofA (UBOUND(AofA,1)) = hMem ' store handle as new last element
GET:
' get back a desired array subscript into a working array "L()"
hMem = AofA (subscript)
GLOBALMEM LOCK hMem TO pl
nel = pl
INCR pl
REDIM L(nel-1) AT pl ' you could copy it off as above if you don't want
' to work with it in place.
' ------------------------
' work with L() here
' -------------------------
GLOBALMEM UNLOCK hMem ' CANNOT 'UNLOCK' until we are done with L() here
Dim BigArray(100,1000) '100 arrays, each with 1000 elements
Dim iMax As Long 'number of valid "arrays" as defined by the user
Dim APointer(100) 'maximum position in each dimension (virtual UBound)
' ========================================================================== ' | | ' | Array of Arrays | ' | | ' ========================================================================== ' Allows you to manage a set of LONG arrays where the number of arrays is ' variable and the UBOUND for each array in the set is also variable. ' ' Notes: these routines were built for a specific circumstances: ' * all arrays are assumed to be built sorted in ascending order ' * all data in arrays are assumed to be >= 0 (ie. no negative numbers) ' * all arrays use 0 as the LBOUND ' ' -> .lMaxValue may not be necessary for a more general application ' -> binary search does not work if arrays are not sorted ' -> if you need to store negative numbers, you will need to adjust the ' AoA_Get function to return value in a parameter separate from error code ' ' * Critical sections to make thread safe not fully implemented (not sure I need it yet) ' ========================================================================== ' PUBLIC DOMAIN SOFTWARE ' The author or authors of this code dedicate any and all ' copyright interest in this code to the public domain. ' Anyone is free to copy, modify, publish, use, compile, ' sell, or distribute the original code, either in source ' code form or as a compiled binary, for any purpose, ' commercial or non-commercial, and by any means. ' Bern Ertl - May 2009 ' ========================================================================== #COMPILE DLL #DIM ALL '============================<[ Equates ]>============================= '=============================<[ Types ]>============================== TYPE ArrayInfo lKey AS LONG 'Each array is indexed to a 'key' supplied by the application plData AS LONG PTR lUpperBound AS LONG lMaxValue AS LONG END TYPE '=============================<[ Macros ]>============================= '============================<[ Globals ]>============================= GLOBAL gCriticalSection AS CRITICAL_SECTION ' Critical section handle GLOBAL gsArrayData() AS STRING GLOBAL guArrayInfo() AS ArrayInfo '============================<[ Functions ]>=========================== SUB AoA_DIM ALIAS "AoA_DIM" (BYVAL lKey AS LONG, _ BYVAL lUpperBound AS LONG) EXPORT REGISTER I AS LONG, J AS LONG J = UBOUND( guArrayInfo) 'Check if key already exists FOR I = 0 TO J IF guArrayInfo( I).lKey = lKey THEN IF guArrayInfo( I).lUpperBound <> lUpperBound THEN guArrayInfo( I).lUpperBound = lUpperBound guArrayInfo( I).lMaxValue = 0 gsArrayData( I) = STRING$( (lUpperBound + 1) * 4, 0) guArrayInfo( I).plData = STRPTR( gsArrayData( I)) END IF EXIT SUB END IF NEXT 'Add lKey to guArrayInfo INCR J REDIM PRESERVE gsArrayData( J) REDIM PRESERVE guArrayInfo( J) guArrayInfo( J).lKey = lKey guArrayInfo( J).lUpperBound = lUpperBound guArrayInfo( J).lMaxValue = 0 gsArrayData( J) = STRING$( (lUpperBound + 1) * 4, 0) guArrayInfo( J).plData = STRPTR( gsArrayData( J)) END SUB '------------------------------------------------------------------------ SUB AoA_REDIM ALIAS "AoA_REDIM" (BYVAL lKey AS LONG, _ BYVAL lUpperBound AS LONG) EXPORT 'ReDim PRESERVE REGISTER I AS LONG, J AS LONG J = UBOUND( guArrayInfo) 'Check if key already exists FOR I = 0 TO J IF guArrayInfo( I).lKey = lKey THEN SELECT CASE AS LONG guArrayInfo( I).lUpperBound CASE < lUpperBound 'Expand array gsArrayData( I) += STRING$( (lUpperBound - guArrayInfo( I).lUpperBound) * 4, 0) guArrayInfo( I).lUpperBound = lUpperBound guArrayInfo( I).plData = STRPTR( gsArrayData( I)) CASE = lUpperBound 'Do nothing CASE > lUpperBound 'Reduce array gsArrayData( I) = LEFT$( gsArrayData( I), (lUpperBound + 1) * 4) guArrayInfo( I).lUpperBound = lUpperBound guArrayInfo( I).plData = STRPTR( gsArrayData( I)) guArrayInfo( I).lMaxValue = CVL( gsArrayData( I), lUpperBound * 4 + 1) END SELECT EXIT SUB END IF NEXT 'Add lKey to guArrayInfo INCR J REDIM PRESERVE gsArrayData( J) REDIM PRESERVE guArrayInfo( J) guArrayInfo( J).lKey = lKey guArrayInfo( J).lUpperBound = lUpperBound guArrayInfo( J).lMaxValue = 0 gsArrayData( J) = STRING$( (lUpperBound + 1) * 4, 0) guArrayInfo( J).plData = STRPTR( gsArrayData( J)) END SUB '------------------------------------------------------------------------ FUNCTION AoA_Put ALIAS "AoA_Put" (BYVAL lKey AS LONG, _ BYVAL lSubscript AS LONG, _ BYVAL lValue AS LONG) EXPORT AS LONG 'Returns %True if successful REGISTER I AS LONG, J AS LONG J = UBOUND( guArrayInfo) 'Find key FOR I = 0 TO J IF guArrayInfo( I).lKey = lKey THEN IF lSubscript >=0 AND lSubscript < guArrayInfo( I).lUpperBound THEN guArrayInfo( I)[email protected][ lSubscript] = lValue FUNCTION = %True EXIT FUNCTION ELSEIF lSubscript = guArrayInfo( I).lUpperBound THEN guArrayInfo( I)[email protected][ lSubscript] = lValue guArrayInfo( I).lMaxValue = lValue FUNCTION = %True END IF EXIT FUNCTION END IF NEXT END FUNCTION '------------------------------------------------------------------------ FUNCTION AoA_Get ALIAS "AoA_Get" (BYVAL lKey AS LONG, _ BYVAL lSubscript AS LONG) EXPORT AS LONG 'Returns data from array if successful, 'returns -1 if lSubscript out of bounds 'returns -2 if lKey not found REGISTER I AS LONG, J AS LONG J = UBOUND( guArrayInfo) 'Find key FOR I = 0 TO J IF guArrayInfo( I).lKey = lKey THEN IF lSubscript >=0 AND lSubscript <= guArrayInfo( I).lUpperBound THEN FUNCTION = guArrayInfo( I)[email protected][ lSubscript] EXIT FUNCTION ELSE 'Need to expand UBOUND of array... FUNCTION = -1 END IF EXIT FUNCTION END IF NEXT 'Need to add array for lKey... FUNCTION = -2 END FUNCTION '------------------------------------------------------------------------ FUNCTION AoA_BinarySearch ALIAS "AoA_BinarySearch" (BYVAL lKey AS LONG, _ BYVAL lValue AS LONG) EXPORT AS LONG 'Returns subscript from array matching lValue OR returns subscript from array containing largest value that is less than lValue 'Assumes array(0) = 0 'returns 0 if lValue <= 0 'returns -1 if lValue > .lMaxValue 'returns -2 if lKey not found REGISTER I AS LONG, J AS LONG LOCAL lArraySubscript AS LONG, lIndex AS LONG IF lValue <= 0 THEN FUNCTION = 0 EXIT FUNCTION END IF J = UBOUND( guArrayInfo) 'Find key FOR I = 0 TO J IF guArrayInfo( I).lKey = lKey THEN IF lValue > guArrayInfo( I).lMaxValue THEN 'Need to expand UBOUND of array... FUNCTION = -1 EXIT FUNCTION END IF lArraySubscript = I I = 0 J = guArrayInfo( lArraySubscript).lUpperBound DO lIndex = (I + J) \ 2 SELECT CASE AS LONG guArrayInfo( lArraySubscript)[email protected][ lIndex] CASE > lValue J = lIndex - 1 CASE < lValue I = lIndex + 1 CASE ELSE ' = lValue FUNCTION = lIndex EXIT FUNCTION END SELECT LOOP UNTIL J < I IF guArrayInfo( lArraySubscript)[email protected][ lIndex] > lValue THEN DECR lIndex FUNCTION = lIndex EXIT FUNCTION END IF NEXT 'Need to add array for lKey... FUNCTION = -2 END FUNCTION '============================<[ Lib Main ]>============================ FUNCTION LIBMAIN(BYVAL InstDLL AS LONG, _ BYVAL Reason AS LONG, _ BYVAL Reserved AS LONG)AS LONG ' InstDLL is the DLL's instance handle. This handle is used by the calling ' application to identify the DLL being called. ' Reason specifies a flag indicating why the DLL entry-point is being called. ' It can be one of the following values: ' %DLL_PROCESS_ATTACH=1: Indicates that the DLL is being loaded by another process ' (a DLL or EXE is loading the DLL). DLLs can use this opportunity to initialize ' any instance or global data, such as arrays. ' %DLL_PROCESS_DETACH=0: Indicates that the DLL is being unloaded or detached from ' the calling application. DLLs can take this opportunity to clean up all ' resources for all threads attached and known to the DLL. ' %DLL_THREAD_ATTACH=2: Indicates that the DLL is being loaded by a new thread in ' the calling application. DLLs can use this opportunity to initialize any thread ' local storage (TLS). ' %DLL_THREAD_DETACH=3: Indicates that the thread is exiting cleanly. If the DLL ' has allocated any thread local storage, it should be released. ' Reserved specifies further aspects of the DLL initialization and cleanup. If ' Reason is %DLL_PROCESS_ATTACH, Reserved is NULL (zero) for dynamic loads ' and non-NULL for static loads. If Reason is %DLL_PROCESS_DETACH, Reserved ' is NULL if LibMain has been called by using the FreeLibrary API call and ' non-NULL if LibMain has been called during process termination. ' Return: If LibMain is called with %DLL_PROCESS_ATTACH, your LibMain function should ' return a zero (0) if any part of your initialization process fails or a one (1) ' if no errors were encountered. If a zero is returned, Windows will abort and ' unload the DLL from memory. When LibMain is called with any other value than ' %DLL_PROCESS_ATTACH, the return value is ignored. IF Reason = 1 THEN InitializeCriticalSection gCriticalSection ELSEIF Reason = 0 THEN DeleteCriticalSection gCriticalSection END IF FUNCTION = 1 END FUNCTION #ENDIF
Comment