Взаимодействие графических примитивов

Private Type Point
    X As Single
    Y As Single
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
Private Function CreateShape(Pt() As Point, ParamArray B()) As Boolean
    Dim V As Variant, I As Long
    ReDim Pt(UBound(B) \ 2)
    For Each V In B
        If I And 1 Then Pt(I \ 2).Y = V Else Pt(I \ 2).X = V
        I = I + 1
    Next
    CreateShape = True
End Function
Private Function AddToDB(Pt() As Point) As Boolean
    On Error GoTo ERRSUB
    Dim Dat() As Byte
    ReDim Dat(UBound(Pt) * 8 + 7)
    CopyMemory Dat(0), Pt(0), UBound(Pt) * 8 + 8
    DB.Recordset.AddNew
    DB.Recordset.Fields("Vtx").Value = UBound(Pt) + 1
    DB.Recordset.Fields("Data").Value = Dat
    DB.Recordset.Update
    AddToDB = True
    Exit Function
ERRSUB:
    MsgBox "Ошибка записи в БД"
End Function
Private Function LoadFromBD(Pt() As Point) As Boolean
    On Error GoTo ERRSUB
    Dim Dat() As Byte, I As Long
    I = DB.Recordset.Fields("Vtx")
    If I <= 0 Then MsgBox "Ошибка в формате данных: неверное число вершин фигуры": Exit Function
    Dat() = DB.Recordset.Fields("Data")
    If UBound(Dat) <> (I - 1) * 8 + 7 Then MsgBox "Ошибка в формате данных: неверные данные фигуры": Exit Function
    ReDim Pt(I - 1)
    CopyMemory Pt(0), Dat(0), UBound(Pt) * 8 + 8
    LoadFromBD = True
    Exit Function
ERRSUB:
    MsgBox "Ошибка чтения из БД"
End Function
Private Sub DrawShape(Pt() As Point)
    Dim I As Long
    picDisplay.Cls
    picDisplay.CurrentX = -2
    picDisplay.CurrentY = -2
    picDisplay.Print "Число вершин: " & UBound(Pt) + 1
    picDisplay.CurrentX = Pt(0).X
    picDisplay.CurrentY = Pt(0).Y
    For I = 0 To UBound(Pt)
        picDisplay.Line -(Pt(I).X, Pt(I).Y)
    Next
    picDisplay.Line -(Pt(0).X, Pt(0).Y) 'Замыкаем
    picDisplay.Refresh
End Sub
Private Sub DB_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
    fCancelDisplay = True
End Sub
Private Sub DB_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    Dim Pt() As Point
    If pRecordset.EOF Or pRecordset.BOF Then Exit Sub
    If LoadFromBD(Pt) Then DrawShape Pt
End Sub
Private Sub Form_Load()
    On Error GoTo ERRSUB
    Dim Pt() As Point
    Me.Show
    DB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
        App.Path & "\DataBase.mdb;Mode=ReadWrite;Persist Security Info=False"
    DB.RecordSource = "SELECT * FROM Figures"
    DB.Refresh
    ' Создание фигур и добавление в БД
'    CreateShape Pt, -1, -1, 1, -1, 1, 1, -1, 1    ' Прямоугольник
'    AddToDB Pt
'    CreateShape Pt, 0, -1, 1, 1, -1, 1            ' Треугольник
'    AddToDB Pt
'    CreateShape Pt, 0, -1, 1, 0, 0, 1, -1, 0      ' Ромб
'    AddToDB Pt
'    CreateShape Pt, Rnd, Rnd, Rnd, Rnd, Rnd, Rnd, Rnd, Rnd, Rnd, Rnd, Rnd, Rnd, Rnd, Rnd
'    AddToDB Pt
    Exit Sub
ERRSUB:
    MsgBox "Ошибка подключения к базе данных", vbCritical: End
End Sub