How to use dynamic arrays/ strings in UDT

[Marc Pons]

Is it some easy way to manage dynamic arrays ( integer or double) in UDT ?
Same question with dynamic strings and even dynamic array of dynamic strings ?

marc

[Frederick J. Harris]

The answer I would give is no, its not easy, or even something I'd even consider doing.  One of the fundamental ideas behind a UDT is that the size of it remain constant in any given program run.  It can hardly do that if objects of whatever type or added to it or subtracted from it.  Old Visual Basic supported dynamic strings in UDTs I believe, and its my guess that everyone who used that feature now regrets it.

[Charles Pegge]

You can do wonderful things with strings and overlay  arrays. As long as you take good care of scope, you can get in under the radar, so to speak, and devise your own dynamic structures.

Simple example:

Code Select Expand


#COMPILE EXE
#DIM ALL

FUNCTION StringOfStrings() AS STRING
DIM s AS STATIC STRING
s=STRING$(1024*4,CHR$(0))
DIM ss(1023) AS STATIC STRING AT STRPTR(s)
ss(16)="Hello"
FUNCTION=s
END FUNCTION

FUNCTION PBMAIN () AS LONG
DIM s AS STATIC STRING
DIM t AS STRING
s=StringOfStrings()
t=s 'tranferanferability test
DIM ss(1023) AS STRING AT STRPTR(t)
ss(16)+=" World!"
MSGBOX(ss(16))
END FUNCTION


Charles

[John Spikowski]

It would be great if OxygenBasic could be used to solve current limitations PB may have.  (64 bit DLL generation, JIT compiling / embedding, ...)

[Charles Pegge]

That is always a possibility. But PB is a mighty tower block, and Oxygen has but a single storey

[Marc Pons]

Thank you Charles !

but i still do not understand to use your proposal in UDTs

[Charles Pegge]

This is a bit clumpy but gives the general principle:

Code Select Expand


#COMPILE EXE
#DIM ALL

TYPE DynamicArrays
    doubles AS DOUBLE PTR
    singles AS SINGLE PTR
    longs   AS LONG   PTR
END TYPE

FUNCTION PBMAIN () AS LONG
    DIM d AS  STATIC DynamicArrays
    DIM ds AS STATIC STRING
    DIM ss AS STATIC STRING
    DIM ls AS STATIC STRING
    '----------------------
    'create space
    ds=STRING$(&h08000,CHR$(0))
    ss=STRING$(&h04000,CHR$(0))
    ls=STRING$(&h04000,CHR$(0))
    '----------------------
    'store pointers
    d.doubles=STRPTR(ds)
    d.singles=STRPTR(ss)
    d.longs  =STRPTR(ls)
    '----------------------
    'overlay
    DIM dd(&hfff) AS DOUBLE AT d.doubles
    DIM ss(&hfff) AS SINGLE AT d.singles
    DIM ll(&hfff) AS LONG   AT d.longs
    dd(3000)=1234.5
    '-----------------------
    'redimensioning technique
    ds+=STRING$(&h02000,CHR$(0))
    d.doubles=STRPTR(ds)
    DIM dd(&hfff) AS DOUBLE AT d.doubles
    '-----------------------
    MSGBOX(STR$(dd(3000)))
END FUNCTION


Charles

[Marc Pons]

 

very good , it works ( just with some adjusments)

Code Select Expand


#COMPILE EXE
#DIM ALL

TYPE DynamicArrays
    doubles AS DOUBLE PTR
    singles AS SINGLE PTR
    longs   AS LONG   PTR
END TYPE

FUNCTION PBMAIN () AS LONG
    DIM d AS  STATIC DynamicArrays
    DIM ds AS STATIC STRING
    DIM ss AS STATIC STRING
    DIM ls AS STATIC STRING
    '----------------------
    'create space
    ds=STRING$(&h08000,CHR$(0))
    ss=STRING$(&h04000,CHR$(0))
    ls=STRING$(&h04000,CHR$(0))
    '----------------------
    'store pointers
    d.doubles=STRPTR(ds)
    d.singles=STRPTR(ss)
    d.longs  =STRPTR(ls)
    '----------------------
    'overlay
    DIM ds(&hfff) AS DOUBLE AT d.doubles
    DIM ss(&hfff) AS SINGLE AT d.singles
    DIM ls(&hfff) AS LONG   AT d.longs
    ds(3000)=1234.5
    '-----------------------
    'redimensioning technique
    ds+=STRING$(&h02000,CHR$(0))
    d.doubles=STRPTR(ds)
    DIM ds(&hfff) AS DOUBLE AT d.doubles
    '-----------------------
    MSGBOX(STR$(ds(3000)))
END FUNCTION


thanks a lot .
In fact it is similar as it is in FreeBasic
see : http://www.freebasic.net/forum/viewtopic.php?f=7&t=17654&p=155489&hilit=varfield#p155489

[Marc Pons]

 

Here my first test : UDT with dynamic array of dynamic strings

Function/Sub  to dim ; redim(preserve) ;  write and read values

comments are hightly apreciated

Code Select Expand

#Compile Exe

Type DynStringA                                  ' Dynamic String Array  Descriptor
    Ar As Dword                                  ' Ptr To String(0)
    Siz As Integer                               ' Index Of Array
End Type

Type StructUdt                                   ' Udt To Test
    A1 As DynStringA
    A2 As DynStringA
End Type


'Dim Array (0 to Index -1)
Function DynString_Dim(Es As DynStringA, Index As Integer) As Dword
    Dim U                             AS Static String
    U = String$((Index + 1) * 4, Chr$(0))
   
    Es.Ar = Strptr(U)
    Es.Siz = Index
   
    Function = Strptr(U)
End Function

' Redim  Preserve Array (0 to Index -1)
Function DynString_Redim(Es As DynStringA, Index As Integer) As Dword
    Local I                           AS Integer
    Local X                           AS Integer
 
    Dim Us(Es.Siz-1)                  AS String At Es.Ar
    Dim U                             AS Static String

    U = String$((Index + 1) * 4, Chr$(0))

    Dim Ut(Index )                    AS String At Strptr(U)
   
    If Index < Es.Siz Then                       ' If Redim To Reduce Size
        I = Index
    Else
        I = Es.Siz                               ' If Redim To Expand Size
    End If
    For X = 0 To I - 1
        Ut(X) = Us(X)   
    Next
    Erase Us
    Es.Ar = Varptr(Ut(0))
    Es.Siz = Index
   
    Function = Strptr(U)
End Function

' Write To Array
Sub DynString_W(Es As DynStringA, Index As Integer, Value As String)
   
    Dim Ss(Es.Siz -1)                 AS String At Es.Ar
    Ss(Index) = Value
   
End Sub

' Read From Array
Function DynString_R(Es As DynStringA, Index As Integer) As String
    Dim Ss(Es.Siz -1)                 AS String At Es.Ar
    Dim Mess                          AS String
    Mess = Ss(Index)
   
    Function = Mess
End Function

Function Pbmain() As Long
    Dim S                             AS String
    Dim D1                            AS Dword
    Dim D2                            AS Dword
   
    Dim I                             AS Integer
    Dim Tes                           AS DynStringA
    Dim Xes                           AS DynStringA
    Dim Udt                           AS StructUdt
   
    Udt.A1 = Tes
    Udt.A2 = Xes
   
    D1 = DynString_Dim(Udt.A1, 100)              'Dim (0 To 99)
    D2 = DynString_Dim(Udt.A2, 100)              'Dim (0 To 99)
   
    DynString_W(Udt.A1, 0, "Pos 0 ")             'Write Value Index 0
    DynString_W(Udt.A2, 0, "Pos 0 ")             'Write Value Index 0

    'Write Value Index 90
    DynString_W(Udt.A1, 90, "Test For Verification : ")

    S = DynString_R(Udt.A1, 90)                  'Read Value Index 90
    DynString_W(Udt.A2, 8, " To Check !!!")      'Write Value Index 8
    DynString_W(Udt.A2, 16, " Pos16!!!")         'Write Value Index 16
    S = S & DynString_R(Udt.A2, 8)               'Read Value Index 8
    Msgbox(S)
    S = ""
    For I = 0 To 20
        'Read Value
        S = S & Str$(I) & " - " & DynString_R(Udt.A2, I) & $CRLF
    Next
    Msgbox(S)
   
    D1 = DynString_Redim(Udt.A2, 15)             ' Redim (0 To 14)
   
    S = ""
    For I = 0 To 14
        'Read Value
        S = S & Str$(I) & " - " & DynString_R(Udt.A2, I) & $CRLF
    Next
    Msgbox(S)
   
    D1 = DynString_Redim(Udt.A2, 20)             ' Redim (0 To 19)
   
    S = ""
    For I = 0 To 19
        'Read Value
        S = S & Str$(I) & " - " & DynString_R(Udt.A2, I) & $CRLF
    Next
    Msgbox(S)
   
End Function




[Charles Pegge]

Hi Marc,

Another approach is to use PB objects. These will support dynamic arrays. There is a significant amount of baggage that comes with this object construct, but it may be less complex to implement your dynamic UDTs this way.

My first foray into PB (v 9.03) objects

Code Select Expand


#COMPILE EXE
#DIM ALL

CLASS classA
  '
  INSTANCE a(),b,c AS LONG
  '
  CLASS METHOD CREATE()
  DIM a(100) AS LONG
  END METHOD
  '
  CLASS METHOD DESTROY()
  END METHOD
  '
  CLASS METHOD redimA(n AS LONG) AS LONG
  REDIM a(n)
  END METHOD
  '
  INTERFACE interfaceA
  INHERIT IUNKNOWN
  '
  PROPERTY GET p1() AS LONG
  PROPERTY=b
  END PROPERTY
  '
  PROPERTY SET p1(x AS LONG)
  b=x
  END PROPERTY
  '
  '
  METHOD REDIM(n AS LONG) AS LONG
  me.redimA(n)
  END METHOD

END INTERFACE
END CLASS


FUNCTION PBMAIN () AS LONG
  DIM ob AS interfaceA : LET ob=CLASS "classA"
  ob.redim(100)
  ob.p1=42
  MSGBOX(STR$(ob.p1))
  ob=NOTHING
END FUNCTION


Charles

[Marc Pons]

Charles , thank you again for your advices
but I am not yet good enought to understand, class , methods , interfaces, propreties...
my knowledge is not so deep !

In my hard way I've continued with my sample for strings, integers , doubles
here the code

Code Select Expand

#Compile Exe

Type DynStringA                                  ' Dynamic String Array  Descriptor
    Ar As Dword                                  ' Ptr To String(0)
    Siz As Integer                               ' Ubound +1 Of Array
    Fil as Integer                               ' N° variable for static position
End Type

Type DynIntegerA                                 ' Dynamic Integer Array  Descriptor
    I_Ar As Dword                                ' Ptr To Integer(0)
    I_Siz As Integer                             ' Ubound +1 Of Array
    I_Fil as Integer                             ' N° variable for static position
End Type

Type DynDoubleA                                  ' Dynamic Integer Array  Descriptor
    D_Ar As Dword                                ' Ptr To Integer(0)
    D_Siz As Integer                             ' Ubound +1 Of Array
    D_Fil as Integer                             ' N° variable for static position
End Type

Type StructUdt                                   ' Udt To Test
    A1 As DynStringA
    A2 As DynStringA
    A3 AS DynIntegerA
    A4 As DynDoubleA
    A5 AS DynIntegerA
    A6 As DynDoubleA
End Type

'###############################################################################
'Dim String Array (0 to Index -1)
Function DynString_Dim(Es As DynStringA, Index As Integer) As Dword
    Dim U(100)                        AS Static String
    Dim I(100)                        AS static integer
   
    LOCAL x                           AS integer
    LOCAL y                           AS integer
    For x = 0 To 99
        if I(x) = 0 THEN
            I(x) = 1
            Es.Fil = x + 1
            y = x
            Exit for
        END IF
    NEXT
   
    U(y) = String$((Index) * 4, Chr$(0))
   
    Es.Ar = Strptr(U(y))
    Es.Siz = Index
   
    Function = Strptr(U(y))
End Function

' Redim  Preserve String Array (0 to Index -1)
Function DynString_Redim(Es As DynStringA, Index As Integer) As Dword
    Local I                           AS Integer
    Local X                           AS Integer
    Local y                           AS Integer
    y = Es.Fil
    Dim Us(Es.Siz-1)                  AS String At Es.Ar
    Dim U(100)                        AS Static String
   
    U(y) = String$((Index) * 4, Chr$(0))
   
    Dim Ut(Index )                    AS String At Strptr(U(y))
   
    If Index < Es.Siz Then                       ' If Redim To Reduce Size
        I = Index
    Else
        I = Es.Siz                               ' If Redim To Expand Size
    End If
    For X = 0 To I - 1
        Ut(X) = Us(X)
    Next
    Erase Us
    Es.Ar = Varptr(Ut(0))
    Es.Siz = Index
   
    Function = Varptr(Ut(0))
End Function

' Write To String Array
Sub DynString_W(Es As DynStringA, Index As Integer, Value As String)
   
    Dim Ss(Es.Siz -1)                 AS String At Es.Ar
    Ss(Index) = Value
   
End Sub

' Read From String Array
Function DynString_R(Es As DynStringA, Index As Integer) As String
    Dim Ss(Es.Siz -1)                 AS String At Es.Ar
    Dim Mess                          AS String
    Mess = Ss(Index)
   
    Function = Mess
End Function
'###############################################################################

'###############################################################################
'Dim Integer Array (0 to Index -1)
Function DynInteger_Dim(Es As DynIntegerA, Index As Integer) As Dword
    Dim U(100)                        AS Static String
    Dim I(100)                        AS static integer
   
    LOCAL x                           AS integer
    LOCAL y                           AS integer
    For x = 0 To 99
        if I(x) = 0 THEN
            I(x) = 1
            Es.I_Fil = x + 1
            y = x
            Exit for
        END IF
    NEXT
    U(y) = String$((Index) * 4, Chr$(0))
   
    Es.I_Ar = Strptr(U(y))
    Es.I_Siz = Index
   
    Function = Strptr(U(y))
End Function

' Redim  Preserve Integer Array (0 to Index -1)
Function DynInteger_Redim(Es As DynIntegerA, Index As Integer) As Dword
    Local I                           AS Integer
    Local X                           AS Integer
    Local y                           AS Integer
    y = Es.I_Fil
   
    Dim Us(Es.I_Siz-1)                AS Integer At Es.I_Ar
    Dim U(100)                        AS Static String
   
    U(y) = String$((Index) * 4, Chr$(0))
   
    Dim Ut(Index )                    AS Integer At Strptr(U(y))
   
    If Index < Es.I_Siz Then                     ' If Redim To Reduce Size
        I = Index
    Else
        I = Es.I_Siz                             ' If Redim To Expand Size
    End If
   
    For X = 0 To I - 1
        Ut(X) = Us(X)
    Next
   
    Erase Us
    Es.I_Ar = Varptr(Ut(0))
    Es.I_Siz = Index
   
    Function = Varptr(Ut(0))
End Function

' Write To Integer Array
Sub DynInteger_W(Es As DynIntegerA, Index As Integer, Value As Integer)
   
    Dim Ss(Es.I_Siz -1)               AS Integer At Es.I_Ar
    Ss(Index) = Value
   
End Sub

' Read From Integer Array
Function DynInteger_R(Es As DynIntegerA, Index As Integer) As Integer
    Dim Ss(Es.I_Siz -1)               AS Integer At Es.I_Ar
    Dim Mess                          AS Integer
    Mess = Ss(Index)
   
    Function = Mess
End Function
'###############################################################################

'###############################################################################
'Dim DynDoubleA Array (0 to Index -1)
Function DynDouble_Dim(Es As DynDoubleA, Index As Integer) As Dword
    Dim U(100)                        AS Static String
    Dim I(100)                        AS static integer
   
    LOCAL x                           AS integer
    LOCAL y                           AS integer
    For x = 0 To 99
        if I(x) = 0 THEN
            I(x) = 1
            Es.D_Fil = x + 1
            y = x
            Exit for
        END IF
    NEXT
   
    U(y) = String$((Index) * 8, Chr$(0))
   
   
    Es.D_Ar = Strptr(U(y))
    Es.D_Siz = Index
   
    Function = Strptr(U(y))
End Function

' Redim  Preserve Integer Array (0 to Index -1)
Function DynDouble_Redim(Es As DynDoubleA, Index As Integer) As Dword
    Local I                           AS Integer
    Local X                           AS Integer
    Local y                           AS Integer
    y = Es.D_Fil
   
    Dim Us(Es.D_Siz-1)                AS Double At Es.D_Ar
    Dim U(100)                        AS Static String
   
    U(y) = String$((Index) * 8, Chr$(0))
   
    Dim Ut(Index )                    AS Double At Strptr(U(y))
   
    If Index < Es.D_Siz Then                     ' If Redim To Reduce Size
        I = Index
    Else
        I = Es.D_Siz                             ' If Redim To Expand Size
    End If
    For X = 0 To I - 1
        Ut(X) = Us(X)
    Next
    Erase Us
    Es.D_Ar = Varptr(Ut(0))
    Es.D_Siz = Index
   
    Function = Varptr(Ut(0))
End Function

' Write To Double Array
Sub DynDouble_W(Es As DynDoubleA, Index As Integer, Value As Double)
   
    Dim Ss(Es.D_Siz -1)               AS Double At Es.D_Ar
    Ss(Index) = Value
   
End Sub

' Read From Double Array
Function DynDouble_R(Es As DynDoubleA, Index As Integer) As Double
    Dim Ss(Es.D_Siz -1)               AS Double At Es.D_Ar
    Dim Mess                          AS Double
    Mess = Ss(Index)
   
    Function = Mess
End Function
'###############################################################################


'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Function Pbmain() As Long
    Dim S                             AS String
    Dim D1                            AS Dword
    Dim D2                            AS Dword
   
    Dim I                             AS Integer
    Dim Tes                           AS DynStringA
    Dim Xes                           AS DynStringA
    Dim Ies                           AS DynIntegerA
    Dim Des                           AS DynDoubleA
    Dim Ies2                          AS DynIntegerA
    Dim Des2                          AS DynDoubleA
    Dim Udt                           AS StructUdt
   
    Udt.A1 = Tes
    Udt.A2 = Xes
    Udt.A3 = Ies
    Udt.A4 = Des
    Udt.A5 = Ies2
    Udt.A6 = Des2
   
    D1 = DynString_Dim(Udt.A1, 100)              'Dim (0 To 99)
    D2 = DynString_Dim(Udt.A2, 100)              'Dim (0 To 99)
   
    DynString_W(Udt.A1, 0, "Pos 0 ")             'Write Value Index 0
    DynString_W(Udt.A2, 0, "Pos 0 ")             'Write Value Index 0
   
    'Write Value Index 90
    DynString_W(Udt.A1, 90, "Test for verification : ")
   
    S = DynString_R(Udt.A1, 90)                  'Read Value Index 90
    DynString_W(Udt.A2, 8, " To Check !!!")      'Write Value Index 8
    DynString_W(Udt.A2, 16, " Pos16!!!")         'Write Value Index 16
    S = S & DynString_R(Udt.A2, 8)               'Read Value Index 8
    Msgbox S, %MB_OK, "String1"
    S = ""
    For I = 0 To 20
        'Read Value
        S = S & Str$(I) & " - " & DynString_R(Udt.A2, I) & $CRLF
    Next
    Msgbox S, %MB_OK, "String2"
   
    D1 = DynString_Redim(Udt.A2, 15)             ' Redim (0 To 14)
    '           DynString_Redim(Udt.A1, 15)             ' Redim (0 To 14)
    S = ""
    For I = 0 To 14
        'Read Value
        S = S & Str$(I) & " - " & DynString_R(Udt.A2, I) & $CRLF
    Next
    Msgbox S, %MB_OK, "String3"
   
    D1 = DynString_Redim(Udt.A2, 20)             ' Redim (0 To 19)
   
    S = ""
    For I = 0 To 19
        'Read Value
        S = S & Str$(I) & " - " & DynString_R(Udt.A2, I) & $CRLF
    Next
    Msgbox S, %MB_OK, "String4"
   
    DynInteger_Dim(Udt.A3, 50)                   'Dim (0 To 49)
    DynInteger_W(Udt.A3, 1, 1)                   'Write Value Index 1
    DynInteger_W(Udt.A3, 10, 10)                 'Write Value Index 10
    S = ""
    For I = 0 To 19
        'Read Value
        S = S & Str$(I) & " - " & str$(DynInteger_R(Udt.A3, I)) & $CRLF
    Next
    Msgbox S, %MB_OK, "Integer1"
    DynInteger_Redim(Udt.A3, 2)                  ' Redim (0 To 1)
   
    DynInteger_W(Udt.A3, 0, 100)                 'Write Value Index 0
   
    DynInteger_Redim(Udt.A3, 20)                 ' Redim (0 To 19)
    S = ""
    For I = 0 To 19
        'Read Value
        S = S & Str$(I) & " - " & str$(DynInteger_R(Udt.A3, I)) & $CRLF
    Next
    Msgbox S, %MB_OK, "Integer2"
   
   
    DynDouble_Dim(Udt.A4, 50)                    'Dim (0 To 49)
    DynDouble_W(Udt.A4, 1, 1.25#)                'Write Value Index 1
    DynDouble_W(Udt.A4, 10, 10.37#)              'Write Value Index 10
    S = ""
    For I = 0 To 19
        'Read Value
        S = S & Str$(I) & " - " & str$(DynDouble_R(Udt.A4, I)) & $CRLF
    Next
    Msgbox S, %MB_OK, "Double1"
    DynDouble_Redim(Udt.A4, 2)                   ' Redim (0 To 1)
    DynDouble_W(Udt.A4, 0, 100.999999999998#)    'Write Value Index 1
    DynDouble_Redim(Udt.A4, 20)                  ' Redim (0 To 19)
    S = ""
    For I = 0 To 19
        'Read Value
        S = S & Str$(I) & " - " & str$(DynDouble_R(Udt.A4, I)) & $CRLF
    Next
    Msgbox S, %MB_OK, "Double2"
   
    DynString_Redim(Udt.A1, 20)
    DynString_Redim(Udt.A2, 20)
    DynInteger_Redim(Udt.A3, 20)
    DynDouble_Redim(Udt.A4, 20)
    DynInteger_Redim(Udt.A5, 20)
    DynDouble_Redim(Udt.A6, 20)
   
    for I = 0 to 19
        DynString_W(Udt.A1, I, "A1 Pos: " & str$(I))
        DynString_W(Udt.A2, I, "A2 Pos: " & str$(I))
        DynInteger_W(Udt.A3, I, 100 + I)
        DynDouble_W(Udt.A4, I, 100.1 + I)
        DynInteger_W(Udt.A5, I, 200 + I)
        DynDouble_W(Udt.A6, I, 200.2 + I)
    NEXT
   
    Test_All Udt
End Function

sub Test_All(byRef S1 as StructUdt)
   
    LOCAL I                           AS integer
    LOCAL mess                        AS string
    Msgbox str$(S1.A1.Siz)
    mess = ""
    For I = 0 to S1.A1.Siz - 1
        mess = mess & Str$(I)
       
        mess = mess & "    A1 : " & DynString_R(S1.A1, I)
        mess = mess & "    A2 : " & DynString_R(S1.A2, I)
        mess = mess & "    A3 : " & str$(DynInteger_R(S1.A3, I))
        mess = mess & "    A4 : " & str$(DynDouble_R(S1.A4, I))
        mess = mess & "    A5 : " & str$(DynInteger_R(S1.A5, I))
        mess = mess & "    A6 : " & str$(DynDouble_R(S1.A6, I))
        mess = mess & $CRLF
       
    NEXT
    Msgbox mess, %MB_OK, "Test_All"
END sub



It works , but i am not very happy to store the info into a static array of string (100)
I had to do that because when i used more than 1 array of the same type i had to maintain the position of data when dim/ redim. I also use an integer static array to track the position, modified each time i dim a new array.

I decided to allow 100 positions , the idea is to create an include file to make this stuff more general.

[Marc Pons]

Updated info

To be used in UDT / Union structures
              Dynamic String's      (no dim/redim functions  : not needed simplified form of string array )
              Dynamic arrays of
                          - Dynamic String's 
                          - Byte's ; Integer's ; Word's ; long's; DWord's; Quad's
                          - Single's ; Double's ; Currency's ; Extended's

            with functions/subs  dim , redim , Set , Get  :
            notice if not dim or redim  before Set/Get value the array is dim as the ubound = index +1

All the data are stored via a static array of strings dimentioned at 20 arrays or strings
See the line 73 in .inc file
%MAX_ARRAYS                       = 20           ' increase size, if you need more

Marc

.inc file + test.bas in the attachment here

[Frederick J. Harris]

Hi Marc!

     You had originally asked if there was an easy way to include variable quantities of data in UDTs.  I suppose a lot depends on how you define 'easy'!

     This isn't a lot different from what Charles suggested, but here is a small console program with output that shows how I'd do it with pointers and memory allocations.  If you don't have the console compiler, print the output to a file.  My example just uses integers, but could be extended to include any type of data.  Also, no data is stored in the program's static/global data area ...

Code Select Expand


#Compile    Exe
#Dim        All
#Include    "Windows.inc"
%SIZEOF_INT = 4

Type DynamicIntegers
  pInts    As Long Ptr
  iCount   As Long
End Type

Function PBMain() As Long
  Local DymInts As DynamicIntegers
  Local blnFree As Long
  Register i As Long
  Register j As Long

  For i = 1 To 10
    Print "Run #" i
    DymInts.iCount = Rnd(0,10)
    DymInts.pInts = GlobalAlloc(%GPTR, DymInts.iCount * %SIZEOF_INT)
    Print "DynInts.iCount  = " DymInts.iCount
    Print "DymInts.pInts   = " DymInts.pInts
    Print "sizeof(DymInts) = " sizeof(DymInts)
    Print
    For j=0 To DymInts.iCount -1
      DymInts.@pInts[j]=Rnd(100,999)
    Next j
    Print " j      Varptr(DymInts.@pInts[j])    DymInts.@pInts[j]"
    Print "======================================================"
    For j=0 To DymInts.iCount -1
      Print j, Varptr(DymInts.@pInts[j]), , DymInts.@pInts[j]
    Next j
    Print
    blnFree=GlobalFree(DymInts.pInts)
    Print "blnFree = " blnFree  : Print : Print
  Next i
  Waitkey$

  PBMain=0
End Function

'Run # 1
'DynInts.iCount  =  10
'DymInts.pInts   =  1348984
'sizeof(DymInts) =  8
'
' j      Varptr(DymInts.@pInts[j])    DymInts.@pInts[j]
'======================================================
' 0             1348984                     281
' 1             1348988                     567
' 2             1348992                     219
' 3             1348996                     886
' 4             1349000                     122
' 5             1349004                     528
' 6             1349008                     956
' 7             1349012                     386
' 8             1349016                     792
' 9             1349020                     720
'
'blnFree =  0
'
'
'Run # 2
'DynInts.iCount  =  9
'DymInts.pInts   =  1348984
'sizeof(DymInts) =  8
'
' j      Varptr(DymInts.@pInts[j])    DymInts.@pInts[j]
'======================================================
' 0             1348984                     370
' 1             1348988                     659
' 2             1348992                     843
' 3             1348996                     702
' 4             1349000                     519
' 5             1349004                     965
' 6             1349008                     299
' 7             1349012                     962
' 8             1349016                     596
'
'blnFree =  0
'
'
'Run # 3
'DynInts.iCount  =  10
'DymInts.pInts   =  1348984
'sizeof(DymInts) =  8
'
' j      Varptr(DymInts.@pInts[j])    DymInts.@pInts[j]
'======================================================
' 0             1348984                     216
' 1             1348988                     505
' 2             1348992                     996
' 3             1348996                     273
' 4             1349000                     716
' 5             1349004                     700
' 6             1349008                     435
' 7             1349012                     168
' 8             1349016                     832
' 9             1349020                     481
'
'blnFree =  0
'
'
'Run # 4
'DynInts.iCount  =  5
'DymInts.pInts   =  1351600
'sizeof(DymInts) =  8
'
' j      Varptr(DymInts.@pInts[j])    DymInts.@pInts[j]
'======================================================
' 0             1351600                     821
' 1             1351604                     612
' 2             1351608                     514
' 3             1351612                     187
' 4             1351616                     953
'
'blnFree =  0
'
'
'Run # 5
'DynInts.iCount  =  6
'DymInts.pInts   =  1351600
'sizeof(DymInts) =  8
'
' j      Varptr(DymInts.@pInts[j])    DymInts.@pInts[j]
'======================================================
' 0             1351600                     909
' 1             1351604                     224
' 2             1351608                     807
' 3             1351612                     981
' 4             1351616                     505
' 5             1351620                     258
'
'blnFree =  0
'
'
'Run # 6
'DynInts.iCount  =  2
'DymInts.pInts   =  1351632
'sizeof(DymInts) =  8
'
' j      Varptr(DymInts.@pInts[j])    DymInts.@pInts[j]
'======================================================
' 0             1351632                     908
' 1             1351636                     577
'
'blnFree =  0
'
'
'Run # 7
'DynInts.iCount  =  9
'DymInts.pInts   =  1348984
'sizeof(DymInts) =  8
'
' j      Varptr(DymInts.@pInts[j])    DymInts.@pInts[j]
'======================================================
' 0             1348984                     872
' 1             1348988                     918
' 2             1348992                     757
' 3             1348996                     792
' 4             1349000                     307
' 5             1349004                     340
' 6             1349008                     360
' 7             1349012                     777
' 8             1349016                     830
'
'blnFree =  0
'
'
'Run # 8
'DynInts.iCount  =  0
'DymInts.pInts   =  1351632
'sizeof(DymInts) =  8
'
' j      Varptr(DymInts.@pInts[j])    DymInts.@pInts[j]
'======================================================
'
'blnFree =  0
'
'
'Run # 9
'DynInts.iCount  =  5
'DymInts.pInts   =  1351600
'sizeof(DymInts) =  8
'
' j      Varptr(DymInts.@pInts[j])    DymInts.@pInts[j]
'======================================================
' 0             1351600                     459
' 1             1351604                     144
' 2             1351608                     197
' 3             1351612                     328
' 4             1351616                     501
'
'blnFree =  0
'
'
'Run # 10
'DynInts.iCount  =  2
'DymInts.pInts   =  1351632
'sizeof(DymInts) =  8
'
' j      Varptr(DymInts.@pInts[j])    DymInts.@pInts[j]
'======================================================
' 0             1351632                     299
' 1             1351636                     127
'
'blnFree =  0


Note in all cases the size of the UDT, which I've output in each run,  remains constant at 8 bytes, yet is able to store any variable quantity of data.

[Marc Pons]

Hy Frederick

Thank you for your suggestions and your sample .

I understand the principes , allocating memory to put the data in and use the pointer to that portion of memory to set and get the content , plus the ubound of the "array" to define the dimention of that allocated memory

In fact it is a similar way I've investigated , using Static array of strings  in a function to allocate "permanent" content.

My first idea was to provide an easy way not only on the container to store and retreive information (wich i figured out  > allocating memory and adress to that)
but also on how to monitor that ( without sophisticated pointer management ), if you look on my previous post it is an attachment: it is what i intend to do a .inc file to have generic fonctions for different predifined types.
i proposed someting  like       
String_G(Udt.A2,12)                  'Get  string Value Index 12 from utd array A2
Long_G(Udt.A3,10)                  'Get  Long Value Index 10 from utd array A3
or
DString_G(Udt.S15)                   'Get  string  from utd dynamic string S15

I have done that with  Dynamic String's
         and     Dynamic arrays of
                          - Dynamic String's
                          - Byte's ; Integer's ; Word's ; long's; DWord's; Quad's
                          - Single's ; Double's ; Currency's ; Extended's

[Stan Duraham]

Marc Pons: Is it some easy way to manage dynamic arrays ( integer or double) in UDT ?
Same question with dynamic strings and even dynamic array of dynamic strings ?

You can download HLib: http://www.deadtheorywalking.com/power_basic_code/hlib.html

It allows you to store Strings and Dynamic Arrays in a UDT; also Trees and Hashes.
The Arrays are fully automatic; you don't need to ReDim for append, insert and delete (although you can).