VisualFreeBasic游戏趣味编程_10.3_鼠标点击与十字消除

首先添加updateWithInput()函数，根据鼠标点击位置(m.x, m.y)计算点中的小方块在二维数组中的行列序号(clicked_i, clicked_j)。为了方便调试，可以将blocks(clicked_i,clicked_j).colorId设为0，即将其颜色设为灰白色：

Sub updateWithInput(hWndForm As hwnd) ' 和输入有关的更新
   Static pp As Long '预防鼠标一直按住，造成一直点击
   If IsKeyPress(VK_LBUTTON) Then '鼠标左键点击
      If pp = 0 Then
         pp = 1 '表示鼠标按下
         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 '表示点中圆圈
            blocks(clicked_i, clicked_j).colorId =0
         End If
      End If
   Else
      pp = 0 '表示鼠标放开
   End If
End Sub

下一步，寻找被鼠标点中的方块的上、下、左、右4个方向，分别找到4个方向上第一个不是空白颜色的彩色方块。

在updateWithInput()函数中，首先判断被鼠标点中的方块是否为空白方块，如果是函数直接返回：

If blocks(clicked_i, clicked_j).colorId = 0 Then Return   '如果当前点击的不是空白方块，则不需要处理，返回

如图10-5所示，假设C为被鼠标点中的方块，首先定义数组Block fourBlocks[4]，并将其元素初始化为方块C：

' 定义数组,存储上、下、左、右4个方向找到第一个不是空白的方块
Dim fourBlocks(3) As Long Block '初始化为点击的方块

首先向上寻找，找到第一个不是空白的方块，比如图10-5中的U，存储在fourBlocks(0)中：

            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

注意search从 clicked_i 开始向上寻找，直到边界为 0 ， Step -1 为每循环一次 search 会-1 。当找到一个颜色序号不是0的方块时，赋值后执行 Exit For 语句，停止循环。

同样从方块C开始向下、向左、向右找到第一个颜色不是空白的方块，分别存放到fourBlocks（1）、fourBlocks（2）、fourBlocks（3）中：

            '向下找到第一个颜色不是空白的方块  
            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

假如某一方向一直找到边界仍然没有彩色方块，比如图10-5中的向左寻找，则fourBlocks[2]中储存其初值，即为空白方块C。

进一步，统计数组fourBlocks的4个元素，检查是否有2个或2个以上相同颜色的彩色方块，如果有就将其消除。

首先定义数组colorStatistics存储各种颜色的小方块的个数：

Dim colorStatistics(ColorTypeNum) As Long

遍历fourBlocks，统计对应颜色彩色方块的个数。如果某种颜色的方块个数colorStatistics[i] >=2，则将对应方块的颜色序号设为0：

            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，也就是空白的灰白色
                        blocks(fourBlocks(j).i, fourBlocks(j).j).colorId = 0
                     End If
                  Next
               End If
            Next

实现效果如图

完整代码参考

#define BlockSize 19   '小方块的边长
#define RowNum 12      '游戏画面一共RowNum行小方块
#define ColNum 21      '游戏画面一共ColNum列小方块
#define ColorTypeNum 9 '方块颜色为彩色的个数
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 ' 颜色数组，小方块可能的几种颜色
Sub startup() '初始化函数
   Dim As Long i, j  ,t 
   '对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 
      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
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

   gg.Redraw
End Sub

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

   Sleep 10 '暂停若干毫秒
End Sub
Sub updateWithInput(hWndForm As hwnd) ' 和输入有关的更新
   Static pp As Long '预防鼠标一直按住，造成一直点击
   If IsKeyPress(VK_LBUTTON) Then '鼠标左键点击
      If pp = 0 Then
         pp = 1 '表示鼠标按下
         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 '如果当前点击的不是空白方块，则不需要处理，返回
            ' 定义数组,存储上、下、左、右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，也就是空白的灰白色
                        blocks(fourBlocks(j).i, fourBlocks(j).j).colorId = 0
                     End If
                  Next
               End If
            Next
         End If
      End If
   Else
      pp = 0 '表示鼠标放开
   End If
End Sub
Sub 游戏执行过程(hWndForm As hWnd)
   Dim gg As yGDI = hWndForm
   startup() '初始化
   Do '循环执行
      show(gg) '绘制
      updateWithInput(hWndForm)
      updateWithoutInput()
   Loop

End Sub