x As Integer
y As Integer
End Type
Dim ax As Integer, ay As Integer
Dim b() As ss
Dim cx As Integer, cy As Integer
Dim dx As Integer, dy As Integer
Dim mx As Integer, my As Integer
Dim js As Boolean
Dim jsn As Integer
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Timer1.Enabled = False Then Timer1.Enabled = True
jsn = jsn + 1
js = True
Select Case KeyCode
Case vbKeyUp
If Not b(1).y < ay Then mx = 0: my = -1
Case vbKeyDown
If Not b(1).y > ay Then mx = 0: my = 1
Case vbKeyLeft
If Not b(1).x < ax Then mx = -1: my = 0
Case vbKeyRight
If Not b(1).x > ax Then mx = 1: my = 0
End Select
If js = True And jsn Mod 5 = 0 Then
Timer1_Timer
End If
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
js = False
jsn = 0
End Sub
Private Sub Form_Load()
Me.AutoRedraw = True
Me.Width = 10000: Me.Height = 8000 + 600
Me.Scale (1, 1)-(25, 20)
Timer1.Enabled = False
Timer1.Interval = 250
ax = 10: ay = 10
ReDim b(1 To 3)
b(1).x = 9: b(1).y = 10
b(2).x = 8: b(2).y = 10
b(3).x = 7: b(3).y = 10
cx = 6: cy = 10
dx = 5: dy = 15
Line (0, 0)-(55, 55), vbBlack, BF
Line (0, 0)-(25, 20), Me.BackColor, BF
Me.DrawWidth = 27
Line (b(1).x + 0.5, b(1).y + 0.5)-(ax + 0.5, ay + 0.5), vbYellow
For i = 1 To UBound(b) - 1
Line (b(i).x + 0.5, b(i).y + 0.5)-(b(i + 1).x + 0.5, b(i + 1).y + 0.5), vbYellow
Next i
Line (b(UBound(b)).x + 0.5, b(UBound(b)).y + 0.5)-(cx + 0.5, cy + 0.5), vbYellow
Me.DrawWidth = 1
Call tua1(ax, ay)
Call tub(b(1).x, b(1).y)
Call tub(b(2).x, b(2).y)
Call tub(b(3).x, b(3).y)
Call tuc1(cx, cy)
Call tud(dx, dy)
mx = 1
End Sub
Sub tua2(x, y)
Me.DrawWidth = 12
PSet (x + 0.7, y + 0.2), vbBlack
PSet (x + 0.7, y + 0.8), vbBlack
Me.DrawWidth = 9
PSet (x + 0.7, y + 0.2), vbWhite
PSet (x + 0.7, y + 0.8), vbWhite
Me.DrawWidth = 5
PSet (x + 0.7, y + 0.2), vbBlack
PSet (x + 0.7, y + 0.8), vbBlack
Me.DrawWidth = 1
End Sub
Sub tua1(x, y)
Me.DrawWidth = 12
PSet (x + 0.3, y + 0.2), vbBlack
PSet (x + 0.3, y + 0.8), vbBlack
Me.DrawWidth = 9
PSet (x + 0.3, y + 0.2), vbWhite
PSet (x + 0.3, y + 0.8), vbWhite
Me.DrawWidth = 5
PSet (x + 0.3, y + 0.2), vbBlack
PSet (x + 0.3, y + 0.8), vbBlack
Me.DrawWidth = 1
End Sub
Sub tua4(x, y)
Me.DrawWidth = 12
PSet (x + 0.2, y + 0.7), vbBlack
PSet (x + 0.8, y + 0.7), vbBlack
Me.DrawWidth = 9
PSet (x + 0.2, y + 0.7), vbWhite
PSet (x + 0.8, y + 0.7), vbWhite
Me.DrawWidth = 5
PSet (x + 0.2, y + 0.7), vbBlack
PSet (x + 0.8, y + 0.7), vbBlack
Me.DrawWidth = 1
End Sub
Sub tua3(x, y)
Me.DrawWidth = 12
PSet (x + 0.2, y + 0.3), vbBlack
PSet (x + 0.8, y + 0.3), vbBlack
Me.DrawWidth = 9
PSet (x + 0.2, y + 0.3), vbWhite
PSet (x + 0.8, y + 0.3), vbWhite
Me.DrawWidth = 5
PSet (x + 0.2, y + 0.3), vbBlack
PSet (x + 0.8, y + 0.3), vbBlack
Me.DrawWidth = 1
End Sub
Sub tub(x, y)
Me.DrawWidth = 25
PSet (x + 0.5, y + 0.5), vbGreen
Me.DrawWidth = 15
PSet (x + 0.5, y + 0.5), vbBlack
Me.DrawWidth = 1
End Sub
Sub tuc1(x, y)
Me.DrawWidth = 25
PSet (x + 0.5, y + 0.5), vbGreen
Me.DrawWidth = 1
Line (x, y)-(x + 0.5, y + 1.02), Me.BackColor, BF
Me.DrawWidth = 8
Line (x + 0.15, y + 0.5)-(x + 0.5, y + 0.2), vbGreen
Line (x + 0.15, y + 0.5)-(x + 0.5, y + 0.8), vbGreen
Me.DrawWidth = 12
PSet (x + 0.5, y + 0.5), vbBlack
Me.DrawWidth = 1
End Sub
Sub tuc2(x, y)
Me.DrawWidth = 25
PSet (x + 0.5, y + 0.5), vbGreen
Me.DrawWidth = 1
Line (x + 0.5, y)-(x + 1, y + 1.02), Me.BackColor, BF
Me.DrawWidth = 8
Line (x + 0.85, y + 0.5)-(x + 0.5, y + 0.2), vbGreen
Line (x + 0.85, y + 0.5)-(x + 0.5, y + 0.8), vbGreen
Me.DrawWidth = 12
PSet (x + 0.5, y + 0.5), vbBlack
Me.DrawWidth = 1
End Sub
Sub tuc3(x, y)
Me.DrawWidth = 25
PSet (x + 0.5, y + 0.5), vbGreen
Me.DrawWidth = 1
Line (x, y)-(x + 1.02, y + 0.5), Me.BackColor, BF
Me.DrawWidth = 8
Line (x + 0.5, y + 0.15)-(x + 0.2, y + 0.5), vbGreen
Line (x + 0.5, y + 0.15)-(x + 0.8, y + 0.5), vbGreen
Me.DrawWidth = 12
PSet (x + 0.5, y + 0.5), vbBlack
Me.DrawWidth = 1
'Line (x + 0.4, y + 0.03)-(x, y + 0.53)
'Line (x + 0.6, y + 0.03)-(x + 1, y + 0.53)
End Sub
Sub tuc4(x, y)
'Line (x, y)-(x + 1, y + 1), Me.BackColor, BF
'Me.DrawWidth = 27
'PSet (x + 0.5, y + 0.5), vbBlack
Me.DrawWidth = 25
PSet (x + 0.5, y + 0.5), vbGreen
Me.DrawWidth = 1
Line (x, y + 0.5)-(x + 1.02, y + 1), Me.BackColor, BF
Me.DrawWidth = 8
Line (x + 0.5, y + 0.85)-(x + 0.2, y + 0.5), vbGreen
Line (x + 0.5, y + 0.85)-(x + 0.8, y + 0.5), vbGreen
Me.DrawWidth = 12
PSet (x + 0.5, y + 0.5), vbBlack
Me.DrawWidth = 1
End Sub
Sub tud(x, y)
Me.DrawWidth = 15
PSet (x + 0.5, y + 0.5)
Me.DrawWidth = 1
End Sub
Private Sub Timer1_Timer()
Dim cx1, cy1
cx1 = cx: cy1 = cy
cx = b(UBound(b)).x: cy = b(UBound(b)).y
For i = UBound(b) To 2 Step -1
b(i).x = b(i - 1).x
b(i).y = b(i - 1).y
Next i
b(1).x = ax: b(1).y = ay
ax = ax + mx: ay = ay + my
If ax = dx And ay = dy Then
ReDim Preserve b(1 To UBound(b) + 1)
b(UBound(b)).x = cx: b(UBound(b)).y = cy
Dim sw As Boolean
Do Until sw = True
sw = True
Dim rn As Integer
Randomize
rn = Int(Rnd * 22 * 17)
dx = rn Mod 22 + 2: dy = rn \ 22 + 2
For i = 1 To UBound(b)
If b(i).x = dx And b(i).y = dy Then sw = False: Exit For
Next i
If ax = dx And ay = dy Then sw = False
If cx = dx And cy = dy Then sw = False
Loop
End If
For i = 1 To UBound(b)
If (b(i).x = ax And b(i).y = ay) Or (cx = ax And cy = ay) Or ax < 1 Or ax > 24 Or ay < 1 Or ay > 19 Then
Timer1.Enabled = False
ax = ax - mx: ay = ay - my
For j = 1 To UBound(b) - 1
b(j).x = b(j + 1).x: b(j).y = b(j + 1).y
Next j
b(UBound(b)).x = cx: b(UBound(b)).y = cy
cx = cx1: cy = cy1
Exit For
End If
Next i
Line (0, 0)-(25, 20), Me.BackColor, BF
Call tud(dx, dy)
Me.DrawWidth = 27
Line (b(1).x + 0.5, b(1).y + 0.5)-(ax + 0.5, ay + 0.5), vbYellow
For i = 1 To UBound(b) - 1
Line (b(i).x + 0.5, b(i).y + 0.5)-(b(i + 1).x + 0.5, b(i + 1).y + 0.5), vbYellow
Next i
Line (b(UBound(b)).x + 0.5, b(UBound(b)).y + 0.5)-(cx + 0.5, cy + 0.5), vbYellow
Me.DrawWidth = 1
Select Case mx
Case 1
Call tua1(ax, ay)
Case -1
Call tua2(ax, ay)
Case 0
Select Case my
Case 1
Call tua3(ax, ay)
Case -1
Call tua4(ax, ay)
End Select
End Select
For i = 1 To UBound(b)
Call tub(b(i).x, b(i).y)
Next i
Select Case b(UBound(b)).x - cx
Case 1
Call tuc1(cx, cy)
Case -1
Call tuc2(cx, cy)
Case 0
Select Case b(UBound(b)).y - cy
Case 1
Call tuc3(cx, cy)
Case -1
Call tuc4(cx, cy)
Case 0
Select Case b(UBound(b) - 1).x - cx
Case 1
Call tuc1(cx, cy)
Case -1
Call tuc2(cx, cy)
Case 0
Select Case b(UBound(b) - 1).y - cy
Case 1
Call tuc3(cx, cy)
Case -1
Call tuc4(cx, cy)
End Select
End Select
End Select
End Select
End Sub