Safearray и ReDim массива - VB

Узнай цену своей работы

Формулировка задачи:

Здравствуйте!
В процедуре имею указатель на Safearray 2-х мерного массива.
Как с помощью этого указателя сделать ReDim массива, не зная тип массива?
Сам делаю так (криво):
Делаю клон массива
Dim TmpArray () As ???
GetMem4 ppMoyArray, ppTmpArray
Делаю ReDim TmpArray
и уничтожаю клон.
Но, не зная тип массива, вынужден в процедуру передавать тип и иметь пустые TmpArray для всех типов, которые предвидятся, что будут использованы в будущем.
Хочется по универсальнее.
Можно или нет получить массив, зная указатель на Safearray?
(включая UDT).
Спасибо!

Решение задачи: «Safearray и ReDim массива»

textual
Листинг программы
<font color="blue">Public</font> <font color="blue">Function</font> RedimPtr(<font color="blue">ByVal</font> ppArray <font color="blue">As</font> <font color="blue">Long</font>, <font color="blue">ByVal</font> LBound1 <font color="blue">As</font> <font color="blue">Long</font>, <font color="blue">ByVal</font> UBound1 <font color="blue">As</font> <font color="blue">Long</font>, _
                                       Optional <font color="blue">ByVal</font> LBound2 <font color="blue">As</font> <font color="blue">Long</font>, Optional <font color="blue">ByVal</font> UBound2 <font color="blue">As</font> <font color="blue">Long</font>) <font color="blue">As</font> <font color="blue">Long</font>

    <font color="blue">Dim</font> DDims <font color="blue">As</font> <font color="blue">Long</font>

    GetMem4 ppArray, VarPtr(RedimPtr)
    <font color="blue">If</font> RedimPtr = <font color="darkblue"><b>0</b></font> <font color="blue">Then</font> <font color="blue">Exit</font> <font color="blue">Function</font>
    GetMem2 RedimPtr, VarPtr(DDims)

    <font color="blue">If</font> DDims = <font color="darkblue"><b>1</b></font> <font color="blue">Then</font>

        <font color="blue">Call</font> SafeArrayDestroyData(<font color="blue">ByVal</font> RedimPtr)
        PutMem4 RedimPtr + <font color="darkblue"><b>16</b></font>, UBound1 - LBound1 + <font color="darkblue"><b>1</b></font>       
        PutMem4 RedimPtr + <font color="darkblue"><b>20</b></font>, LBound1                     
        <font color="blue">Call</font> SafeArrayAllocData(<font color="blue">ByVal</font> RedimPtr)

    <font color="blue">ElseIf</font> DDims = <font color="darkblue"><b>2</b></font> <font color="blue">Then</font>

        <font color="blue">Call</font> SafeArrayDestroyData(<font color="blue">ByVal</font> RedimPtr)
        PutMem4 RedimPtr + <font color="darkblue"><b>16</b></font>, UBound2 - LBound2 + <font color="darkblue"><b>1</b></font>       
        PutMem4 RedimPtr + <font color="darkblue"><b>20</b></font>, LBound2                     

        PutMem4 RedimPtr + <font color="darkblue"><b>24</b></font>, UBound1 - LBound1 + <font color="darkblue"><b>1</b></font>       
        PutMem4 RedimPtr + <font color="darkblue"><b>28</b></font>, LBound1                     
        <font color="blue">Call</font> SafeArrayAllocData(<font color="blue">ByVal</font> RedimPtr)

    <font color="blue">Else</font>

        RedimPtr = <font color="darkblue"><b>0</b></font>
        MsgBox <font color="teal">"   Wrong Array dimensions!        "</font> & Chr(<font color="darkblue"><b>13</b></font>) & <font color="teal">"   Only one or two dimension Arrays supported! "</font>, vbCritical, <font color="teal">"Error"</font>

    <font color="blue">End</font> <font color="blue">If</font>
<font color="blue">End</font> <font color="blue">Function</font>

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

9   голосов , оценка 3.667 из 5
Похожие ответы