VisualFreeBasic游戏趣味编程_10.6_得分计算与胜负判断

首先定义变量score记录玩家消去的方块个数，noZeroBlockNum记录游戏开始时彩色砖块的总数，设定当score>=0.9*noZeroBlockNum时游戏胜利：

Dim Shared score As Long '得分数，也就是消去的方块的个数
Dim Shared noZeroBlockNum As Long '非空白区域的砖块的个数

在startup()初始化函数中统计随机生成的彩色砖块总数：

If t > 0 Then noZeroBlockNum += 1 '统计随机产生的方块中，非零方块的个数

将得分初始化为0：

   noZeroBlockNum = 0
   score = 0  '得分数，也就是消去的方块的个数

在updateWithInput()函数中，更新十字区域消除的方块个数：

score += colorStatistics(i) ' 得分加上消除的方块数

在show()函数中，显示当前得分score，游戏胜利要求的得分数0.9* noZeroBlockNum：

   gg.Font "黑体", 10
   gg.DrawTextS 0,242,窗口宽度,20, "当前" & score & "分,达到" & Int(0.9*noZeroBlockNum) & "分游戏胜利",DT_CENTER Or DT_VCENTER Or DT_SINGLELINE

gg.DrawTextS 是指定范围，后面的 DT_CENTER Or DT_VCENTER Or DT_SINGLELINE 参数是把文字画在范围的中间。
当score>=0.9*noZeroBlockNum时，输出游戏胜利信息：

   If score >= 0.9 *noZeroBlockNum Then '消去足够的方块，游戏胜利
      gg.Font "黑体", 50
      gg.DrawTextS 0, 80, 窗口宽度, 80, "游 戏 胜 利", DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
   End If

最后在updateWithoutInput()、updateWithInput()中添加代码，时间结束后游戏停止更新：

   If maxTime - (GetTickCount - remainTime) / 1000 < 0 Then Return

全部代码

#define BlockSize 19   '小方块的边长
#define RowNum 12      '游戏画面一共RowNum行小方块
#define ColNum 21      '游戏画面一共ColNum列小方块
#define ColorTypeNum 8 '方块颜色为彩色的个数
Type Block ' 小方块结构体
   As Long x, y ' 小方块在画面中的x,y坐标
   As Long i, j ' 小方块在二维数组中的i,j下标
   colorId As Long '对应颜色的下标
End Type
'全局变量定义
Dim Shared blocks(RowNum -1, ColNum -1) As Block    ' 构建二维数组，存储所有数据
Dim Shared colors(ColorTypeNum)         As COLORREF ' 颜色数组，小方块可能的几种颜色
Dim Shared maxTime    As Single = 200 ' 游戏允许的总时长
Dim Shared remainTime As ULong '开始时间
Dim Shared score As Long '得分数，也就是消去的方块的个数
Dim Shared noZeroBlockNum As Long '非空白区域的砖块的个数

Sub startup() '初始化函数
   Dim As Long i, j, t
   noZeroBlockNum = 0
   score = 0  '得分数，也就是消去的方块的个数
   '对blocks二维数组进行初始化
   For i = 0 To RowNum -1
      For j = 0 To ColNum -1
         blocks(i, j).x = j * BlockSize '小方块左上角的坐标
         blocks(i, j).y = i * BlockSize
         blocks(i, j).i = i '存储当前小方块在二维数组中的下标
         blocks(i, j).j = j
         Randomize
         t = Int(Rnd * (ColorTypeNum + 5)) -4 '为了产生更多的灰白色，更符合“十字消除”游戏的玩法
         If t < 0 Then t = 0
         blocks(i, j).colorId = t
         If t > 0 Then noZeroBlockNum += 1 '统计随机产生的方块中，非零方块的个数
      Next
   Next
   colors(0) = BGR(225, 225, 225) ' 颜色数组第一种颜色为灰白色，表示空白小方块
   For i = 1 To ColorTypeNum '其他几种颜色为彩色
      colors(i) = HSBtoRGB_Gdi(HSB((i -1) * 40, 80, 90, 255))
   Next
   remainTime = GetTickCount()

End Sub

Sub show(gg As yGDI) '绘制函数
   gg.Cls BGR(220, 220, 220) '灰色背景。
   gg.Pen 1, BGR(255, 255, 255) ' 白色线条

   Dim As Long i, j
   ' 以对应的颜色、坐标画出所有的小方块
   For i = 0 To RowNum -1
      For j = 0 To ColNum -1
         gg.Brush colors(blocks(i, j).colorId) '设置填充颜色
         gg.DrawFrame blocks(i, j).x, blocks(i, j).y, BlockSize, BlockSize
      Next
   Next
   Dim 窗口宽度 As Long = DpiUnScaleI(Form1.ScaleWidth)

   gg.Font "黑体", 10
   gg.DrawTextS 0, 242, 窗口宽度, 20, "当前" & score & "分,达到" & Int(0.9 *noZeroBlockNum) & "分游戏胜利", DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
   If score >= 0.9 *noZeroBlockNum Then '消去足够的方块，游戏胜利
      gg.Font "黑体", 50
      gg.DrawTextS 0, 80, 窗口宽度, 80, "游 戏 胜 利", DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
   Else
      gg.Brush BGR(255, 0, 0) 'GDI的颜色值。
      Dim tt As Single = maxTime - (GetTickCount - remainTime) / 1000
      If tt < 0 Then
         tt = 0
      Else
         gg.DrawFrame 0, 230, 窗口宽度 / maxTime * tt, 15
      End If
   End If
End Sub

Sub updateWithoutInput() '与输入无关的更新

   Sleep 10 '暂停若干毫秒
End Sub
Sub updateWithInput(hWndForm As hwnd, gg As yGDI) ' 和输入有关的更新
   If maxTime - (GetTickCount - remainTime) / 1000 < 0 Then Return

   Static pp As Long '预防鼠标一直按住，造成一直点击
   If IsKeyPress(VK_LBUTTON) <> 0 Or pp = 1 Then '鼠标左键点击

      Dim ps As Point
      GetCursorPos(@ps) '获取鼠标在屏幕的位置
      MapWindowPoints HWND_DESKTOP, hWndForm, @ps, 1 '将鼠标位置从屏幕转换到游戏窗口的位置
      ps.x = DpiUnScaleI(ps.x) '响应系统DPI
      ps.y = DpiUnScaleI(ps.y)
      '通过鼠标位置计算出点击的小方块在二维数组中的下标
      Dim clicked_i As Long = Int(ps.y / BlockSize)
      Dim clicked_j As Long = int(ps.x / BlockSize)
      If clicked_i >= 0 And clicked_j >= 0 And clicked_i < RowNum And clicked_j < ColNum Then '表示点中圆圈
         If blocks(clicked_i, clicked_j).colorId <> 0 Then Return '如果当前点击的不是空白方块，则不需要处理，返回
         gg.Brush BGR(105, 105, 105) 'GDI的颜色值。
         gg.DrawFrame blocks(clicked_i, clicked_j).x, blocks(clicked_i, clicked_j).y, BlockSize, BlockSize

         ' 定义数组,存储上、下、左、右4个方向找到第一个不是空白的方块
         Dim fourBlocks(3) As Block '初始化为点击的方块
         Dim search        As Long  '寻找下标
         '向上找到第一个颜色不是空白的方块
         For search = clicked_i To 0 Step -1
            If blocks(search, clicked_j).colorId <> 0 Then
               fourBlocks(0) = blocks(search, clicked_j)
               Exit For
            End If
         Next
         '向下找到第一个颜色不是空白的方块
         For search = clicked_i To RowNum -1
            If blocks(search, clicked_j).colorId <> 0 Then
               fourBlocks(1) = blocks(search, clicked_j)
               Exit For
            End If
         Next
         '向左找到第一个颜色不是空白的方块
         For search = clicked_j To 0 Step -1
            If blocks(clicked_i, search).colorId <> 0 Then
               fourBlocks(2) = blocks(clicked_i, search)
               Exit For
            End If
         Next
         '向右找到第一个颜色不是空白的方块
         For search = clicked_j To ColNum
            If blocks(clicked_i, search).colorId <> 0 Then
               fourBlocks(3) = blocks(clicked_i, search)
               Exit For
            End If
         Next
         Dim colorStatistics(ColorTypeNum) As Long
         Dim As Long i, j
         'i=0表示空白颜色，不要统计
         For i = 1 To ColorTypeNum
            For j = 0 To 3
               If fourBlocks(j).colorId = i Then
                  colorStatistics(i) += 1
               End If
            Next
            If colorStatistics(i) >= 2 Then '如果这种颜色方块个数大于等于2
               '把对应十字区域要消除的方块颜色改成空白颜色
               For j = 0 To 3 '遍历fourBlocks
                  If fourBlocks(j).colorId = i Then
                     '颜色序号设为0，也就是空白的灰白色
                     gg.Pen 2, 0
                     gg.Brush
                     gg.DrawFrame blocks(fourBlocks(j).i, fourBlocks(j).j).x, blocks(fourBlocks(j).i, fourBlocks(j).j).y, BlockSize, BlockSize
                     If pp = 1 And IsKeyPress(VK_LBUTTON) = 0 Then
                        blocks(fourBlocks(j).i, fourBlocks(j).j).colorId = 0
                        score += 1 ' 得分加上消除的方块数
                     End If
                  End If
               Next
            End If
         Next
      End If
      If pp = 0 And IsKeyPress(VK_LBUTTON) <> 0 Then
         pp = 1 '表示鼠标按下
      ElseIf IsKeyPress(VK_LBUTTON) = 0 Then
         pp = 0
      End If
   End If
End Sub
Sub 游戏执行过程(hWndForm As hWnd)
   Dim gg As yGDI = hWndForm
   startup() '初始化
   Do        '循环执行
      show(gg) '绘制
      updateWithInput(hWndForm, gg)
      gg.Redraw
      updateWithoutInput()

   Loop
End Sub