Заполнение формы шарами - 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