مبرمج كتكوت... محتاج مساعده

Option Explicit

Private Const Yellow As Long = 65535
Private Const Orange As Long = 8421631
Private Const Blue As Long = 16711680
Private Const Green As Long = 65280
Private Const White As Long = 16777215


Private Enum CirColors
Y = 1
O = 2
B = 3
G = 4
End Enum


Private Type LeaderCircles
X As Integer
Y As Single
R As Integer
C As CirColors
yAcc As Single

End Type

Dim CurrentCargo As Long

Dim Circles(5) As LeaderCircles

Dim I As Integer

Dim X As Integer, CurrentColor As Long


Private Sub Update(I As Integer)


Circles(I).X = Rnd * 800: If Circles(I).X < 100 Then Circles(I).X = 100
Circles(I).Y = 0
Circles(I).R = Rnd * 25: If Circles(I).R < 20 Then Circles(I).R = 10
Circles(I).C = Rnd * 4
Circles(I).yAcc = Rnd * 0.05: If Circles(I).yAcc < 0.01 Then Circles(I).yAcc = 0.01

Select Case Circles(I).C
Case 1
Circles(I).C = Yellow
Case 2
Circles(I).C = Orange
Case 3
Circles(I).C = Blue
Case 4
Circles(I).C = Green
End Select

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyRight Then
X = X + 15
ElseIf KeyCode = vbKeyLeft Then
X = X - 15
End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then End
End Sub

Private Sub Form_Load()

Show

Init

Do

DoEvents

lblCn.Left = X - 15
lblCn.Top = 465

RenderCirecles
RenderBoxes 549

RenderBox 450
Loop

End Sub

Private Sub Init()
For I = 0 To UBound(Circles)
Update I
Next I

X = 300

CurrentColor = White
lblCn.ForeColor = White

Me.BorderStyle = 0
Me.WindowState = 2
Me.BackColor = &H80000007
End Sub

Private Sub RenderBox(Y As Integer)
Me.Line (X - 25, Y)-(X + 25, Y), CurrentColor
Me.Line (X + 25, Y)-(X + 25, Y + 50), CurrentColor
Me.Line (X + 25, Y + 50)-(X - 25, Y + 50), CurrentColor
Me.Line (X - 25, Y + 50)-(X - 25, Y), CurrentColor
End Sub

Private Sub RenderBoxes(Y As Integer)

Dim X1 As Integer, X2 As Integer, X3 As Integer, X4 As Integer
X1 = 50
X2 = 300
X3 = 550
X4 = 749

Me.Line (X1 - 50, Y)-(X1 + 50, Y), Yellow
Me.Line (X1 + 50, Y)-(X1 + 50, Y + 50), Yellow
Me.Line (X1 + 50, Y + 50)-(X1 - 50, Y + 50), Yellow
Me.Line (X1 - 50, Y + 50)-(X1 - 50, Y), Yellow



Me.Line (X2 - 50, Y)-(X2 + 50, Y), 8421631
Me.Line (X2 + 50, Y)-(X2 + 50, Y + 50), 8421631
Me.Line (X2 + 50, Y + 50)-(X2 - 50, Y + 50), 8421631
Me.Line (X2 - 50, Y + 50)-(X2 - 50, Y), 8421631

Me.Line (X3 - 50, Y)-(X3 + 50, Y), Blue
Me.Line (X3 + 50, Y)-(X3 + 50, Y + 50), Blue
Me.Line (X3 + 50, Y + 50)-(X3 - 50, Y + 50), Blue
Me.Line (X3 - 50, Y + 50)-(X3 - 50, Y), Blue


Me.Line (X4 - 50, Y)-(X4 + 50, Y), Green
Me.Line (X4 + 50, Y)-(X4 + 50, Y + 50), Green
Me.Line (X4 + 50, Y + 50)-(X4 - 50, Y + 50), Green
Me.Line (X4 - 50, Y + 50)-(X4 - 50, Y), Green


End Sub


Private Sub RenderCirecles()
For I = 0 To UBound(Circles)

Circles(I).Y = Circles(I).Y + Circles(I).yAcc

If Circles(I).Y > 600 Then
Update I
End If

Collision I

Me.Circle (Circles(I).X, Circles(I).Y), Circles(I).R, Circles(I).C

Next I
End Sub

Private Sub Collision(I As Integer)
If Circles(I).X > (X - 25) And Circles(I).X < (X + 25) And Circles(I).Y > 450 And Circles(I).Y < Y + 500 Then
If (lblCn.ForeColor = White) Or (Circles(I).C = CurrentColor) Then
If CurrentCargo < 3 Then

CurrentCargo = CurrentCargo + 1
lblCn.Caption = lblCn.Caption + 1


lblCn.ForeColor = Circles(I).C
CurrentColor = Circles(I).C

Update I
End If
End If
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub Timer1_Timer()
Cls
End Sub

Option Explicit

Private Const Yellow As Long = 65535
Private Const Orange As Long = 8421631
Private Const Blue As Long = 16711680
Private Const Green As Long = 65280
Private Const White As Long = 16777215


Private Enum CirColors
Y = 0
o = 1
b = 2
g = 3
End Enum


Private Type LeaderCircles
X As Integer
Y As Single
R As Integer
C As CirColors
yAcc As Single

End Type

Dim CurrentCargo As Long

Dim Circles(5) As LeaderCircles

Dim I As Integer

Dim X As Integer, CurrentColor As Long


Private Sub Update(I As Integer)


Circles(I).X = Rnd * 800: If Circles(I).X < 100 Then Circles(I).X = 100
Circles(I).Y = 0
Circles(I).R = Rnd * 25: If Circles(I).R < 20 Then Circles(I).R = 10
Circles(I).C = Rnd * 4
Circles(I).yAcc = Rnd * 0.05: If Circles(I).yAcc < 0.01 Then Circles(I).yAcc = 0.01

Select Case Circles(I).C
Case Y
Circles(I).C = Yellow
Case o
Circles(I).C = Orange
Case b
Circles(I).C = Blue
Case g
Circles(I).C = Green
End Select

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyRight Then
X = X + 15
ElseIf KeyCode = vbKeyLeft Then
X = X - 15
End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then End
End Sub

Private Sub Form_Load()

Show

Init

Do

DoEvents

lblCn.Left = X - 15
lblCn.Top = 465

RenderCirecles
RenderBoxes 549

RenderBox 450
Loop

End Sub

Private Sub Init()
For I = 0 To UBound(Circles)
Update I
Next I

X = 300

CurrentColor = White
lblCn.ForeColor = White

Me.ScaleMode = 3
Me.BorderStyle = 0
Me.WindowState = 2
Me.BackColor = &H80000007

Timer1.Interval = 10

lblCn.Caption = "0"
lblCn.ForeColor = White
lblCn.BackColor = 0
lblCn.Font.Size = 12
lblCn.FontBold = True
lblCn.FontItalic = True
lblCn.AutoSize = True
lblCn.BackStyle = 1

End Sub

Private Sub RenderBox(Y As Integer)
Me.Line (X - 25, Y)-(X + 25, Y), CurrentColor
Me.Line (X + 25, Y)-(X + 25, Y + 50), CurrentColor
Me.Line (X + 25, Y + 50)-(X - 25, Y + 50), CurrentColor
Me.Line (X - 25, Y + 50)-(X - 25, Y), CurrentColor
End Sub

Private Sub RenderBoxes(Y As Integer)

Dim X1 As Integer, X2 As Integer, X3 As Integer, X4 As Integer
X1 = 50
X2 = 300
X3 = 550
X4 = 749

Me.Line (X1 - 50, Y)-(X1 + 50, Y), Yellow
Me.Line (X1 + 50, Y)-(X1 + 50, Y + 50), Yellow
Me.Line (X1 + 50, Y + 50)-(X1 - 50, Y + 50), Yellow
Me.Line (X1 - 50, Y + 50)-(X1 - 50, Y), Yellow



Me.Line (X2 - 50, Y)-(X2 + 50, Y), 8421631
Me.Line (X2 + 50, Y)-(X2 + 50, Y + 50), 8421631
Me.Line (X2 + 50, Y + 50)-(X2 - 50, Y + 50), 8421631
Me.Line (X2 - 50, Y + 50)-(X2 - 50, Y), 8421631

Me.Line (X3 - 50, Y)-(X3 + 50, Y), Blue
Me.Line (X3 + 50, Y)-(X3 + 50, Y + 50), Blue
Me.Line (X3 + 50, Y + 50)-(X3 - 50, Y + 50), Blue
Me.Line (X3 - 50, Y + 50)-(X3 - 50, Y), Blue


Me.Line (X4 - 50, Y)-(X4 + 50, Y), Green
Me.Line (X4 + 50, Y)-(X4 + 50, Y + 50), Green
Me.Line (X4 + 50, Y + 50)-(X4 - 50, Y + 50), Green
Me.Line (X4 - 50, Y + 50)-(X4 - 50, Y), Green


End Sub


Private Sub RenderCirecles()
For I = 0 To UBound(Circles)

Circles(I).Y = Circles(I).Y + Circles(I).yAcc

If Circles(I).Y > 600 Then
Update I
End If

Collision I

Me.Circle (Circles(I).X, Circles(I).Y), Circles(I).R, Circles(I).C

Next I
End Sub

Private Sub Collision(I As Integer)
If Circles(I).X > (X - 25) And Circles(I).X < (X + 25) And Circles(I).Y > 450 And Circles(I).Y < Y + 500 Then
If (lblCn.ForeColor = White) Or (Circles(I).C = CurrentColor) Then
If CurrentCargo < 3 Then

CurrentCargo = CurrentCargo + 1
lblCn.Caption = lblCn.Caption + 1


lblCn.ForeColor = Circles(I).C
CurrentColor = Circles(I).C

Update I
End If
End If
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub Timer1_Timer()
Cls
End Sub