Заполнение формы шарами - 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д