-
VisualFreeBasic游戏趣味编程_10.7_多关卡与增加游戏难度 首先，定义level表示当前为第几关： Dim Shared level As Long = 1 ' 当前关卡序号 在start()函数中，随着level的增加，当前关的游戏总时长越来越短： maxTime = 200 - level*10 show()函数中显示当前为第几关、已得分数、得到多少分可以进入下一关： gg.DrawTextS 0, 242, 窗口宽度, 20, "当前第" & level & "关，已得" & score & "分,达到" & Int(0.9 *noZeroBlockNum) & "分进入下一关", DT_CENTER Or DT_VCENTER Or DT_SINGLELINE updateWithoutInput()函数中，如果得分达到要求，则将level加1，重新计时，并调用startup()函数进入下一关；如果得分没有达到要求且时间到了，则继续重新开始这一关的游戏： Sub updateWithoutInput() '与输入无关的更新 If score >= 0.9 *noZeroBlockNum Then ' 得分达到要求 level += 1 '如果得分达到要求，进入下一关 startup() '调用初始化函数，重新开始游戏 ElseIf maxTime - (GetTickCount - remainTime) / 1000 < 0 Then '得分没有达到要求且时间到了 startup() '调用初始化函数，重新开始游戏 End If Sleep 10 '暂停若干毫秒 End Sub -
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 -
VisualFreeBasic游戏趣味编程_10.5_倒计时与进度条 输入并运行以下代码，窗口显示出程序运行了多少秒： Sub 游戏执行过程(hWndForm As hWnd) Dim gg As yGDI = hWndForm Dim 开始时间 As Double = Now() Dim 当前时间 As Double Do '循环执行 gg.Cls gg.Font "黑体", 20 当前时间 = Now() gg.DrawString 100,100,"程序运行了" & DateDiff("s",开始时间,当前时间) & "秒" gg.Redraw Sleep 20 Loop End Sub 首先定义两个用于计时的变量 Dim 开始时间 As Double Dim 当前时间 As Double 程序开始运行时获得当前时刻： Dim 开始时间 As Double= Now() 在do循环语句中，再次获得程序运行到此的时刻： 当前时间 = Now() 用 DateDiff 函数计算时间差，即可得到程序一共运行了多少秒： DateDiff("s",开始时间,当前时间) 进一步修改代码带进度条如下： Sub 游戏执行过程(hWndForm As hWnd) Dim gg As yGDI = hWndForm Dim 开始时间 As Double = Now() Dim 当前时间 As Double Dim maxTime As Long =20 ' 游戏允许的总时长 Dim remainTime As Long = maxTime ' 游戏剩余时间 Dim 窗口宽度 As Long = DpiUnScaleI(Form1.ScaleWidth) Do '循环执行 gg.Cls gg.Brush BGR(255, 0, 0) 'GDI的颜色值。 remainTime = maxTime - DateDiff("s", 开始时间, 当前时间) If remainTime < 0 Then remainTime = 0 Else gg.DrawFrame 0, 0, 窗口宽度/maxTime * remainTime ,20 End If gg.Font "黑体", 20 当前时间 = Now() gg.DrawString 100, 100, "程序运行了" & DateDiff("s", 开始时间, 当前时间) & "秒" gg.Redraw Sleep 20 Loop End Sub 然而发现进度条一秒跳一次，不够丝滑，我们改用代码。 Sub 游戏执行过程(hWndForm As hWnd) Dim gg As yGDI = hWndForm Dim 开始时间 As ULong = GetTickCount Dim 当前时间 As ULong Dim maxTime As Single =20 ' 游戏允许的总时长 Dim remainTime As Single Dim 窗口宽度 As Long = DpiUnScaleI(Form1.ScaleWidth) Do '循环执行 gg.Cls gg.Brush BGR(255, 0, 0) 'GDI的颜色值。 当前时间 = GetTickCount remainTime = maxTime - (当前时间-开始时间)/1000 If remainTime < 0 Then remainTime = 0 Else gg.DrawFrame 0, 0, 窗口宽度/maxTime * remainTime ,20 End If gg.Font "黑体", 20 gg.DrawString 100, 100, "程序运行了" & Int((当前时间-开始时间)/1000) & "秒" gg.Redraw Sleep 20 Loop End Sub 其中 GetTickCount 是系统API，获取系统开机以来的时间，毫秒为单位。有了毫秒级别，进度跳是丝滑了。下面我们把进度跳加入到游戏中。 全局变量 Dim Shared maxTime As Single =20 ' 游戏允许的总时长 Dim Shared remainTime As ULong '开始时间 其中，变量maxTime记录游戏允许的总时长，remainTime记录游戏开始时间 在start()初始化函数中，加大窗口高度用于显示倒计时进度条，并对时间变量进行初始化： remainTime = GetTickCount() 最后在show( )函数中添加代码绘制出倒计时进度条： Dim 窗口宽度 As Long = DpiUnScaleI(Form1.ScaleWidth) 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, 20 End If
-
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 -
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 -
VisualFreeBasic游戏趣味编程_10.2_随机颜色方块的实现 为了实现随机颜色的方块，首先进行宏定义： #define ColorTypeNum 9 '方块颜色为彩色的个数 定义全局变量colors数组记录ColorTypeNum+1种颜色，其中第0种为灰白色（表示空白），其他为彩色： Dim Shared colors(ColorTypeNum) As COLORREF ' 颜色数组，小方块可能的几种颜色 在startup()函数中对颜色数组进行初始化： colors(0) = BGR(225, 225, 225) ' 颜色数组第一种颜色为灰白色，表示空白小方块 For i = 1 To ColorTypeNum '其他几种颜色为彩色 colors(i) = HSBtoRGB_Gdi(HSB((i -1) * 40, 80, 90, 255)) Next 为了记录小方块的颜色，为Block结构体添加成员变量colorId： Type Block ' 小方块结构体 As Long x, y ' 小方块在画面中的x,y坐标 As Long i, j ' 小方块在二维数组中的i,j下标 colorId As Long '对应颜色的下标 End Type 在startup()中对blocks初始化时，设置其颜色序号为[0, ColorTypeNum]的随机数： Randomize blocks(i, j).colorId = Int(Rnd * (ColorTypeNum+1)) 在show()函数中以对应颜色绘制出所有的小方块： gg.Brush colors(blocks(i, j).colorId) '设置填充颜色 gg.DrawFrame blocks(i, j).x,blocks(i, j).y, BlockSize,BlockSize 实现效果如图10-3所示 修改中随机颜色的生成代码，使得1/3的方块颜色为灰白色，更符合“十字消除”游戏的玩法，如图10-4所示。 完整代码 #define BlockSize 19 '小方块的边长 #define RowNum 13 '游戏画面一共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, gg As ygdi) ' 和输入有关的更新 End Sub Sub 游戏执行过程(hWndForm As hWnd) Dim gg As yGDI = hWndForm startup() '初始化 Do '循环执行 show(gg) '绘制 updateWithInput(hWndForm, gg) updateWithoutInput() Loop End Sub -
VisualFreeBasic游戏趣味编程_10.1_红色方块的表示与绘制 十字消除游戏画面由很多小方块组成，首先进行宏定义： #define BlockSize 19'小方块的边长 #define RowNum 13 '游戏画面一共RowNum行小方块 #define ColNum 21 '游戏画面一共ColNum列小方块 定义小方块结构体： Type Block ' 小方块结构体 As Long x, y ' 小方块在画面中的x,y坐标 As Long i, j ' 小方块在二维数组中的i,j下标 End Type 利用Block结构体类型，定义二维数组blocks全局变量，存储游戏画面中所有小方块的信息： Dim Shared blocks(RowNum -1, ColNum -1) As Block ' 构建二维数组，存储所有数据 在startup()中初始化blocks，将其设置为红色填充、白色线条；show()函数中绘制出所有的小方块，显示效果如图10-2所示。 #define BlockSize 19 '小方块的边长 #define RowNum 13 '游戏画面一共RowNum行小方块 #define ColNum 21 '游戏画面一共ColNum列小方块 Type Block ' 小方块结构体 As Long x, y ' 小方块在画面中的x,y坐标 As Long i, j ' 小方块在二维数组中的i,j下标 End Type '全局变量定义 Dim Shared blocks(RowNum -1, ColNum -1) As Block ' 构建二维数组，存储所有数据 Sub startup() '初始化函数 Dim As Long i, j '对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 Next Next End Sub Sub show(gg As yGDI) '绘制函数 gg.Cls BGR(220, 220, 220) '灰色背景。 gg.Pen 1, BGR(255, 255, 255) ' 白色线条 gg.Brush BGR(255, 0, 0) '设置填充颜色 Dim As Long i, j ' 以对应的颜色、坐标画出所有的小方块 For i = 0 To RowNum -1 For j = 0 To ColNum -1 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, gg As ygdi) ' 和输入有关的更新 End Sub Sub 游戏执行过程(hWndForm As hWnd) Dim gg As yGDI = hWndForm startup() '初始化 Do '循环执行 show(gg) '绘制 updateWithInput(hWndForm, gg) updateWithoutInput() Loop End Sub -
VisualFreeBasic游戏趣味编程_第10章_“十字消除”游戏 在本章我们将探讨如何编写“十字消除”游戏，用户点击空白方块，沿其上、下、左、右方向寻找第一个彩色方块，如果有两个或两个以上颜色一致，就将其消除。在进度条时间结束前消除足够的方块，可以进入下一关，效果如图10-1所示。 本章首先讲解了如何实现随机颜色方块的表示与绘制，鼠标点击与十字消除算法；然后讲解了如何绘制提示框和倒计时进度条；接着讲解了如何开发得分计算、胜负判断、多关卡功能；接下来介绍了地址与指针的概念，并讲解了如何利用地址传递使得程序更加模块化；最后介绍了指针和数组的知识，应用动态数组讲解了如何实现游戏尺寸的动态大小调整。 -
VisualFreeBasic游戏趣味编程_9.8_枚举类型 如果一个变量只有几种可能的值，则该变量可以定义为枚举类型： Enum Element '定义枚举类型, 小方块所有的可能的种类 wall, target, box, empty, achieved, role End Enum Dim level(7, 7) As Long = {{wall, wall, wall, wall, wall, wall, wall, wall}, _ {wall, wall, wall, target, box, empty, empty, wall}, _ {wall, empty, empty, empty, empty, empty, empty, wall}, _ {wall, empty, empty, empty, empty, empty, empty, wall}, _ {wall, empty, empty, empty, empty, empty, empty, wall}, _ {wall, role, empty, box, target, wall, wall, wall}, _ {wall, empty, empty, empty, empty, wall, wall, wall}, _ {wall, wall, wall, wall, wall, wall, wall, wall}} 其中，enum为定义枚举类型的关键词，Element为用户定义的枚举类型的名称，{}内列出了所有可能的取值。 也可以直接定义枚举类型二维数组level，存储所有的地图数据。将level由字符型调整为枚举类型，这样程序的可读性更好，也可以避免赋值不当造成的问题。 -
VisualFreeBasic游戏趣味编程_9.7_基于文件的关卡数据读取 FB语言提供了文件读写的功能，输入并运行以下代码： Dim buffer As String, f As Integer buffer = "一个文件中的Hello World。" f = FreeFile '打开文件“test.ext”进行二进制使用，使用文件号“f”。 Open "test.txt" For Binary As #f If Err>0 Then Print "打开文件时出错":End '将我们的字符串放在文件中，使用数字“f”。 Put #f, , buffer '关闭所有打开的文件。 Close 其中，Open "file.ext" For Binary As #f以可写模式打开文本文件，"test.txt"为文件的名字, Put #f, , buffer 将字符串str存储到文件中，close 关闭文件。 通常我们使用封装的函数来读写文件，方便简单 Dim ss As String ss = "文件测试" SaveFileStr("test.txt", ss) '写入文件 ss = GetFileStr("test.txt") '读取文件 "test.txt" 文件会保存在和 软件文件夹下，但是，当有的软件修改了默认文件夹，那么就保存到其它文件夹里，通常，我们为了保证，一定保存在特点文件夹，必须指定文件夹，比方：App.Path （ 软件文件夹） Dim ss As String ss = "文件测试" SaveFileStr(App.Path & "test.txt", ss) '写入文件 ss = GetFileStr(App.Path & "test.txt") '读取文件 新生成了一个test.txt文本文件，用记事本打开，内容如图9-8所示。 为了便于关卡数据的编辑与保存，新建文本文件level.txt并写入地图元素缩写字符，如图9-10所示。 以下代码就可以读取文本文件中的地图信息。 Dim ss As String ss = GetFileStr(App.Path & "level.txt") '读取文件 Dim ee() As String vbSplit(ss, vbcrlf, ee()) '分割字符串 Dim i As Long for i = 0 to UBound(ee) ‘把读取文件的数据，装载到 level 变量中 If i >= B_NUM Then Exit For '预防地图数据错误，导致超过数组，把软件搞崩溃了 level(i) = ee(i) Next 提示 当直接运行编译成功的exe文件时，要读写的文件应和其放在同一个目录下。