Вопросы про ЮзерТипы

[Matew]

Вопросы относятся к азам ВБ, которые к сожалению до меня не доходят . Сами вопросы в комментариях к коду. Объясните тупому?

Код: Выделить всё

' в модуле
Type POINTAPI
x as long
y as long
End TYPE
' это в форме или модуле
Private Sub cmdCommand1_Click()
    Dim arrPt() As POINTAPI
    Dim pt As POINTAPI
    MsgBox UboundArray(arrPt()) ' пишет, что нельзя приравнивать к варианту. Как поправить?
    Msg "Работает! ", pt ' нельзя юзертип в опции, опять же, если в объявлении написать вариант, то получаем предыдущий вопрос
   If pt Is Nothing Then ' как проверить, что юзертип пустой, как можно проще?
    MsgBox "URA!"
   End If
   pt = Nothing ' Как правильно очистить юзертип?
End Sub

Sub Msg(str As String, Optional pt As POINTAPI)
    MsgBox str & pt.x
End Sub

'Автор процедур Andrey Fedorov:
Public Function UboundArray(ArrayName As Variant, Optional Dimension As Integer = 1) As Long
    If Dimension < 1 Or Dimension > GetArrayDimensions(ArrayName) Then
        UboundArray = -1
    Else
        UboundArray = UBound(ArrayName, Dimension)
    End If
End Function

Public Function GetArrayDimensions(arr As Variant) As Integer
    Dim a As Long

    CopyMemory a, ByVal VarPtr(arr) + 8, 4
    CopyMemory a, ByVal a, 4
    If a Then CopyMemory GetArrayDimensions, ByVal a, 2
End Function



[Viper]

А зачем такой мудреж то? "Проще надо быть и люди к вам потянутся."©

1. Optional pt As POINTAPI - низзя структуру задавать как необязательный параметр
2. UboundArray(arrPt()) - ну думаю текст ошибки понятен? Обсуждалось и не раз. Тип должен быть объявлен либо в ActiveX компоненте, либо использоваться явно, без преобразования в Variant
3. If pt Is Nothing Then - низзя, это не объект! Просто проверить нельзя, надо каждое поле проверять. А потом, что значит пустая структура? Она и при нулевых данных может быть вполне корректной
4. pt = Nothing - аналогично низзя, обнулить можно через ZeroMemory, например

З.Ы. Если уж так хочется что-то универсальное применить к массивам, то в Кирпичах два модуля по работе с ними (один от GSerg, второй мой).

[Matew]

Viper, спасибо, я так собственно и думал, но хотелось универсальности и красоты чуть-чуть(маленький каприз). Сложностей решил не делать. Оставлю все, как есть - некрасиво. За первый пункт только обидно.

[Matew]

Вот, благодаря Viper-у и GSerg-у, написал универсальную процедурку. Мож кому сгодится (Полностью заменяет UBound() и LBound() для любых видов массивов (кроме приравненных к варианту) и при этом не выпадает с ошибкой, если массив не инициализирован) :

Код: Выделить всё

Public Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long
' Структура, описывающая границы одной размерности массива
Public Type SAFEARRAYBOUND
    cElements As Long       ' число элементов
    lLbound As Long         ' индекс первого элемента
End Type
' Структура, описывающая массив
Public Type SAFEARRAY
    cDims As Integer        ' число размерностей
    fFeatures As Integer    ' флаги, описывающие массив (см. перечисление SA_Features)
    cbElements As Long      ' размер элемента массива
    cLocks As Long          ' разность между числом Locked'ов массива и числом Unlocked'ов
    pvData As Long          ' указатель на данные массива
    ' следующий член структуры закомментирован по причине того,
    ' что нам удобнее работать с универсальной структурой SAFEARRAY.
    ' А массив размерностей бум использовать отдельно
    ' rgsabound(0) As SAFEARRAYBOUND
End Type
' Возвращает верхнюю границу масива(закоментирована нижняя граница)
'
' Аргументы
' ppArray       - указатель на массив, следует использовать ArrPtr(arr)
' Dimension - размерность массива, длину который хотите узнать
' Возвращаемое значение:
'Верхняя граница масива(закоментирована нижняя граница)
'
Public Function UbArr(ByVal ppArray As Long, Optional Dimension As Long = 1) As Long 'LbArr
Dim pSafeArray As SAFEARRAY, pBounds() As SAFEARRAYBOUND
    If ppArray = 0 Then
        ' ну раз нуль, то без вариантов
         UbArr = -1 ' мне так удобней
        Exit Function
    End If
   
    Dim psa As Long
    GetMem4 ppArray, VarPtr(psa)
    If psa = 0 Then
        ' а массив то неинициализован
        UbArr = -1 ' мне так удобней
        Exit Function
    End If
   
    CopyMemory pSafeArray, ByVal psa, LenB(pSafeArray)
    Debug.Assert pSafeArray.cDims <> 0  ' это конечно вряд ли
    ReDim pBounds(0 To pSafeArray.cDims - 1)
    ' массив размерностей аккурат за SAFEARRAY
    CopyMemory pBounds(0), ByVal (psa + LenB(pSafeArray)), LenB(pBounds(0)) * pSafeArray.cDims
    ' Верхняя граница массива:
    UbArr = pBounds(Dimension - 1).cElements + pBounds(Dimension - 1).lLbound - 1
    ' Соответственно нижняя граница еще проще:
    'LbArr = pBounds(Dimension - 1).lLbound
End Function


Практически автозаменой поменял половину программы...

[Хакер]

Matew
Вот мне интересно, а какие значения по твоему должны возвращать LBound и UBound если дин. массив не инициализирован?

[Matew]

Хакер, я ждал этого вопроса

'Автор процедур Andrey Fedorov:
Public Function UboundArray(ArrayName As Variant, Optional Dimension As Integer = 1) As Long
If Dimension < 1 Or Dimension > GetArrayDimensions(ArrayName) Then
UboundArray = -1
Else
UboundArray = UBound(ArrayName, Dimension)
End If
End Function

Public Function GetArrayDimensions(arr As Variant) As Integer
Dim a As Long

CopyMemory a, ByVal VarPtr(arr) + 8, 4
CopyMemory a, ByVal a, 4
If a Then CopyMemory GetArrayDimensions, ByVal a, 2
End Function

Мне показалалось это удобным. Для моих целей вполне пойдет. А про Lbound пусть каждый решает сам. Я поэтому и закоментировал, что не знаю.(Редко встречается код, где нижняя граница массива, описана через Lbound).
Я бы все это не мудрил, если бы в ВБ была бы конструкция Try/Exception.