当前位置: 源码素材网 » VB教程 » 详情页

VB旋转泡泡游戏中的一个球体集合类代码,值得参考

  •   时间:2020-02-11
  • 概述:游戏代码

从一个VB编写的游戏中整理出来的代码,添加了注释,这个游戏是旋转泡泡,本代码主要是球体集合类,反映出了当前可挑选的颜色球,供界面选择彩球的支撑类,会根据资源的大小,请求的宽高来自动计算出资源的每个均分块,记住,这是特定的类结构,然后依次创建没个对象。每个集合中的对象都有自己的唯一名字。

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "balls"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'--这是球体集合,它也反映出了当前可挑选的颜色球
'--这是供界面选择彩球的支撑类。
'--它会根据资源的大小,请求的宽高来自动计算出资源
'--的每个均分块,记住,这是特定的类结构。
'--然后依次创建没个对象。
'--每个集合中的对象都有自己的唯一名字。名字的规则就是
'--row xx col xx
'--有一个创建函数
Option Explicit
Private balls As Collection
Private selnames(15) As String '--被选中的彩球名字保存。
Private selnumber As Long '--可选择的彩球个数,它决定了泡泡产生可选择的单元对象,默认为4个
Private cellcount As Long '--单元总数,selnumber不可以大于它
Private isValid As Boolean '--该集合对象是否有效
Const size As Long = 24 '--对单元的规定尺寸
Private mvrespb As PictureBox
Private mvshowpb As PictureBox
'--设置或获取可选择球单元的个数
Public Property Get AbleSelCount() As Long
    '--可选球的个数
    If isValid Then
        AbleSelCount = selnumber
    Else
        AbleSelCount = 0
    End If
End Property
Public Property Get SelBalls() As Long
    If isValid Then
        SelBalls = selnumber
    Else
        SelBalls = 0
    End If
End Property
Public Property Let SelBalls(newBalls As Long)
    If isValid Then
        '--现在看cellcount是否小于默认值4,可选的球数
        Dim bi As Long, ballidx As Long
        If cellcount < 4 Then
            selnumber = cellcount
            '--全部放到可选单元中去
            For bi = 1 To balls.Count
                selnames(bi - 1) = balls(bi).ResName
            Next
        Else
            If newBalls < 4 Or newBalls > cellcount Then
                selnumber = 4
            Else
                selnumber = newBalls
            End If
            '--先把所有球单元的选中标记置假
            For bi = 1 To balls.Count
                balls(bi).ResIsSel = False
            Next
            '--随机挑选指定个数的球单元为可选
            For bi = 1 To selnumber
ReSel:
                ballidx = Int(Rnd() * cellcount) + 1
                If balls(ballidx).ResIsSel Then
                    GoTo ReSel '--重新产生选择彩球
                Else
                    selnames(bi - 1) = balls(ballidx).ResName
                    balls(ballidx).ResIsSel = True '--置选中标记
                End If
            Next
        End If
        '--最后,为选种的球画一个白色的边框
        Dim tx As Long, ty As Long
        Dim row As Long, col As Long
        Dim rowe As Long, cole As Long
        cole = mvrespb.ScaleWidth \ size
        rowe = mvrespb.ScaleHeight \ size
        '--绘制小彩球的显示界面
        mvshowpb.Cls
        For row = 0 To rowe - 1
            For col = 0 To cole - 1
                '--球之间的间隔为5个象素
                BitBlt mvshowpb.hdc, col * 24 + 4 * (col + 1), row * 24 + 4 * (row + 1), size, size, res.cellmask.hdc, 0, 0, SRCAND
                BitBlt mvshowpb.hdc, col * 24 + 4 * (col + 1), row * 24 + 4 * (row + 1), size, size, mvrespb.hdc, col * 24, row * 24, SRCPAINT
            Next
        Next
        For bi = 1 To selnumber
            '利用对象的名字来获取坐标绘制
            row = CLng(Mid(selnames(bi - 1), 4, 1))
            col = CLng(Right(selnames(bi - 1), 1))
            tx = col * 24 + 4 * (col + 1)
            ty = row * 24 + 4 * (row + 1)
            mvshowpb.Line (tx - 2, ty - 2)-(tx + size, ty + size), vbWhite, B
        Next
        mvshowpb.Refresh '--显示刷新
    End If
End Property
'--size系列参数表明了这个单元尺寸
Public Function CreateBalls(respb As PictureBox, show As PictureBox) As Boolean
    If respb Is Nothing Or show Is Nothing Then
        MsgBox "资源容器不存在!", vbInformation
    Else
        Set balls = New Collection '--创建集合对象,保存球单元对象
        Dim row As Long, col As Long
        Dim rowe As Long, cole As Long
        Dim ballobj As BallCell
        cole = respb.ScaleWidth \ size
        rowe = respb.ScaleHeight \ size
        For row = 0 To rowe - 1
            For col = 0 To cole - 1
              Set ballobj = New BallCell '--创建球对象。
              ballobj.ResHeight = 24
              ballobj.ResWidth = 24
              ballobj.ResName = "row" & row & "col" & col
              ballobj.ResX = col * 24
              ballobj.ResY = row * 24
              ballobj.ResNeedMask = True
              ballobj.ResIsSel = False '--默认为未被选中
              balls.Add ballobj, ballobj.ResName '--添加球到集合中去
              cellcount = cellcount + 1 '--单元资源记数
            Next
        Next
        Set mvrespb = respb
        Set mvshowpb = show
        isValid = True '--对象有效
        '--设置彩球选择属性
        SelBalls = 16    '--增加一倍
    End If
End Function
'--通过一个缩引编号来获得一个ballcell对象
Public Function GetBallCell(idx As Long) As BallCell
    If isValid Then '--对象有效才能获取球对象
        If idx < 0 Or idx >= selnumber Then
            GetBallCell = Nothing
        Else
           Set GetBallCell = balls(selnames(idx))  '--从数组中取得名字关键字,从而获取球单元对象
        End If
    End If
End Function
Private Sub Class_Initialize()
    isValid = False '--对象无效
    selnumber = 0
    cellcount = 0
End Sub
'--获得balls集合对象的状态
Public Property Get BallsState() As Boolean
    BallsState = isValid
End Property
Private Sub Class_Terminate()
    Set balls = Nothing
End Sub

 最好是下载完整的游戏代码以便参考。

    相关声明:

      若“VB旋转泡泡游戏中的一个球体集合类代码,值得参考”有损您的权益,请告之我们删除内容。
      部分文章来源于网络,版权归原作者所有。