Results 1 to 3 of 3

Thread: tHeap + extension tTypedHeap

  1. #1
    thinBasic MVPs
    Join Date
    Oct 2012
    Location
    Germany
    Age
    54
    Posts
    1,527
    Rep Power
    170

    tHeap + extension tTypedHeap

    What's this?

    Some "Heap-Class"

    You may declare any variable to be tHeap-Memory. tHeap can store anything.
    More sophisticated the Extension tTypedHeap, allows to store a variable-type/udt-information together with the data but also uses just 4 bytes to store a pointer.
    Any more information gets stored to the types static members

    tTypedHeap is dynamic arrays of any fixed size type as well as dynamic strings, data from heap can be saved & loaded by just one call.

    3 Units
    (one just to enumerate type-names, required by tHeap-Unit)

    ' Filename "Type_Enumerate.tBasicU"
    
    ' to create a global uniform Type-name-enumeration 
    ' every type gets stored only once 
    ' the "enumerated" number can be used to compare types.
    
    ' every "enumerated" number is unique since it's a memory-pointer 
    ' which is valid until the script ends
    
    ' all type-names get stored in UCase and can be read out at this 
    ' pointer using Heap_Get() 
                                                                                      
    '---------------------------------------------------------------------------------
    Function Type_Enumerate(ByVal sType     As String, _
                   Optional ByVal TestExist As Boolean _
                            ) As DWord
    '---------------------------------------------------------------------------------
      
      Static hAllTypes As DWord   
           ' this points a heap with a list of pointers to all enumerated type-names
      
      Local Index    As Long   ' will hold the index of requested pointer
           
      
      If Not Type_Exists(sType) Then Return 0 ' if it's not a type then return nothing
      
      sType = Ucase$(sType) ' from here all type-names work in UCASE
      
      If HEAP_Size(hAllTypes) Then    ' are there any pointers already?     
        ' place virtual Dword-array upon the pointer-list:
        Local vPtr(HEAP_Size(hAllTypes)/4) As DWord At hAllTypes
       
       ' and scan if any of the list points the requested type-name
        Index = Array Scan vPtr Ptr, = sType
     
        If Index Then 
          Return vPtr(Index)
        EndIf
        
      EndIf                
      
      ' does not exist yet:
      If TestExist Then Return 0
     
      ' store sType and append its Pointer to function-static hAllTypes
      hAllTypes = HEAP_ReAllocByStr(hAllTypes, HEAP_Get(hAllTypes) & MKDWD$(HEAP_AllocByStr(sType)) )
      
      ' return last appended pointer
      Function = Peek(DWord, HEAP_End(hAllTypes) - 3 )
      
      ' use Heap_Get on the result to read the type-name out
      
    End Function
    

    this the unit that contains all the heap-functions:
    #MINVERSION 1.9.15.0
    ' Filename "tHeap.tBasicU"
    
    #INCLUDE Once "Type_Enumerate.tBasicU"
    
    ' #####################################################################
    Type tHeap
    ' #####################################################################
      pData      As DWord  
      
      Static allowZeroAllocation As Boolean ' global setting to all tHeap
      
      Alloc        As Function 
      ReAlloc      As Function
      
      AllocByStr   As Function
      
      GetSize      As Function   ' i.e. Size in Bytes
      
      Copy         As Function
      EndPtr       As Function   ' position of last Byte = Heap_End()
      Free         As Function
      
      GetBytes     As Function   ' replaces Heap_Get, Heap_Left, Heap_Mid, Heap_Right
      GetData      As Function   ' Heap_Get
      
      Load         As Function
      Save         As Function
      
    
    End Type 
      
    ' ----------------------------------------------------------------------
    Function tHeap.Alloc(ByVal nBytes As Long) As DWord
    ' ----------------------------------------------------------------------
      If nBytes < 1 Then
        HEAP_ReAllocByStr(Me.pData, "", Me.allowZeroAllocation)
      Else
        Me.pData = HEAP_Alloc(nBytes)
      EndIf
      Function = Me.pData
      
    End Function 
     
    ' ----------------------------------------------------------------------
    Function tHeap.ReAlloc(ByVal nBytes As Long) As DWord
    ' ----------------------------------------------------------------------
    
      If nBytes < 1 Then
        HEAP_ReAllocByStr(Me.pData, "", Me.allowZeroAllocation)
      Else 
        Me.pData = HEAP_Realloc(Me.pData, nBytes)
      EndIf
      
      Function = Me.pData
    
    End Function   
    
    ' ----------------------------------------------------------------------
    Function tHeap.AllocByStr(ByVal sData As String) As DWord
    ' ----------------------------------------------------------------------
      ' works as re-alloc also
      
      Me.pData = HEAP_ReAllocByStr(Me.pData, sData, Me.allowZeroAllocation)
      Function = Me.pData
      
    End Function
    
    ' ----------------------------------------------------------------------
    Function tHeap.Copy(ByRef Sourceheap As tHeap) As DWord
    ' ----------------------------------------------------------------------
      
      Me.pData = HEAP_ReAllocByStr(Me.pData, HEAP_Get(Sourceheap.pData), Me.allowZeroAllocation )
      Function = Me.pData
      
    End Function
    
    ' ----------------------------------------------------------------------
    Function tHeap.EndPtr() As DWord
    ' ----------------------------------------------------------------------
      Function = HEAP_End(Me.pData)
    
    End Function
    
    
    ' ----------------------------------------------------------------------
    Function tHeap.Free() As DWord
    ' ----------------------------------------------------------------------
      HEAP_Free( Me.pData )
      Me.pData = 0
      Function = 0
    
    End Function 
    
    
    ' ----------------------------------------------------------------------
    Function tHeap.GetSize() As Long
    ' ----------------------------------------------------------------------
      Function = HEAP_Size(Me.pData)
    
    End Function   
      
    
    ' ----------------------------------------------------------------------
    Function tHeap.GetBytes( _
                    Optional ByVal bFirst As Long, _
                             ByVal bCount As Long  _
                            ) As String
    ' ----------------------------------------------------------------------
      
      
      If HEAP_Size(Me.pData) = 0 Then Exit Function
      
      If bCount < 1 Then
        If bFirst < 1 Then
          ' = all bytes by default:
          Return HEAP_Get(Me.pData)
        EndIf 
        ' use all starting with the first 
         
        bCount = HEAP_Size(Me.pData) - bFirst + 1
      EndIf
      
      If Between(bFirst, 1, HEAP_Size(Me.pData)) Then
        bCount = MinMax(bCount, 1, HEAP_Size(Me.pData) - bFirst + 1)
        Return Memory_Get(Me.pData + bFirst - 1, bCount)
      Else
        ' first out of range, so take bCount bytes from the end
        bCount = MinMax(bCount, 1, HEAP_Size(Me.pData))
        Return Memory_Get(HEAP_End(Me.pData) - bCount + 1, bCount )
      EndIf  
      
    End Function   
    
    ' ----------------------------------------------------------------------
    Function tHeap.GetData() As String
    ' ----------------------------------------------------------------------
      If HEAP_Size(Me.pData) = 0 Then Exit Function
      Function = Memory_Get(Me.pData, HEAP_Size(Me.pData))
      
    
    End Function   
    
    ' ----------------------------------------------------------------------
    Function tHeap.Load(ByVal sFilename As String) As DWord
    ' ----------------------------------------------------------------------   
    
      Function = Me.AllocByStr(Load_File(sFilename))
    End Function   
    
    ' ----------------------------------------------------------------------
    Function tHeap.Save(ByVal sFilename As String) As Boolean
    ' ----------------------------------------------------------------------
      Function = ( Save_File( sFilename, HEAP_Get(Me.pData) ) = 0 )
      
    End Function   
    
    ' ----------------------------------------------------------------------
    ' Function tHeap. ()
    ' ----------------------------------------------------------------------
    ' End Function   
    
    
    ' ######################################################################
    Type tTypedHeap Extends tHeap
    ' ######################################################################
      Static pTypes   As DWord
      Static pVarPtrs As DWord
      
      GetKeyIndex     As Function 
    
      AllocAs         As Function
      Free            As Function
      
      GetData         As Function
      GetType         As Function
      GetUBound       As Function
      
      SetData         As Function
      AddData         As Function
      
      Load            As Function
      Save            As Function
      
    End Type
    
    ' PRIVATE  
    '---------------------------------------------------------------------------------
    Function tTypedHeap.GetKeyIndex(Optional ByVal testExist As Boolean) As Long
    '---------------------------------------------------------------------------------
     
      ' returns Index of this if available 
      ' or creates new slot if not testExist
       
      ' the local key is the varptr:
      Local lKey    As DWord = VarPtr(Me)
      Local lResult As Long
       
      If HEAP_Size(Me.pVarptrs) >= 4 Then
         
        Local lPtr(HEAP_Size(Me.pVarptrs)/4) As DWord At Me.pVarPtrs 
       
        lResult = Array Scan lPtr, = lKey 
         
        If lResult Then Return lResult
      EndIf
       
      If testExist Then Return 0
       
      ' make a new one:
       
      Me.pVarptrs = HEAP_ReAllocByStr(Me.pVarptrs, HEAP_Get(Me.pVarptrs) & MKDWD$(lKey))
      Me.pTypes   = HEAP_ReAllocByStr(Me.pTypes,   HEAP_Get(Me.pTypes) & MKDWD$(0))
       
      Function = HEAP_Size(Me.pVarptrs)/4
       
       
    End Function
     
     
    ' PUBLIC
    '--------------------------------------------------------------------------------- 
    Function tTypedHeap.AllocAs(ByVal sType As String,     _
                       Optional ByVal lUbound As Long = 1, _
                                ByVal sData   As String    _
                                ) As String
    '---------------------------------------------------------------------------------
       
      ' this will allocate desired space and store the types name
       
       
      Local kI        As Long   = Me.GetKeyIndex()
      Local pType(kI) As DWord At Me.pTypes
       
      If HEAP_Size(Me.pData) Then Me.Free()
         
      pType(kI) = Type_Enumerate(sType)
      If Not pType(kI) Then Return "Byte"
       
      lUbound = MinMax(lUbound, 1, &H7FFFFFFF )
       
      If HEAP_Get(pType(kI)) = "STRING" Then
        '  = dword-array of heap-pointers
        Me.pData = HEAP_Alloc(lUbound * 4)
        If StrPtrLen(StrPtr(sData)) Then
          Poke(DWord, Me.pData, HEAP_AllocByStr(sData))
        EndIf  
        Function = "DWORD"
      Else
        Local data Like sType At 0
        Select Case StrPtrLen(StrPtr(sData)) 
          Case 0
            Me.pData = HEAP_Alloc(lUbound * SizeOf(data))
          Case >= lUbound * SizeOf(data)
             Me.pData = HEAP_AllocByStr(sData)
          Case Else
            Me.pData = HEAP_Alloc(lUbound * SizeOf(data))
            Memory_Set(Me.pData, sData)
        End Select  
        
        Function = sType  
      EndIf 
       
    End Function
     
    '---------------------------------------------------------------------------------
    Function tTypedHeap.Free() As DWord
    '---------------------------------------------------------------------------------
      
      ' free the data only!
      ' this won't change/delete the previously assigned type
      ' type will stay valid until .AllocAs("something else")
      
      If Me.GetType() = "STRING" Then
        If HEAP_Size(Me.pData) > 3 Then
          Local pData As DWord At Me.pData
          Do
            HEAP_Free(pData)
            SetAt(pData, GetAt(pData)+4)
          Loop Until GetAt(pData) > HEAP_End(Me.pData) 
        EndIf    
      EndIf
      
      HEAP_Free(Me.pData)
      Me.pData = 0
       
    End Function
     
    '---------------------------------------------------------------------------------
    Function tTypedHeap.GetType() As String
    '---------------------------------------------------------------------------------
      ' this will return the stored Type-name if one
       
       
      Local kI As Long = Me.GetKeyIndex(TRUE) ' true means check for existance
       
      If kI = 0 Then Return "byte" ' get out of here
        
      Local pType(kI) As DWord At Me.pTypes
       
      Function = HEAP_Get(pType(kI))
       
    End Function
    
    '---------------------------------------------------------------------------------
    Function tTypedHeap.GetData( Optional ByVal Index As Long,       _
                                          ByVal sSeperator As String _
                                ) As String
    '---------------------------------------------------------------------------------
       
      ' returns element(Index)-data
       
      Local kI As Long = Me.GetKeyIndex(TRUE)
      If Not kI Then Exit Function 
      Local pType(kI) As DWord At Me.pTypes
      
      If Not HEAP_Size(Me.pData) Then Exit Function
      
      If HEAP_Get(pType(kI)) = "STRING" Then
        If Between(Index, 1, Me.GetUBound ) Then
          Local pData As DWord At Me.pData + (Index-1) * 4
          Function = HEAP_Get(pData)
        Else 
          Local pData As DWord At Me.pData
          Local sResult  As String 
          Do
            sResult &= HEAP_Get(pData) & sSeperator
            SetAt(pData, VarPtr(pData) + 4 )
          Loop Until GetAt(pData) > HEAP_End(Me.pData)
          Function = sResult
          
        EndIf
      Else  
        If Between(Index, 1, Me.GetUBound ) Then
          Local data(Index) Like HEAP_Get(pType(kI)) At Me.pData
          Function = data(Index)
        Else
          Function = HEAP_Get(Me.pData)
        EndIf
      EndIf
      
    End Function
    
    '---------------------------------------------------------------------------------
    Function tTypedHeap.GetUBound() As Long
    '---------------------------------------------------------------------------------
      
      ' returns UBound of stored elements
      
      If HEAP_Size(Me.pData) = 0 Then Return 0
      Local kI As Long = Me.GetKeyIndex(TRUE)
      If Not kI Then                  Return 0 
      Local pType(kI) As DWord At Me.pTypes
     
      If HEAP_Get(pType(kI)) = "STRING" Then
        Function = HEAP_Size(Me.pData)/4
      Else
        Local data Like HEAP_Get(pType(kI)) At Me.pData
        Function = HEAP_Size(Me.pData)/SizeOf(data)
      EndIf
      
      
      
    End Function
    
    '---------------------------------------------------------------------------------
    Function tTypedHeap.SetData(ByVal sData As String,       _
                       Optional ByVal Index As Long     = 1  _
                                ) As DWord
    '---------------------------------------------------------------------------------
      
      ' returns pointer where exactly to read this data if success
      
      If HEAP_Size(Me.pData) = 0 Then Return 0
      Local kI As Long = Me.GetKeyIndex(TRUE)
      If Not kI Then                  Return 0 
      Local pType(kI) As DWord At Me.pTypes
    
      If HEAP_Get(pType(kI)) = "STRING" Then
        Local pData(Index) As DWord At Me.pData
        pData(Index) = HEAP_ReAllocByStr(pData(Index), sData)  
        Function = pData(Index)
      Else
        If Function_CParams = 2 Then
          Select Case HEAP_Get(pType(kI))
            Case "BYTE"
              sData = MKBYT$(sData)
            Case "INTEGER", "BOOLEAN"
              sData = MKI$(sData)
            Case "WORD"
              sData = MKWRD$(sData)
            Case "DWORD"
              sData = MKDWD$(sData)
            Case "LONG"
              sData = MKL$(sData)
            Case "QUAD"
              sData = MKQ$(sData)
            Case "EXT", "EXTENDED"
              sData = MKE$(sData)
            Case "CURRENCY"
              sData = MKCUR$(sData)
            Case "SINGLE"  
              sData = MKS$(sData)
            Case "DOUBLE"
              sData = MKD$(sData)
          End Select
          Local data Like HEAP_Get(pType(kI)) At 0
          SetAt(data, Me.pData + (Index-1) * SizeOf(data) )
          Memory_Set( GetAt(data), sData)
          Function = GetAt(data)
        Else
          Me.pData = HEAP_ReAllocByStr(Me.pData, sData)
          Function = Me.pData
        EndIf  
        
      EndIf
    
    End Function
     
    '---------------------------------------------------------------------------------
    Function tTypedHeap.AddData(ByVal sData As String) As DWord
    '---------------------------------------------------------------------------------
      
      ' returns new pointer on success or 0 if fails 
      
      Local kI As Long = Me.GetKeyIndex(TRUE)
      If Not kI Then                  Return 0 
      Local pType(kI) As DWord At Me.pTypes
      
      If HEAP_Get(pType(kI)) = "STRING" Then
        Me.pData = HEAP_ReAllocByStr(Me.pData, HEAP_Get(Me.pData) & MKDWD$(HEAP_AllocByStr(sData)) )
        If HEAP_Size(Me.pData) Then Function = Peek(DWord, HEAP_End(Me.pData) - 3 )
      
      Else
        Select Case HEAP_Get(pType(kI))
          Case "BYTE"
            If StrPtrLen(StrPtr(sData)) = Len(CVBYT(MKBYT$(sData))) Then sData = MKBYT$(sData)
          Case "INTEGER", "BOOLEAN"
            If StrPtrLen(StrPtr(sData)) = Len(CVI(MKI$(sData))) Then sData = MKI$(sData)
          Case "WORD"
            If StrPtrLen(StrPtr(sData)) = Len(CVWRD(MKWRD$(sData))) Then sData = MKWRD$(sData)
          Case "DWORD"   
            If StrPtrLen(StrPtr(sData)) = Len(CVDWD(MKDWD$(sData))) Then sData = MKDWD$(sData)
          Case "LONG"
            If StrPtrLen(StrPtr(sData)) = Len(CVL(MKL$(sData))) Then sData = MKL$(sData)
          Case "QUAD"
            If StrPtrLen(StrPtr(sData)) = Len(CVQ( MKQ$(sData))) Then sData = MKQ$(sData)
          Case "EXT", "EXTENDED"
            If StrPtrLen(StrPtr(sData)) = Len(CVE(MKE$(sData))) Then sData = MKE$(sData)
          Case "CURRENCY"
            If StrPtrLen(StrPtr(sData)) = Len(CVCUR(MKCUR$(sData))) Then sData = MKCUR$(sData)
          Case "SINGLE"  
            If StrPtrLen(StrPtr(sData)) = Len(CVS(MKS$(sData))) Then sData = MKS$(sData)
          Case "DOUBLE"
            If StrPtrLen(StrPtr(sData)) = Len(CVD(MKD$(sData))) Then sData = MKD$(sData)
        End Select
        
        Me.pData = HEAP_ReAllocByStr(Me.pData, HEAP_Get(Me.pData) & sData )
        Function = Me.pData
        
      EndIf 
    
    End Function
                    
    '---------------------------------------------------------------------------------
    Function tTypedHeap.Load(ByVal sFilename As String) As String
    '---------------------------------------------------------------------------------
      Local kI As Long = Me.GetKeyIndex()
      
      Local pType(kI) As DWord At Me.pTypes
     
      If HEAP_Size(Me.pData) Then Me.Free()
      
      Local sData As String = Load_File(sFilename)
      If StrPtrLen(StrPtr(sData)) < 4 Then Return "byte"
      
      Local lLen  As Long   At StrPtr(sData)
      Local sType As String = Memory_Get(StrPtr(sData)+4, lLen)
      Local lPos  As Long
         
      pType(kI) = Type_Enumerate(sType)
      If Ucase$(sType) = "STRING" Then
        SetAt( lLen, VarPtr(lLen) + 4 + lLen )
        
        While GetAt(lLen) < StrPtr(sData) + StrPtrLen(StrPtr(sData))
        
          Me.AddData( Memory_Get( VarPtr(lLen) + 4, lLen) )
          
          SetAt( lLen, VarPtr(lLen) + 4 + lLen )
        Wend
        
        Function = "DWORD"
        
      Else 
      
        SetAt( lLen, VarPtr(lLen) + 4 + lLen  )
        Me.AllocByStr( Memory_Get( VarPtr(lLen) + 4, lLen) )
        
        Function = HEAP_Get(pType(kI))
        
      EndIf
      
       
    End Function
    
    '---------------------------------------------------------------------------------
    Function tTypedHeap.Save(ByVal sFilename As String) As Boolean
    '---------------------------------------------------------------------------------
      
      Local kI As Long = Me.GetKeyIndex(TRUE)
      If Not kI Then Return FALSE
       
      Local pType(kI) As DWord At Me.pTypes
     
      
      Local sOut As String 
      
      If HEAP_Get(pType(kI))= "STRING" then
        sOut = MKL$(HEAP_Size(pType(kI))) _
               & HEAP_Get(pType(kI))      
        
        Local pLine As DWord At Me.pData
        
        Do
          sOut &= MKL$(HEAP_Size(pLine)) _
                & HEAP_Get(pLine)
                    
          SetAt(pLine, VarPtr(pLine) + 4 )
        Loop Until GetAt(pLine) >= HEAP_End(Me.pData)
        
      Else
        sOut = MKL$(HEAP_Size(pType(kI))) _
               & HEAP_Get(pType(kI))        _
               & MKL$(HEAP_Size(Me.pData))  _
               & HEAP_Get(Me.pData)
      
      EndIf
                           
      Function = ( Save_File( sFilename, sOut ) = 0 )
     
    End Function
                    
                    
    '---------------------------------------------------------------------------------
    'Function tTypedHeap.()
    '---------------------------------------------------------------------------------
    'End Function
    
    and some testing-script, syntax examples:

    #MINVERSION 1.9.15.0
      
    Uses "console"      
    
    #INCLUDE Once "tHeap.tBasicU"  
    
    
    Dim h, p As tHeap   
    Dim i    As Long       
    
    PrintL "Testing primitive tHeap-Type"
    
    If h.AllocByStr("1234567890") Then 
      PrintL "h.AllocByStr(" & $DQ & "1234567890" & $DQ & ")"  
      
      PrintL "We have" & Str$(h.GetSize) & " Bytes" & $CRLF
      PrintL "h.GetBytes"
                                    '(first, count)
      PrintL "all   : " & h.GetBytes()            ' all
      PrintL "1, 3  : " & h.GetBytes( 1, 3)       ' left 3
      PrintL "4, 4  : " & h.GetBytes( 4, 4)       ' mid  4, 4
      PrintL " , 5  : " & h.GetBytes(  , 5)       ' right 5
      PrintL "7,    : " & h.GetBytes( 7 )         ' all from 7
     
      PrintL
     
      If p.Copy(h) Then
        PrintL "test .copy :" & p.GetData
      EndIf 
     
      h.Free
      PrintL "check h after free: " & $DQ &  h.GetBytes & $DQ
      PrintL
      
      
      p.Save(APP_ScriptPath & "test.dat") 
      PrintL "saved p"
      
      If h.Load(APP_ScriptPath & "test.dat") Then
      
        PrintL "check h after load: " & $DQ &  h.GetBytes & $DQ
        PrintL
      
        h.Free
      EndIf
      
       
      PrintL "test h.Alloc(25):"
      If h.Alloc(25)  Then
        PrintL "and have" & Str$(h.GetSize) & " Bytes" & $CRLF
        
        ' quick fill via layover:
        Local b(h.GetSize) As Byte At h.pData
        For i = 1 To UBound(b)
          b(i) = 64 + i ' ABC... 
        Next
        
        PrintL h.GetBytes
      Else
        PrintL "h.Alloc failed"
      EndIf
      
      PrintL "test h.ReAlloc(15):"
      If h.ReAlloc(15)  Then
        PrintL "now have" & Str$(h.GetSize) & " Bytes" & $CRLF 
        PrintL h.GetBytes
      Else
        PrintL "h.ReAlloc failed"
      EndIf
      
    Else
      PrintL "h.AllocByStr failed!"
    EndIf  
    
    PrintL $CRLF & "key to continue"
    WaitKey                   
    
    h.Free()
    p.Free()
    
    
    ' typed heap will work with any numeric type, dynamic strings and udts
    ' all data is treated as dynamic array by default
    
    PrintL $CRLF & "now testing tTypedHeap"
    
    Dim th As tTypedHeap 
    
    PrintL $CRLF & "allocating space for 8 longs"
    th.AllocAs("Long", 8)
    
    PrintL "fill with data using .SetData"
    For i = 1 To th.GetUbound 
               ' (   value   , Index)
      th.SetData( Pow(2, i-1), i ) 
    Next
    
    PrintL "adding some seperate elements"
    
    ' negative values only work as variable or in quotes! 
    ' the minus seems to irritate the parser...
            
    th.AddData( "-12345" )  
    i = -45678
    th.AddData( i )  
    
    ' can also add multiple elements at once using type-conversion:
    th.AddData( MKL$(-11,-12,-13) )
    
    
    PrintL "request all elements:"
    
    For i = 1 To th.GetUbound
      PrintL "Element(" & TStr$(i) & ") = " & th.GetData(i)
    Next
    
    PrintL $CRLF & "key to continue"
    WaitKey       
    
    PrintL $CRLF & "overwrite th with 5 strings,"
    th.AllocAs("String", 5 )      
    
    PrintL ".SetData for Elements 1 to 5"  
    
    th.SetData("I am first string", 1)
    th.SetData("second string",     2)
    th.SetData("third string",      3)
    th.SetData("string four",       4)
    th.SetData("and five",          5)
    
    PrintL $CRLF & "append more strings using .AddData"
    
    th.AddData("one more added")        
    th.AddData("how about this?")
    
    PrintL $CRLF & "request all data-elements seperated by $CRLF:"
    
    PrintL th.GetData( , $CRLF)
    
    PrintL $CRLF & "key to continue"
    WaitKey       
    
    PrintL "save the stuff..."
    th.Save(APP_ScriptPath & "thSaveTest.dat")
    
    PrintL $CRLF & "key to continue"
    WaitKey  
    
    PrintL "allocate as other type & instantly fill in data"
    ' Ubound does not matter as long as it's smaller than passed data
    
    th.AllocAs("Long", , MKL$(5,4,3,2,1) )
      
    For i = 1 To th.GetUbound
      PrintL "Element(" & TStr$(i) & ") = " & th.GetData(i)
    Next
    
    PrintL $CRLF & "now .setData(data, omitted Index)"
                                       
    th.SetData(MKL$(1,2,3))
    For i = 1 To th.GetUbound
      PrintL "Element(" & TStr$(i) & ") = " & th.GetData(i)
    Next
    
    PrintL "altogether: " & th.GetData()       
    PrintL "now smile :)"
    
    
    th.Free()
    
    PrintL $CRLF & "key to continue"
    WaitKey  
    
    PrintL "now reload th (multiple strings)"
    th.Load(APP_ScriptPath & "thSaveTest.dat")
    PrintL "output: " & $CRLF & th.GetData( , $CRLF)
    
     
    PrintL $CRLF & "key to end"
    WaitKey
    
    Attached Files Attached Files
    Last edited by ReneMiner; 20-06-2015 at 13:12.
    I think there are missing some Forum-sections as beta-testing and support

  2. #2
    Super Moderator Petr Schreiber's Avatar
    Join Date
    Aug 2005
    Location
    Brno - Czech Republic
    Posts
    7,128
    Rep Power
    732
    This is great Rene,

    will use in my projects, if you don't mind


    Petr
    Learn 3D graphics with ThinBASIC, learn TBGL!
    Windows 10 64bit - Intel Core i5-3350P @ 3.1GHz - 16 GB RAM - NVIDIA GeForce GTX 1050 Ti 4GB

  3. #3
    thinBasic MVPs
    Join Date
    Oct 2012
    Location
    Germany
    Age
    54
    Posts
    1,527
    Rep Power
    170
    Quote Originally Posted by Petr Schreiber View Post
    This is great Rene,

    will use in my projects, if you don't mind


    Petr
    go ahead, i like to share ideas
    I think there are missing some Forum-sections as beta-testing and support

Similar Threads

  1. ScriptBasic GSL extension module
    By John Spikowski in forum Scripting
    Replies: 0
    Last Post: 30-05-2011, 01:52
  2. Windows 7, 64bit - no extension connection, no edit
    By Petr Schreiber in forum Installation
    Replies: 3
    Last Post: 04-09-2010, 12:42

Members who have read this thread: 0

There are no members to list at the moment.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •