Заполнение формы шарами - VB

Узнай цену своей работы

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

Привет всем!!! Не так давно начал изучать программировании, выбрал для себя VB 6.0, сегодня целый день мучаюсь как заполнить форму шарами. Вот код, но тут одна полоска из шаров, а я хочу чтоб шарики заполняли половину формы .И сразу вопрос, можно ли использовать такую схему для создания игры там где внизу появляется шарик рандомного цвета и им нужно стрелять по шарикам которые находятся на верху и тоже разных цветов. Спасибо

Решение задачи: «Заполнение формы шарами»

textual
Листинг программы
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim cc(5) As Long, i As Integer, j As Integer, d As Integer
Const n As Integer = 10, m As Integer = 5
Dim Ball(1 To n, 1 To m) As VB.Shape, myBall As VB.Shape
 
Private Sub Form_Activate()
    d = Me.ScaleWidth \ n
    Load_Balls
    Set_Balls
    Set_MyBall
    Change_Balls_Color
    Change_myBall_Color
End Sub
 
Private Sub Set_Balls(Optional ByVal R As Integer = 1)
     For i = 1 To n
         For j = 1 To m
           Ball(i, j).Top = (j - R) * d: Ball(i, j).Left = (i - 1) * d
           Ball(i, j).Visible = True
           Ball(i, j).Width = d: Ball(i, j).Height = d
           Ball(i, j).BackStyle = 1: Ball(i, j).BorderStyle = 1: Ball(i, j).BorderWidth = 3
           Ball(i, j).Shape = 3
         Next j
    Next i
End Sub
 
Private Sub Set_MyBall()
    myBall.Top = Me.ScaleHeight - d * 2: myBall.Left = Me.ScaleWidth / 2 - d / 2
    myBall.Visible = True
    myBall.Width = d: myBall.Height = d
    myBall.BackStyle = 1: myBall.BorderStyle = 1: myBall.BorderWidth = 3
    myBall.Shape = 3
End Sub
 
Private Sub Load_Balls()
     For i = 1 To n
         For j = 1 To m
           Set Ball(i, j) = Controls.Add("VB.Shape", "B" & i & j, Me)
         Next j
    Next i
    Set myBall = Controls.Add("VB.Shape", "myB", Me)
End Sub
 
Private Sub Change_myBall_Color()
            myBall.BackColor = cc(Int(Rnd * 5))
End Sub
 
Private Sub Change_Balls_Color()
    For i = 1 To n
        For j = 1 To m
            Ball(i, j).BackColor = cc(Int(Rnd * 5))
        Next j
    Next i
End Sub
 
Private Sub Form_Load()
    Me.ScaleMode = 3
    cc(0) = vbRed: cc(1) = vbGreen: cc(2) = vbWhite: cc(3) = vbYellow: cc(4) = vbBlue: cc(5) = vbMagenta
    Randomize
    Me.Width = 6500: Me.Height = 7500
End Sub
 
Private Sub Move_MyBall(ByVal X As Single, Y As Single)
    Dim Dx As Single, Dy As Single, Dxx As Single, Dyy As Single ', R As Single
    Dx = 0.3
    Dx = Dx * Sgn(X - (myBall.Left + d))
    Dy = Dx * ((Y - (myBall.Top + d)) / (X - (myBall.Left + d)))
    Timer1.Enabled = True
    'If Dy >= 0 Then Dy = -Dy 'Exit Sub
    Do Until myBall.Left > Me.ScaleWidth + 100 Or myBall.Left < -100 Or myBall.Top > Me.ScaleWidth + 100 Or myBall.Top < -100
       myBall.Move myBall.Left + Dx, myBall.Top + Dy
       If Crash(myBall.Left, myBall.Top) <> "0:0" Then
            If Crash(myBall.Left, myBall.Top) = "1" Then
               'MsgBox Crash(myBall.Left, myBall.Top) & " Совпало"
               GoTo m1
            Else
               'MsgBox Crash(myBall.Left, myBall.Top) & " Несовпало"
               Dx = Dx: Dy = -Dy
            End If
       End If
       DoEvents
    Loop
    Sleep 500
m1:
    Game_Over
    Set_MyBall
    Change_myBall_Color
End Sub
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
     Move_MyBall X, Y
End Sub
 
Private Function Crash(ByVal X As Single, Y As Single) As String
    Crash = "0:0"
    For i = 1 To n
        For j = 1 To m
            If (Abs(Ball(i, j).Left - X) < d / 1.5 And Abs(Ball(i, j).Top - Y) < d / 1.5) And Ball(i, j).Visible = True And myBall.Visible = True Then
                If myBall.BackColor = Ball(i, j).BackColor Then
                      Crash = "1"
                      Ball(i, j).Visible = False
                      myBall.Visible = False
                      Exit Function
                Else
                      Crash = "0"
                End If
            End If
        Next j
    Next i
End Function
 
Private Function Game_Over() As Boolean
    Game_Over = True
    For i = 1 To n
        For j = 1 To m
            If Ball(i, j).Visible = True Then Game_Over = False: Exit For
        Next j
    Next i
    If Game_Over Then
       MsgBox "Game Over"
       Set_Balls
       Set_MyBall
       Change_Balls_Color
       Change_myBall_Color
    End If
End Function

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

8   голосов , оценка 4.125 из 5
Похожие ответы