Дан указатель Р1 на корень непустого генеалогического дерева - VB

Option Explicit
 
Private Type Node
    Name        As Long
    Parent      As Long
    ChildCount  As Long
    Child()     As Long
End Type
 
Dim Names()     As Variant
Dim Tree()      As Node
Dim maxw        As Long
Dim maxh        As Long
 
Private Sub Form_Load()
    Dim i1 As Long, i2 As Long, r As Long
    
    Randomize
    
    AutoRedraw = True: FillStyle = vbSolid: FillColor = vbWhite: ScaleMode = vbPixels
    Names = Array("ÀëåêñГ*Г*äð", "ГЂГ*Г*òîëèé", "Âèêòîð", "Àëåêñåé", "Äìèòðèé", "Г‚Г*ñèëèé", "ГЏГҐГІГ°", "ÈâГ*Г*", _
                  "ÍèêîëГ*Г©", "Ôåäîð", "ГЊГЁГµГ*ГЁГ«", "Ãðèãîðèé", "ËåîГ*ГЁГ¤", "ГЌГЁГЄГЁГІГ*", "Èëüÿ", "ÑòåïГ*Г*", _
                  "ÑòГ*Г*ГЁГ±Г«Г*Гў", "ÐîìГ*Г*", "Ñåðãåé", "ГЂГ*ГІГ®Г*")
    Create -1, 4
    Draw 0, 5, 5
    Me.Width = (Width - ScaleWidth * Screen.TwipsPerPixelX) + (maxw + 10) * Screen.TwipsPerPixelX
    Me.Height = (Height - ScaleHeight * Screen.TwipsPerPixelY) + (maxh + 10) * Screen.TwipsPerPixelY
    Show
    
    Do: i1 = Val(InputBox("Ââåäèòå Г*îìåð Г¤Г*ëüГ*ГҐГЈГ® ðîäñòâåГ*Г*ГЁГЄГ* В№1", "0")): Loop While i1 > UBound(Tree)
    Do: i2 = Val(InputBox("Ââåäèòå Г*îìåð Г¤Г*ëüГ*ГҐГЈГ® ðîäñòâåГ*Г*ГЁГЄГ* В№2", "0")): Loop While i2 > UBound(Tree)
    
    Caption = Format(i1, "00") & " " & Names(Tree(i1).Name) & " - " & Format(i2, "00") & " " & Names(Tree(i2).Name)
    r = Search(i1, i2)
    
    If r = -1 Then MsgBox "ГЌГҐГІ îáùåãî": Exit Sub
    
    MsgBox "ГЋГЎГ№ГЁГ© ïðåäîê: " & Format(r, "00") & " " & Names(Tree(r).Name)
End Sub
' Ïîèñê
Private Function Search(ByVal i1 As Long, ByVal i2 As Long) As Long
    Dim ti1 As Long, ti2 As Long
    ti1 = i1
    Do Until Tree(ti1).Parent = Tree(i2).Parent
        ti1 = Tree(ti1).Parent
        If ti1 = -1 Then ti1 = i1: i2 = i2 - 1: If i2 = -1 Then Exit Do
        DoEvents
    Loop
    Search = Tree(i2).Parent
End Function
' ÎòðèñîâêГ*
Private Sub Draw(ByVal i As Long, ByVal x As Long, y As Long)
    Dim n As Long, h As Long, w As Long, idx As Long, cap As String, ly As Long
    cap = Format(i, "00") & " " & Names(Tree(i).Name)
    ly = y: h = TextHeight(cap): w = TextWidth(cap)
    Line (x - 1, y)-Step(w + 2, h), &HF08020, B
    CurrentX = x: CurrentY = y: Print cap
    For n = 0 To Tree(i).ChildCount - 1
        Line (x + w + 2, ly + h \ 2)-(x + 100, y + h \ 2), &H808080
        idx = Tree(i).Child(n): Draw idx, x + 100, y
        If n < Tree(i).ChildCount - 1 Then y = y + h + 3
    Next
    If x + w > maxw Then maxw = x + w
    If y + h > maxh Then maxh = y + h
End Sub
' ÑîçäГ*Г*ГЁГҐ äåðåâГ*
Private Sub Create(ByVal Parent As Long, ByVal Level As Long)
    Dim i As Long, n As Long, c As Long
    c = Int(Rnd * 3)
    If Parent = -1 Then
        ReDim Tree(0): Parent = 0: Tree(i).Name = Int(Rnd * (UBound(Names) + 1))
        Tree(i).Parent = -1
    End If
    ReDim Tree(Parent).Child(c): Tree(Parent).ChildCount = c + 1
    For n = 0 To c
        i = UBound(Tree) + 1: ReDim Preserve Tree(i)
        Tree(Parent).Child(n) = i
        Tree(i).Name = Int(Rnd * (UBound(Names) + 1)): Tree(i).Parent = Parent
        If Level Then Create i, Level - 1
    Next
End Sub