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

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

Дан указатель Р1 на корень не пустого генеалогического дерева. Для двух дальних родствеников найти ближайшего общего предка.

Решение задачи: «Дан указатель Р1 на корень непустого генеалогического дерева»

textual
                            Листинг программы 
                        

                            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
                        