VisualFreeBasic游戏趣味编程_10.4_方块提示框的绘制

为了便于玩家看到自己点击的方块、十字区域内可以消除的方块，需要绘制方块提示框。首先定义绘制提示框的函数：

            gg.Brush BGR(105, 105, 105) 'GDI的颜色值。
            gg.DrawFrame blocks(clicked_i, clicked_j).x,blocks(clicked_i, clicked_j).y, BlockSize,BlockSize

如果十字区域有要消除的彩色方块，则执行：

  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

实现效果如图10-7所示，点击的空白方块用灰色填充提示，十字区域待消除的方块用黑色方形线框提示，

完整代码

#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

End Sub

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

   Sleep 10 '暂停若干毫秒
End Sub
Sub updateWithInput(hWndForm As hwnd, gg As yGDI) ' 和输入有关的更新
   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
                     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