Results 1 to 18 of 18

Thread: [RESOLVED] CopyMemory Shift Array one position

  1. #1

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Resolved [RESOLVED] CopyMemory Shift Array one position

    Code:
    Option Explicit
    
    Private Type CellStruct
        sText As String
        Width As Long
        Height As Long
        Font As StdFont
        ForeColor As OLE_COLOR
        '...other boolean type and Long type member
    End Type
    
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, _
                                                                         lpvSource As Any, _
                                                                         ByVal cbCopy As Long)
    
    Private Type CellLine
        Cols() As CellStruct
    End Type
    
    Private m_CellRows() As CellLine
    
    Private Sub Form_Load()
    
    Dim i As Long, j As Long, copysize As Long
    Dim myfont(3) As New StdFont
    
        ReDim m_CellRows(3)
    
        For i = 0 To 3
            myfont(i).Name = "Tahoma"
            myfont(i).Size = 10 + i
            ReDim m_CellRows(i).Cols(1)
            For j = 0 To 1
                m_CellRows(i).Cols(j).sText = "Test String"
                m_CellRows(i).Cols(j).Height = j
                Set m_CellRows(i).Cols(j).Font = myfont(i)
            Next
    
        Next
    
        For i = 0 To 3
            ReDim Preserve m_CellRows(i).Cols(1)
            For j = 0 To 1
                Debug.Print i & ":" & j, m_CellRows(i).Cols(j).sText, m_CellRows(i).Cols(j).Font.Size
            Next
        Next
    
        For i = 3 To 2 Step -1
            m_CellRows(i) = m_CellRows(i - 1)  '2-->3 1-->2
        Next
    
        'copysize = LenB(m_CellRows(0))
        'copysize = copysize * 2
        'CopyMemory ByVal VarPtr(m_CellRows(2)), ByVal VarPtr(m_CellRows(1)), copysize
    
        For i = 0 To 3
            ReDim Preserve m_CellRows(i).Cols(1)
            For j = 0 To 1
                Debug.Print i & ":" & j, m_CellRows(i).Cols(j).sText, m_CellRows(i).Cols(j).Font.Size
            Next
        Next
    
    End Sub
    Typically we directly assign array with OBJECT and String elements by the below code to shift array,there's no problem and works fine:

    For i = 3 To 2 Step -1
    m_CellRows(i) = m_CellRows(i - 1) '2-->3 1-->2
    Next

    Considering a huge m_CellRows with 1000 elements and 100 Cols (m_CellRows(999).Cols(99)), what is the fast way to shift position when inserting at index 2?
    As above, we can use:
    For i = 999 To 2 Step -1
    m_CellRows(i) = m_CellRows(i - 1) '998-->999 997-->998,996-->997... (999 goes away)
    Next

    I am trying to use CopyMemory to increase performance, But I am not sure what is reliability and memory leak, looks like failed at some time:

    copysize = LenB(m_CellRows(0)) '= 4
    copysize = copysize * (999-2) 'shifting ONE position for #2 till #999,old #999 goes away
    CopyMemory ByVal VarPtr(m_CellRows(3)), ByVal VarPtr(m_CellRows(2)), copysize

    I may confuse you too much, For my case,what is the proper way to use CopyMemory to shift one position for m_CellRows from position 2 till last elements? Please take note UDT array m_CellRows has Font Object and sText string elements.
    Last edited by Jonney; Jan 21st, 2013 at 05:35 AM.

  2. #2
    Cumbrian Milk's Avatar
    Join Date
    Jan 2007
    Location
    0xDEADBEEF
    Posts
    2,448

    Re: CopyMemory Shift Array one position

    I've not used VB6 in a while but...

    It looks to me like you are just copying the safearray pointers rather than the data.

    If any of these are lost as a result of the copymemory call (eg. #999) I think you will get a leak. Manually deallocate any of these before the call to copymemory (Erase m_CellRows(999)).

    The copymemory call from the example will also create a second reference to array #2. After the call I think the original needs to be deallocated using copymemory or similar to avoid the garbage collection running twice on the same object (something like CopyMemory ByVal VarPtr(m_CellRows(2)), 0, 4)
    W o t . S i g

  3. #3
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: CopyMemory Shift Array one position

    CopyMemory probably won't be able to do what you're asking. VB arrays are implemented using the SAFEARRAY structure. The pvData member of that structure is a pointer to the actual elements of the array, which are located elsewhere in memory. Thus, CopyMemory won't be able to actually "shift" the elements of the array. Also, the VarPtr function cannot be used to get the address of an array. See How To Get the Address of Variables in Visual Basic.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  4. #4
    Cumbrian Milk's Avatar
    Join Date
    Jan 2007
    Location
    0xDEADBEEF
    Posts
    2,448

    Re: CopyMemory Shift Array one position

    I'm not sure its necessary to shift the elements, just the safearray pointers (eg the 4 byte value of the Array variables)
    As long as any double references are cleaned and any lost array elements are deallocated it should work (i think)
    W o t . S i g

  5. #5

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: CopyMemory Shift Array one position

    Quote Originally Posted by Milk View Post
    I've not used VB6 in a while but...

    It looks to me like you are just copying the safearray pointers rather than the data.

    If any of these are lost as a result of the copymemory call (eg. #999) I think you will get a leak. Manually deallocate any of these before the call to copymemory (Erase m_CellRows(999)).

    The copymemory call from the example will also create a second reference to array #2. After the call I think the original needs to be deallocated using copymemory or similar to avoid the garbage collection running twice on the same object (something like CopyMemory ByVal VarPtr(m_CellRows(2)), 0, 4)
    Thank you,Milk. It needs CopyMemory ByVal VarPtr(m_CellRows(2)), 0, 4 to do garbage clean. After I put this, the data looks OK. Without this, the data got mad even though no crash.

    Thanks Bonnie West.
    Last edited by Jonney; Jan 21st, 2013 at 07:04 PM. Reason: Give thanks

  6. #6
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: [RESOLVED] CopyMemory Shift Array one position

    OK, so the mighty CopyMemory can do what you want.

    Code:
    Option Explicit
    
    #If False Then
    Private Type SAFEARRAY1D    'Offsets
        cDims      As Integer   '  +0
        fFeatures  As Integer   '  +2
        cbElements As Long      '  +4
        cLocks     As Long      '  +8
        pvData     As Long      ' +12   <-- points to first array element
        cElements  As Long      ' +16
        lLbound    As Long      ' +20
    End Type
    #End If
    
    Private Type CellStruct     'LenB
        sText     As String     '   4
        Width     As Long       '   4
        Height    As Long       '   4
        Font      As StdFont    '   4
        ForeColor As OLE_COLOR  '   4
        '...other boolean type  '   2
        ' and Long type member  '   4
    End Type
    
    Private Type CellLine       'Elements of m_CellRows() are UDTs whose only member is a pointer to a SAFEARRAY1D UDT
        Cols() As CellStruct    '0   1   2   3   ...   98   99    <-- Indices
    End Type                    '0   4   8  12   ...  392  396    <-- Offsets in Bytes
    
    Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef ArrayVar() As Any) As Long
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
    Private Declare Sub GetMem4 Lib "msvbvm60.dll" (ByVal Addr As Long, ByRef RetVal As Long)
    
    Private m_CellRows() As CellLine
    
    Private Sub Form_Load()
        Dim i As Long, j As Long, Ptr As Long
        Dim MyFont As StdFont, sText As String
    
        ReDim m_CellRows(0& To 99&) As CellLine
    
        For i = 0& To 99&
            Set MyFont = New StdFont    'Don't use As New
            MyFont.Name = "Tahoma"
            MyFont.Size = 10@ + i
    
            ReDim m_CellRows(i).Cols(0& To 19&) As CellStruct
    
            For j = 0& To 19&
                m_CellRows(i).Cols(j).sText = "Test String"
                m_CellRows(i).Cols(j).Height = j
                Set m_CellRows(i).Cols(j).Font = MyFont
            Next
            Set MyFont = Nothing
        Next
    
        For i = 0& To 99&
           'ReDim Preserve m_CellRows(i).Cols(1) As CellStruct      <-- What for?
            For j = 0& To 19&
                sText = sText & i & ":" & j & vbTab & _
                        """" & m_CellRows(i).Cols(j).sText & """" & vbTab _
                        & m_CellRows(i).Cols(j).Font.Size & vbNewLine
            Next       'String concatenation isn't optimized
        Next           'since this is for debugging purposes only
        Clipboard.Clear: Clipboard.SetText sText
        Stop 'Paste text to a text editor
    
       'IMPORTANT!!!  Free the memory occupied by the element to be overwritten
        For i = 0& To 19&
            m_CellRows(99&).Cols(i).sText = vbNullString    'must not be ""
            Set m_CellRows(99&).Cols(i).Font = Nothing      'Long and Boolean
        Next                                                'need not be freed
        Erase m_CellRows(99&).Cols()                        'Not sure if everything
        ReDim m_CellRows(99&).Cols(0& To 19&) As CellStruct 'is fully deallocated here
    
        Stop 'Step Into the code here (F8)
       'Get the address of the first element of m_CellRows()
        GetMem4 VarPtrArray(m_CellRows()), Ptr:             Debug.Assert Ptr 'Pointer to SAFEARRAY1D
        GetMem4 UAdd(Ptr, 12&), Ptr:                        Debug.Assert Ptr 'SAFEARRAY1D.pvData
    
       'Shift elements up (2-98 >>> 3-99)
        CopyMemory UAdd(Ptr, 12&), UAdd(Ptr, 8&), 4& * 97&  '97 Long elements (pointers)
    
        sText = vbNullString
        For i = 0& To 99&
           'ReDim Preserve m_CellRows(i).Cols(1) As CellStruct      <-- What for?
            For j = 0& To 19&
                sText = sText & i & ":" & j & vbTab & _
                        """" & m_CellRows(i).Cols(j).sText & """" & vbTab _
                        & m_CellRows(i).Cols(j).Font.Size & vbNewLine
            Next
        Next
        Clipboard.Clear: Clipboard.SetText sText
    End Sub 'Paste text to a text editor and compare with previous
    That code has not been thoroughly tested for leaks, so watch out for any suspicious increase in memory usage.


    EDIT

    The pointer arithmetic in the above code has been modified to use the following function (inspired by Matt Curland's code):

    Code:
    'Increments the given pointer address by the specified positive value using unsigned arithmetic.
    Private Function UAdd(ByVal Ptr As Long, ByVal Incr As Long) As Long
        Const MSB = &H80000000
    
        UAdd = (Ptr Xor MSB) + Incr Xor MSB
    End Function
    Last edited by Bonnie West; Mar 8th, 2013 at 07:08 AM.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  7. #7

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: [RESOLVED] CopyMemory Shift Array one position

    Code:
    Option Explicit
    
    #If False Then
    Private Type SAFEARRAY1D    'Offsets
        cDims      As Integer   '  +0
        fFeatures  As Integer   '  +2
        cbElements As Long      '  +4
        cLocks     As Long      '  +8
        pvData     As Long      ' +12   <-- points to first array element
        cElements  As Long      ' +16
        lLbound    As Long      ' +20
    End Type
    #End If
    
    Private Type CellStruct     'LenB
        sText     As String     '   4
        Width     As Long       '   4
        Height    As Long       '   4
        Font      As StdFont    '   4
        ForeColor As OLE_COLOR  '   4
        '...other boolean type  '   2
        ' and Long type member  '   4
    End Type
    
    Private Type CellLine       'Elements of m_CellRows() are UDTs whose only member is a pointer to a SAFEARRAY1D UDT
        Cols() As CellStruct    '0   1   2   3   ...   98   99    <-- Indices
    End Type                    '0   4   8  12   ...  392  396    <-- Offsets in Bytes
    
    Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef ArrayVar() As Any) As Long
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
    Private Declare Sub GetMem4 Lib "msvbvm60.dll" (ByVal Addr As Long, ByRef RetVal As Long)
    
    Private m_CellRows() As CellLine
    
    Private Sub Form_Load()
        Dim i As Long, j As Long, Ptr As Long
        Dim MyFont As StdFont, sText As String
        
        Dim iDelRow As Long, num As Long, m_CntOfRows As Long
    
        ReDim m_CellRows(0& To 5&) As CellLine
    
        For i = 0& To 5&
            Set MyFont = New StdFont    'Don't use As New
            MyFont.Name = "Tahoma"
            MyFont.Size = 10@ + i
    
            ReDim m_CellRows(i).Cols(0& To 19&) As CellStruct
    
            For j = 0& To 2&
                m_CellRows(i).Cols(j).sText = "Test String" & CStr(j * Rnd)
                m_CellRows(i).Cols(j).Height = j
                Set m_CellRows(i).Cols(j).Font = MyFont
            Next
            Set MyFont = Nothing
        Next
    
        For i = 0& To 5&
           'ReDim Preserve m_CellRows(i).Cols(1) As CellStruct      <-- What for?
            For j = 0& To 2&
                sText = sText & i & ":" & j & vbTab & _
                        """" & m_CellRows(i).Cols(j).sText & """" & vbTab _
                        & m_CellRows(i).Cols(j).Font.Size & vbNewLine
            Next       'String concatenation isn't optimized
        Next           'since this is for debugging purposes only
        Clipboard.Clear: Clipboard.SetText sText
        Stop 'Paste text to a text editor
    
      
        Stop 'Step Into the code here (F8)
       'Get the address of the first element of m_CellRows()
        GetMem4 VarPtrArray(m_CellRows()), Ptr:             Debug.Assert Ptr 'Pointer to SAFEARRAY1D
        GetMem4 Ptr + 12&, Ptr:                             Debug.Assert Ptr 'SAFEARRAY1D.pvData
    
        'delete item #3 and #4
        iDelRow = 3: num = 2: m_CntOfRows = UBound(m_CellRows) + 1
        CopyMemory Ptr + 4& * iDelRow, Ptr + 4& * (iDelRow + num), 4& * (m_CntOfRows - (iDelRow + num))     '(m_CntOfRows - (iDelRow + num)) Long elements (pointers)
        
        m_CntOfRows = m_CntOfRows - num    
        ReDim Preserve m_CellRows(m_CntOfRows - 1)
    
        sText = vbNullString
        For i = 0& To UBound(m_CellRows)
            For j = 0& To 2&
                sText = sText & i & ":" & j & vbTab & _
                        """" & m_CellRows(i).Cols(j).sText & """" & vbTab _
                        & m_CellRows(i).Cols(j).Font.Size & vbNewLine
            Next
        Next
        Clipboard.Clear: Clipboard.SetText sText
    End Sub 'Paste text to a text editor and compare with previous
    For real case, I want to delete item #3 and item#4 (total item count is 6 -#0 to #5), I got errors. Look like the data of Cols was collapsed.

  8. #8
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: [RESOLVED] CopyMemory Shift Array one position

    I think you will need to understand how VB arrays (and UDTs) are arranged in memory. See the earlier link on SAFEARRAY in post #3. Once you get a better understanding, it should be simple enough to modify the necessary pointer values. Research on Pointer Arithmetic as well.

    BTW, I see you've taken out the part about memory deallocation. I hope you know the consequences of doing that.
    Last edited by Bonnie West; Jan 31st, 2013 at 05:42 AM.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  9. #9

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: [RESOLVED] CopyMemory Shift Array one position

    Quote Originally Posted by Bonnie West View Post
    I think you will need to understand how VB arrays (and UDTs) are arranged in memory. See the earlier link on SAFEARRAY in post #3. Once you get a better understanding, it should be simple enough to modify the necessary pointer values. Research on Pointer Arithmetic as well.

    BTW, I see you've taken out the part about memory deallocation. I hope you know the consequences of doing that.
    Oh, it is advance stuff beyond my capability at this moment. The code looks logic but failed after I call ReDim Preserve m_CellRows(m_CntOfRows - 1). I met the same problem with pure CopyMemory:

    Code:
    copysize = LenB(m_CellRows(0))
    copysize = copysize * (m_CntOfRows - (iDelRow + num))
    CopyMemory ByVal VarPtr(m_CellRows(iDelRow )), ByVal VarPtr(m_CellRows(iDelRow + num)), copysize
    CopyMemory ByVal VarPtr(m_CellRows(m_CntOfRows - num)), 0&, LenB(m_CellRows(0)) * num  'de-allocate Garbage collection

  10. #10
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: [RESOLVED] CopyMemory Shift Array one position

    Could you please post the complete code that you would like to optimize? Also, please state clearly what it is that you want to accomplish. Thank you.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  11. #11

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: [RESOLVED] CopyMemory Shift Array one position

    Quote Originally Posted by Bonnie West View Post
    Could you please post the complete code that you would like to optimize? Also, please state clearly what it is that you want to accomplish. Thank you.
    It's a Excel-like Grid control but much simple. I am in charge of Data structure.

    For MS Excel like cells, we can insert a Row or a Col, Delete/Add few Rows and Cols at a time.

    Those operations are no problem with VB native Array function (MAGIC ). But I want to use CopyMemory to speed up the shifting. Refer to my attached file. I believe you understand the code.

    Name:  cell.PNG
Views: 1323
Size:  8.8 KB
    Attached Files Attached Files
    Last edited by Jonney; Jan 31st, 2013 at 02:54 PM.

  12. #12

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: [RESOLVED] CopyMemory Shift Array one position

    I am frustrated with CopyMemory.

    OK, I have to go back VB native function to shifting array.
    Last edited by Jonney; Feb 1st, 2013 at 05:31 AM.

  13. #13
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: [RESOLVED] CopyMemory Shift Array one position

    Would you be willing to learn how to do it with CopyMemory? I'm currently making a diagram that illustrates the in-memory relationship of your data structure. It's quite complicated and I can tell you, manually shifting your array is no easy task, especially since you would have to deallocated the overwritten array element(s) yourself. So, unless you fully understand what you're doing, I would suggest don't do it.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  14. #14

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: [RESOLVED] CopyMemory Shift Array one position

    Quote Originally Posted by Bonnie West View Post
    Would you be willing to learn how to do it with CopyMemory? I'm currently making a diagram that illustrates the in-memory relationship of your data structure. It's quite complicated and I can tell you, manually shifting your array is no easy task, especially since you would have to deallocated the overwritten array element(s) yourself. So, unless you fully understand what you're doing, I would suggest don't do it.
    What I saw others have done so, but all of example is just RomoveItem / AddItem by one position at one time.

    In VBIDE, my code is ok if I Delete a Row or Col at one time, VBIDE won't crash and the data remain OK. But If I delete more that (>=) 5 Rows at one time, VBIDE got crash and data may lost.

    I Really don't understand.

    My Code is logic but doesn't work . If you come out of a diagram and a solution, I am appreciated.

    Thanks.
    Last edited by Jonney; Feb 1st, 2013 at 06:57 AM.

  15. #15
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: [RESOLVED] CopyMemory Shift Array one position

    OK, I'm not done yet so I'll post it later...
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  16. #16

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: [RESOLVED] CopyMemory Shift Array one position

    Quote Originally Posted by Bonnie West View Post
    OK, I'm not done yet so I'll post it later...
    Thanks.

    VB allows direct assign between two arrays and ReDim Preserve / ReDim to resize the array. I am wondering what VB did at back. Does VB also use CopyMemory / GetMem4 /VarPtrArray / Varptr / Strptr / SAFEARRAY to accomplish those functions?

    For I = iDelRow + num To m_CntOfRows - 1
    m_CellRows(I - num) = m_CellRows(I)
    Next

    m_CntOfRows = m_CntOfRows - num
    ReDim Preserve m_CellRows(m_CntOfRows - 1)
    Last edited by Jonney; Feb 1st, 2013 at 08:39 AM.

  17. #17
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: [RESOLVED] CopyMemory Shift Array one position

    The diagram below shows how your data structure is internally represented:

    Name:  DataStruct.png
Views: 1314
Size:  3.8 KB

    The m_CellRows() dynamic array variable is actually just a pointer variable. As mentioned before, VB implements arrays using the SAFEARRAY structure. That means, m_CellRows() points to the memory address of a SAFEARRAY structure, beginning with its first member which is cDims. In other words, m_CellRows() points to the cDims Integer variable.

    There is a trick in VB used for obtaining the address of the SAFEARRAY structure which is contained in the pointer variable.

    Code:
    SA1D = Not Not ArrayName
    That trick is much more efficient than the GetMem4 VarPtrArray(m_CellRows()), Ptr line in post #6, provided that the array is already initialized.

    The pvData member of a SAFEARRAY is also a pointer and it points to the real array elements. In the case of your data structure, pvData points to the CellLine UDT.

    Your CellLine UDT contains a single member (Cols()) which is again a dynamic array variable. Therefore, it also points to its own SAFEARRAY structure. Like the first array, you can retrieve the address to the SAFEARRAY efficiently by using the Not Not ArrayName trick.

    The pvData member of the SAFEARRAY structure for the Cols() array points to the first member of the CellStruct UDT which is the Text string variable.

    Like array variables, String variables are also just pointers to the actual data. Even the Font member of the CellStruct UDT, which is a StdFont Object, is also just a pointer. Pointers in 32 Bit systems are 4 Bytes long, same as the Long data type.

    BTW, use the following code when performing arithmetic on memory addresses (e.g., Ptr + 12& should be SumUnsignedLong(Ptr, 12&)):

    Code:
    'Sum Unsigned Long from Arithmetic operations on memory address pointers
    '
    'Enables valid addition and subtraction of unsigned long integers.
    'Treats lPtr as an unsigned long and returns an unsigned long.
    'Allows safe arithmetic operations on memory address pointers.
    'Assumes valid pointer and pointer offset.
    
    
    Private Function SumUnsignedLong(ByVal lPtr As Long, ByVal lOffset As Long) As Long
        Const DW_MSB = &H80000000                   'DWord Most Significant Bit
    
        If lOffset > 0& Then
            If lPtr And DW_MSB Then                 'if ptr < 0
                SumUnsignedLong = lPtr + lOffset    'ignores > unsigned max (see assumption)
            ElseIf (lPtr Or DW_MSB) < -lOffset Then
                SumUnsignedLong = lPtr + lOffset    'result is below signed int max
            Else                                    'result wraps to min signed int
                SumUnsignedLong = (lPtr + DW_MSB) + (lOffset + DW_MSB)
            End If
        ElseIf lOffset < 0& Then
            If (lPtr And DW_MSB) = 0& Then          'if ptr > 0
                SumUnsignedLong = lPtr + lOffset    'ignores unsigned < zero (see assumption)
            ElseIf (lPtr - DW_MSB) >= -lOffset Then
                SumUnsignedLong = lPtr + lOffset    'result is above signed int min
            Else                                    'result wraps to max signed int
                SumUnsignedLong = (lOffset - DW_MSB) + (lPtr - DW_MSB)
            End If
        Else 'lOffset = 0&
            SumUnsignedLong = lPtr
        End If
    End Function
    Here's a simplified example of how your data structure looks like in memory:

    Code:
    'Memory
    'Addresses
    &H00000001    m_CellRows() As CellLine    'points to &H00000010
    
    
                  Private Type SAFEARRAY1D    'Offsets
    &H00000010        cDims        As Integer '  +0
    &H00000011
    &H00000012        fFeatures    As Integer '  +2
    &H00000013
    &H00000014        cbElements   As Long    '  +4
    &H00000015
    &H00000016
    &H00000017
    &H00000018        cLocks       As Long    '  +8
    &H00000019
    &H0000001A
    &H0000001B
    &H0000001C        pvData       As Long    ' +12   <-- points to &H00000100
    &H0000001D
    &H0000001E
    &H0000001F
    &H00000020        cElements    As Long    ' +16
    &H00000021
    &H00000022
    &H00000023
    &H00000024        lLbound      As Long    ' +20
    &H00000025
    &H00000026
    &H00000027
                  End Type
    
    
    '>>>>>  ARRAY ELEMENTS THAT WILL BE SHIFTED  >>>>>
    
                  Private Type CellLine       'm_CellRows(0)
    &H00000100        Cols() As CellStruct    'points to &H00000200
    &H00000101
    &H00000102
    &H00000103
                  End Type
                  Private Type CellLine       'm_CellRows(1)
    &H00000104        Cols() As CellStruct
    &H00000105
    &H00000106
    &H00000107
                  End Type
                  Private Type CellLine       'm_CellRows(2)
    &H00000108        Cols() As CellStruct
    &H00000109
    &H0000010A
    &H0000010B
                  End Type
    
    '<<<<<  ARRAY ELEMENTS THAT WILL BE SHIFTED  <<<<<
    
    
                  Private Type SAFEARRAY1D    'Offsets
    &H00000200        cDims        As Integer '  +0
    &H00000201
    &H00000202        fFeatures    As Integer '  +2
    &H00000203
    &H00000204        cbElements   As Long    '  +4
    &H00000205
    &H00000206
    &H00000207
    &H00000208        cLocks       As Long    '  +8
    &H00000209
    &H0000020A
    &H0000020B
    &H0000020C        pvData       As Long    ' +12   <-- points to &H00001000
    &H0000020D
    &H0000020E
    &H0000020F
    &H00000210        cElements    As Long    ' +16
    &H00000211
    &H00000212
    &H00000213
    &H00000214        lLbound      As Long    ' +20
    &H00000215
    &H00000216
    &H00000217
                  End Type
    
    
                  Private Type CellStruct     'Cols(0)
    &H00001000        Text      As String
    &H00001001
    &H00001002
    &H00001003
    &H00001004        Width     As Long
    &H00001005
    &H00001006
    &H00001007
    &H00001008        Height    As Long
    &H00001009
    &H0000100A
    &H0000100B
    &H0000100C        Font      As StdFont
    &H0000100D
    &H0000100E
    &H0000100F
    &H00001010        ForeColor As OLE_COLOR
    &H00001011
    &H00001012
    &H00001013
                  End Type
                  Private Type CellStruct     'Cols(1)
    &H00001014        Text      As String
    &H00001015
    &H00001016
    &H00001017
    &H00001018        Width     As Long
    &H00001019
    &H0000101A
    &H0000101B
    &H0000101C        Height    As Long
    &H0000101D
    &H0000101E
    &H0000101F
    &H00001020        Font      As StdFont
    &H00001021
    &H00001022
    &H00001023
    &H00001024        ForeColor As OLE_COLOR
    &H00001025
    &H00001026
    &H00001027
                  End Type
    Before shifting the array elements, make sure the overwritten elements are deallocated first. Not doing this results in a memory leak. I'm not sure if the code in post #6 completely frees all the associated memory.

    Quote Originally Posted by Jonney View Post
    VB allows direct assign between two arrays and ReDim Preserve / ReDim to resize the array. I am wondering what VB did at back. Does VB also use CopyMemory / GetMem4 /VarPtrArray / Varptr / Strptr / SAFEARRAY to accomplish those functions?
    VB uses the SAFEARRAY structure to implement and manipulate arrays. I don't know what VB does when directly assigning an array to another.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  18. #18

    Thread Starter
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: [RESOLVED] CopyMemory Shift Array one position

    Thank you very much.It's too complicated beyond my knowledge. I give up until I find a proper way.

    I look at Lavolpe's ImageList . He also used CopyMemory to shift Collection and array. But it works.

    If iIndex < m_ListCount Then
    CopyMemory ByVal VarPtr(m_Lists(iIndex)), ByVal VarPtr(m_Lists(iIndex + 1)), (m_ListCount - iIndex) * 4&
    CopyMemory ByVal VarPtr(m_Lists(m_ListCount)), vbDefault, 4&
    End If
    If kIndex < m_ListCount Then
    CopyMemory ByVal VarPtr(m_Keys(kIndex)), ByVal VarPtr(m_Keys(kIndex + 1)), (m_ListCount - kIndex) * 8&
    FillMemory ByVal VarPtr(m_Keys(m_ListCount)), 8&, 0
    End If
    m_ListCount = m_ListCount - 1 ' decrement count
    ReDim Preserve m_Lists(1 To m_ListCount) ' resize arrays
    ReDim Preserve m_Keys(1 To m_ListCount)
    Last edited by Jonney; Feb 3rd, 2013 at 08:06 PM.

Posting Permissions

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



Click Here to Expand Forum to Full Width