刘金玉的零基础VB教程078期：小龙游戏开发介绍 刘金玉原创代码开源

Private Type Color
    R As Integer
    G As Integer
    B As Integer
End Type
Private Type Dragon
    x1 As Single
    Y1 As Single
    X2 As Single
    Y2 As Single
    C As Color
End Type
Private Type Tree
    x1 As Single
    Y1 As Single
    X2 As Single
    Y2 As Single
    H As Single
    C As Color
End Type
Private Type Cloud
    x1 As Single
    Y1 As Single
    X2 As Single
    Y2 As Single
End Type
Private WithEvents timer1 As Timer '全程控制
Private WithEvents timer2 As Timer '跳跃动画
Private WithEvents timer3 As Timer '监控碰撞情况
Private WithEvents timer4 As Timer '控制消息显示时间
Private WithEvents lblscore As Label '记录分数
Private WithEvents lbldesc As Label '描述
Private WithEvents lblmsg As Label '消息
Dim startX!, startY!
Dim status%
Dim jumpflag%, ft&
Dim lrflag% '方向向右为0，方向向左为1
Public score&
Dim scorelast&
Public currentName$
Dim dg As Dragon
Dim trs() As Tree
Dim cld() As Cloud
Dim msgflag As Boolean '消息是否显示标记
Dim n As Long  '表示树的数量
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyLeft Then
    startX = startX - 10
ElseIf KeyCode = vbKeyRight Then
    startX = startX + 10
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeySpace Then
    scorelast = score
    timer2.Enabled = True
End If
End Sub
Private Sub Form_Load()
Call init
End Sub
Public Function init()
WindowState = 2
'初始化龙颜色
dg.C.R = 0
dg.C.G = 0
dg.C.B = 0
Call dragonBorder
ScaleMode = vbPixels
AutoRedraw = True
If timer1 Is Nothing Then
    '总体动画
    Set timer1 = Controls.Add("vb.timer", "timer1")
    '龙跳动动画
    Set timer2 = Controls.Add("vb.timer", "timer2")
    '监控碰撞情况
    Set timer3 = Controls.Add("vb.timer", "timer3")
    '消息显示时间
    Set timer4 = Controls.Add("vb.timer", "timer4")
    '分数
    Set lblscore = Controls.Add("vb.label", "lblscore")
    '说明
    Set lbldesc = Controls.Add("vb.label", "lbldesc")
    '消息
    Set lblmsg = Controls.Add("vb.label", "lblmsg")
End If
lblmsg.Caption = "开始！"
timer1.Interval = 50
timer1.Enabled = False
timer2.Interval = 1
timer2.Enabled = False
timer3.Interval = 1
timer3.Enabled = True
timer4.Interval = 2000
timer4.Enabled = True
'初始坐标点
startY = ScaleHeight / 2  '初始坐标点
startX = 30   '
'初始化六颗树数据
n = 1500
ReDim trs(n) As Tree
Randomize
Dim i&, j&, t!
t = ScaleWidth + 100
For i = 0 To n Step 1
    t = t + Rnd * 500 + 600
    trs(i).x1 = t
    trs(i).Y1 = startY - Rnd * 50 + 10
    trs(i).X2 = trs(i).x1 + 10
    trs(i).Y2 = ScaleHeight / 2 + 50
    trs(i).H = trs(i).Y2 - trs(i).Y1
    If (i > 10 And i < 30) Or i > 50 Then
        trs(i).C.R = Rnd * 256
        trs(i).C.G = Rnd * 256
        trs(i).C.B = Rnd * 256
    Else
        trs(i).C.R = 0
        trs(i).C.G = 0
        trs(i).C.B = 0
    End If
Next i
timer1.Enabled = True
'画树
Call drawTree
'画龙
Call dragon1
'画地面
Call drawGround
'初始化云
ReDim cld(n) As Cloud
t = 0
For i = 0 To UBound(cld) Step 1
    t = t + Rnd * 400
    cld(i).x1 = t
    Dim t2%
    t2 = Int(Rnd * 20) + 1
    cld(i).Y1 = ScaleHeight / t2
    cld(i).X2 = t + Rnd * 200
    cld(i).Y2 = ScaleHeight / t2
Next i
Call drawCloud
End Function
Private Sub Form_Resize()
lblscore.Visible = True
lblscore.Caption = "得分 0"
lblscore.FontSize = 16
lblscore.Left = 10
lblscore.Top = 10
lbldesc.Visible = True
lbldesc.AutoSize = True
lbldesc.Caption = "空格键 跳跃；方向键 控制前后"
lbldesc.FontSize = 20
lbldesc.Top = ScaleHeight - lbldesc.Height - 100
lbldesc.Left = ScaleWidth / 2 - lbldesc.Width / 2
With lblmsg
    .Visible = True
    .Caption = "开始！"
    .AutoSize = True
    .Top = ScaleHeight / 2 - .Height - 100
    .Left = ScaleWidth / 2 - .Width / 2
    .ForeColor = vbRed
    .ZOrder 0
    .FontSize = 20
End With
'消息提示
timer4.Enabled = True
startY = ScaleHeight / 2
startX = 30
Dim i&, j&
For i = 0 To n Step 1
    trs(i).Y2 = ScaleHeight / 2 + 50
    trs(i).Y1 = trs(i).Y2 - trs(i).H
Next i
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
'控制消息显示
Private Sub timer4_Timer()
If msgflag = False Then
    lblmsg.Visible = True
    msgflag = True
Else
    timer4.Enabled = False
    msgflag = False
    lblmsg.Visible = False
End If
End Sub
'监控碰撞情况
Private Sub timer3_Timer()
If isCrash Then
    timer1.Enabled = False
    timer2.Enabled = False
    timer3.Enabled = False
    Do
        currentName = InputBox("请问英雄大名？", "记录")
    Loop While currentName = ""
    Form2.Show (vbModal)
    Form2.mysort
End If
End Sub
'跳跃动画
Private Sub timer2_Timer()
    '判断得分
    Dim i&
    score = 0
    For i = 0 To UBound(trs) Step 1
        If trs(i).X2 < dg.X2 Then score = score + 1
    Next i
    lblscore.Caption = "得分 " & score
    '判断得分是否改变
    If score <> scorelast Then
    End If
    lrflag = 0
    '跳跃方向向上0, 方向向下为1
   If jumpflag = 0 And startY <= ScaleHeight / 2 - 200 Then '100为跳跃方向向上时候的跳跃高度
        jumpflag = 1
   ElseIf jumpflag = 1 And startY >= ScaleHeight / 2 Then
        jumpflag = 0
        '中间位置才会向左移动
        If dg.X2 > ScaleWidth / 2 Then
            lrflag = 1
        End If
        timer2.Enabled = False
   End If
   If jumpflag = 1 Then
        startY = startY + 10
   ElseIf jumpflag = 0 Then
        startY = startY - 10
   End If
End Sub
Private Sub timer1_Timer()
Cls
'画地面
Call drawGround
'画龙
If status = 0 Then
    Call dragon1
    status = 1
Else
    Call dragon2
    status = 0
End If
'判断左右前进方向
If lrflag = 0 And dg.X2 > ScaleWidth / 2 Then
    lrflag = 1
ElseIf lrflag = 1 And dg.x1 < 100 Then
    lrflag = 0
End If
If lrflag = 0 Then
    startX = startX + 5
ElseIf lrflag = 1 Then
    startX = startX - 10
End If
'加边框
Call dragonBorder
'树的移动
Dim i&
Dim d&
d = 20
For i = 0 To n Step 1
    trs(i).x1 = trs(i).x1 - d
    trs(i).X2 = trs(i).X2 - d
Next i
'画树
Call drawTree
'云的移动
Dim d2&
d2 = 20
For i = 0 To n Step 1
    cld(i).x1 = cld(i).x1 - d2
    cld(i).X2 = cld(i).X2 - d2
Next i
'画云
Call drawCloud
'根据分数判断是否输出消息
If scorelast > 0 And scorelast Mod 10 = 0 Then
    lblmsg.Caption = "真棒！得到高分!最近已得" & score & "分"
    lblmsg.Left = ScaleWidth / 2 - lblmsg.Width / 2
    timer4.Enabled = True
End If
End Sub
'定位龙边框
Sub dragonBorder()
dg.x1 = startX - 20
dg.Y1 = startY - 2
dg.X2 = dg.x1 + 30
dg.Y2 = dg.Y1 + 55
'Line (dg.X1, dg.Y1)-(dg.X2, dg.Y2), vbRed, B
End Sub
'画云
Sub drawCloud()
Dim i&
For i = 0 To n - 2 Step 1
    Line (cld(i).x1, cld(i).Y1)-(cld(i).X2, cld(i).Y2)
    Line (cld(i + 1).x1, cld(i + 1).Y1)-(cld(i + 1).X2, cld(i + 1).Y2)
    Line (cld(i + 2).x1, cld(i + 2).Y1)-(cld(i + 2).X2, cld(i + 2).Y2)
Next i
End Sub
'画树
Sub drawTree()
    Dim i&
    For i = 0 To n Step 1
        Line (trs(i).x1, trs(i).Y1)-(trs(i).X2, trs(i).Y2), RGB(trs(i).C.R, trs(i).C.G, trs(i).C.B), BF
        '根据分数判断难度
        If scorelast > 10 And scorelast < 30 Then
            Line (trs(i).x1, trs(i).Y1)-(trs(i).X2 + scorelast, trs(i).Y2), RGB(trs(i).C.R, trs(i).C.G, trs(i).C.B), BF
        End If
    Next i
End Sub
'画地面
Sub drawGround()
Line (0, (ScaleHeight / 2) + 30)-(ScaleWidth, (ScaleHeight / 2) + 30)
Dim i&
For i = 0 To 1000 Step 1
    PSet (Int(Rnd * ScaleWidth), (ScaleHeight / 2) + 30 + Int(Rnd * 30))
Next i
End Sub
'碰撞模型,判断龙树是否碰撞
Function isCrash() As Boolean
    isCrash = False
    Dim i&
    For i = 0 To UBound(trs) Step 1
        If dg.X2 >= trs(i).x1 And dg.x1 <= trs(i).X2 _
           And dg.Y2 >= trs(i).Y1 And dg.Y1 <= trs(i).Y2 Then
            isCrash = True
            Exit For
        End If
    Next i
End Function
'龙绘画
Function dragon2()
Line (startX, startY - 1)-(startX + 20, startY + 1), vbBlack, BF
Line (startX - 3, startY + 1)-(startX + 23, startY + 15), vbBlack, BF
'眼睛
DrawWidth = 3
PSet (startX + 5, startY + 5), vbWhite
DrawWidth = 1
Line (startX - 3, startY + 15)-(startX + 10, startY + 19), vbBlack, BF
'嘴巴
Line (startX - 3, startY + 19)-(startX + 20, startY + 20), vbBlack, BF
'身体
Line (startX - 6, startY + 21)-(startX + 10, startY + 22), vbBlack, BF
Line (startX - 9, startY + 23)-(startX + 10, startY + 24), vbBlack, BF
Line (startX - 11, startY + 25)-(startX + 10, startY + 26), vbBlack, BF
'手
Line (startX + 10, startY + 25)-(startX + 16, startY + 26), vbBlack, BF
Line (startX + 16, startY + 26)-(startX + 17, startY + 28), vbBlack, BF
'身体
Line (startX - 14, startY + 26)-(startX + 10, startY + 28), vbBlack, BF
Line (startX - 20, startY + 29)-(startX + 10, startY + 35), vbBlack, BF
'尾巴
Line (startX - 22, startY + 25)-(startX - 20, startY + 34), vbBlack, BF
Line (startX - 24, startY + 23)-(startX - 23, startY + 32), vbBlack, BF
Line (startX - 25, startY + 21)-(startX - 24, startY + 30), vbBlack, BF
Line (startX - 26, startY + 15)-(startX - 25, startY + 28), vbBlack, BF
'身体
Line (startX - 18, startY + 35)-(startX + 8, startY + 37), vbBlack, BF
Line (startX - 16, startY + 38)-(startX + 6, startY + 40), vbBlack, BF
Line (startX - 14, startY + 41)-(startX + 4, startY + 43), vbBlack, BF
Line (startX - 12, startY + 44)-(startX - 4, startY + 45), vbBlack, BF
'脚1
Line (startX - 12, startY + 44)-(startX - 2, startY + 45), vbBlack, BF
Line (startX - 10, startY + 46)-(startX - 7, startY + 47), vbBlack, BF
Line (startX - 8, startY + 48)-(startX - 4, startY + 49), vbBlack, BF
'脚2
Line (startX, startY + 43)-(startX + 1, startY + 44), vbBlack, BF
Line (startX, startY + 44)-(startX + 1, startY + 50), vbBlack, BF
Line (startX + 1, startY + 51)-(startX + 5, startY + 52), vbBlack, BF
End Function
Function dragon1()
Line (startX, startY - 1)-(startX + 20, startY + 1), vbBlack, BF
Line (startX - 3, startY + 1)-(startX + 23, startY + 15), vbBlack, BF
'眼睛
DrawWidth = 3
PSet (startX + 5, startY + 5), vbWhite
DrawWidth = 1
Line (startX - 3, startY + 15)-(startX + 10, startY + 19), vbBlack, BF
'嘴巴
Line (startX - 3, startY + 19)-(startX + 20, startY + 20), vbBlack, BF
'身体
Line (startX - 6, startY + 21)-(startX + 10, startY + 22), vbBlack, BF
Line (startX - 9, startY + 23)-(startX + 10, startY + 24), vbBlack, BF
Line (startX - 11, startY + 25)-(startX + 10, startY + 26), vbBlack, BF
'手
Line (startX + 10, startY + 25)-(startX + 16, startY + 26), vbBlack, BF
Line (startX + 16, startY + 26)-(startX + 17, startY + 28), vbBlack, BF
'身体
Line (startX - 14, startY + 26)-(startX + 10, startY + 28), vbBlack, BF
Line (startX - 20, startY + 29)-(startX + 10, startY + 35), vbBlack, BF
'尾巴
Line (startX - 22, startY + 25)-(startX - 20, startY + 34), vbBlack, BF
Line (startX - 24, startY + 23)-(startX - 23, startY + 32), vbBlack, BF
Line (startX - 25, startY + 21)-(startX - 24, startY + 30), vbBlack, BF
Line (startX - 26, startY + 15)-(startX - 25, startY + 28), vbBlack, BF
'身体
Line (startX - 18, startY + 35)-(startX + 8, startY + 37), vbBlack, BF
Line (startX - 16, startY + 38)-(startX + 6, startY + 40), vbBlack, BF
Line (startX - 14, startY + 41)-(startX + 4, startY + 43), vbBlack, BF
Line (startX - 12, startY + 44)-(startX - 4, startY + 45), vbBlack, BF
'脚1
Line (startX - 12, startY + 44)-(startX - 2, startY + 45), vbBlack, BF
Line (startX - 12, startY + 46)-(startX - 4, startY + 47), vbBlack, BF
Line (startX - 12, startY + 48)-(startX - 6, startY + 49), vbBlack, BF
Line (startX - 12, startY + 50)-(startX - 10, startY + 52), vbBlack, BF
Line (startX - 12, startY + 53)-(startX - 6, startY + 54), vbBlack, BF
'脚2
Line (startX, startY + 43)-(startX + 1, startY + 46), vbBlack, BF
Line (startX, startY + 46)-(startX + 5, startY + 46), vbBlack, BF
End Function

Private Sub Command1_Click()
Call Form1.init
Form2.Hide
End Sub
Private Sub Form_Activate()
List1.AddItem Form1.currentName
List2.AddItem Form1.score
Command1.SetFocus
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Form1.init
End Sub
Public Sub mysort()
'排序
Dim i&, j&
For i = 0 To List2.ListCount Step 1
    For j = 0 To List2.ListCount - 2 Step 1
        If Val(List2.List(j)) < Val(List2.List(j + 1)) Then
            Dim t&, s$
            t = List2.List(j)
            List2.List(j) = List2.List(j + 1)
            List2.List(j + 1) = t
            s = List1.List(j)
            List1.List(j) = List1.List(j + 1)
            List1.List(j + 1) = s
        End If
    Next j
Next i
End Sub