Тема: « Массивы»

Option Explicit
Const r = 90, rr = 900, nn = 10
Dim WithEvents pb As PictureBox, im As Image
Dim WithEvents cb As CommandButton
Dim i&, v, a$(), s$, ss As String * nn, ll&(1 To nn)
 
Private Sub cb_Click()
    Dim i&, j&, ii&, l&, n&
    Select Case Mid$(cb.Name, 3)
    Case 1: Call reset
    Case 2
        'Решение
        Do
            ii = InStr(ii + 1, ss, 1)
            s = ""
            If ii > 0 Then
                l = ll(ii): n = n + 1
                For i = 1 To 6: For j = 1 To 6
                    If l + i + j = nn Then
                        s = s & " " & i & "," & j
                    End If
                Next: Next
                a = Split(Mid$(s, 2))
                a = Split(a(Fix(Rnd * (UBound(a) + 1))), ",")
                If ii = Choose(n, 1, 6) Then
                    s = Choose(n, 2, 7) & "," & Choose(n, 3, 8)
                ElseIf ii = Choose(n, 5, 10) Then
                    s = Choose(n, 3, 8) & "," & Choose(n, 4, 9)
                Else:
                    s = ii - 1 & "," & ii + 1
                End If: i = 0
                
                For Each v In Split(s, ",")
                    With Controls("im" & v)
                        .Move -(6 - a(i)) * rr
                        .Visible = 1
                    End With
                    i = i + 1
                Next
                
            End If
            
        Loop While ii > 0
    
    End Select
End Sub
 
Private Sub reset()
    ss = ""
    Erase ll
    For i = 1 To nn: Controls("im" & i).Visible = 0: Next
    Controls("cb2").Enabled = 0
End Sub
 
Sub SetNum(ByVal Index&, ByVal Num&)
    Randomize Timer
    If Index < 1 Or Index > nn Then Exit Sub
    If Num < 0 Or Num > 6 Then Exit Sub
    With Controls("cb2")
        If .Enabled Then Exit Sub
        With Controls("im" & Index)
            If Index <= 5 And InStr(1, Left$(ss, nn \ 2), 1) > 0 Then
                MsgBox "В левой части уже есть кубик", vbExclamation: Exit Sub
            ElseIf Index > 5 And InStr(1, Mid$(ss, nn \ 2 + 1), 1) > 0 Then
                MsgBox "В правой части уже есть кубик", vbExclamation: Exit Sub
            End If
            .Visible = Num > 0
            .Move -(6 - Num) * rr
            Mid$(ss, Index, 1) = 1
            ll(Index) = Num
        End With
        .Enabled = Replace$(ss, " ", "") = 11
    End With
End Sub
 
Private Sub Form_Activate()
    pb.SetFocus
End Sub
 
Private Sub Form_Load()
    Dim l&, t&, w&, h&
    
    l = r: t = r: w = rr: h = rr
    For i = 1 To nn
        Set pb = Controls.Add("vb.PictureBox", "pb" & i): With pb
            .Move l, t, w, h: l = l + w
            .Visible = 1
            Set im = Controls.Add("vb.Image", "im" & i, pb): With im
                Set .Picture = Me.Picture
            End With
        End With
    Next
    Set Me.Picture = Nothing
    l = r: t = t + rr + r: i = 0
    For Each v In Array("Сброс", "Найти решение"): i = i + 1
        Set cb = Controls.Add("vb.CommandButton", "cb" & i): With cb
            .Move l, t, rr * 2, rr \ 2: l = l + .Width + r
            .Caption = v
            .Visible = 1
        End With
    Next
    reset
    Me.Caption = "Кости-10"
End Sub
 
Private Sub pb_Click()
    SetNum Mid$(pb.Name, 3), Fix(Rnd * 6 + 1)
End Sub
 
Private Sub cb_LostFocus()
    pb_LostFocus
End Sub
 
Private Sub pb_LostFocus()
    If TypeOf ActiveControl Is PictureBox Then Set pb = ActiveControl
    If TypeOf ActiveControl Is CommandButton Then Set cb = ActiveControl
End Sub

                MsgBox "В левой части уже есть кубик", vbExclamation: Exit Sub
            ElseIf Index > 5 And InStr(1, Mid$(ss, nn \ 2 + 1), 1) > 0 Then
                MsgBox "В правой части уже есть кубик", vbExclamation: Exit Sub
            End If