-
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文件时，要读写的文件应和其放在同一个目录下。 -
VisualFreeBasic游戏趣味编程_9.6_多关卡的实现 为了实现多个关卡的游戏，首先利用宏定义设定关卡数目： #define LEVEL_TOTALNUM 3 '一共多少关卡 假设一共有3关，则可以设定2维字符数组levels，存储这3关的所有地图数据： Dim Shared level(LEVEL_TOTALNUM -1, B_NUM -1) As ZString * B_NUM + 1 = _ {_ {"wwwwwwww", "wwwtbeew", "weeeeeew", "weeeeeew", "weeeeeew", "weepaeew", "weeewwww", "wwwwwwww"}, _ '第1关 {"wwwwwwww", "wwweewww", "wpetbwww", "weeebeww", "wewteeww", "weeeeeww", "weepwwww", "wwwwwwww"}, _ '第2关 {"wwwwwwww", "wwpeewww", "weeweeww", "webabeww", "weeteeww", "wwetewww", "wwwwwwww", "wwwwwwww"} _ '第3关 } 定义currentLevelNum表示当前玩到第几关，二维数组level存储正在玩的这一关的地图数据，则可以在startup()函数中进行初始化： Sub startup() '初始化函数 Dim i As Long, j As Long For i = 0 To B_NUM -1 '首先获得当前关的地图数据 level(i) = levels(currentLevelNum, i) Next 在update()函数中，如果当前关卡完成，就将currentLevelNum加1，并调用startup()开始下一关的初始化： If (achievedNum = targetNum) Then ' 如果完成当前关卡了 show() '调用显示信息，显示游戏胜利画面 If (currentLevelNum < LEVEL_TOTALNUM -1) Then currentLevelNum += 1 ' 进入下一关 startup() ' 开始下一关卡的初始化 End If End If 在show()函数中，如果还有未完成的关卡，显示将要开始第几关游戏；如果所有关卡都完成了，提示游戏胜利： gg.Font "黑体", 20 gg.SetColor BGR(0, 255, 255) 'GDI的颜色值。 gg.DrawString 300, 30, "第" & currentLevelNum + 1 & "关" gg.Font "黑体", 11 gg.DrawString 265, 230, "按空格键重玩当前关" If (achievedNum = targetNum) And currentLevelNum = LEVEL_TOTALNUM -1 Then ' 如果完成目标个数等于目标个数 gg.Font "黑体", 30 gg.SetColor BGR(0, 255, 255) 'GDI的颜色值。 gg.DrawString 15, 100, "游 戏 胜 利" End If 另外，在update()函数中添加代码，按空格键可以重玩当前关卡： If IsKeyPress(VK_SPACE) Then pp = 1 startup() Return 读者可以尝试设计更多关卡，游戏第1关～第5关，完整代码参看后面 Type Player ' 结构体，用于记录玩家位置 i As Long j As Long End Type #define B_SIZE 32 ' 方块大小 #define B_NUM 8 ' 方块个数,一共8*8个方块 #define LEVEL_TOTALNUM 5 '一共多少关卡 '用字符型二维数组存储地图数据 'e: empty w: wall t: target b: box a: achieved p:player '全局变量定义 Dim Shared levels(LEVEL_TOTALNUM -1, B_NUM -1) As ZString * B_NUM + 1 = _ {_ {"wwwwwwww", "wwwtbeew", "weeeeeew", "weeeeeew", "weeeeeew", "weepaeew", "weeewwww", "wwwwwwww"}, _ '第1关 {"wwwwwwww", "wwweewww", "wpetbwww", "weeebeww", "wewteeww", "weeeeeww", "weepwwww", "wwwwwwww"}, _ '第2关 {"wwwwwwww", "wwpeewww", "weeweeww", "webabeww", "weeteeww", "wwetewww", "wwwwwwww", "wwwwwwww"}, _ '第3关 {"wwwwwwww", "wwwwwwww", "weeeewww", "weeettew", "webbbpew", "weewetww", "wwwwwwww", "wwwwwwww"}, _ '第4关 {"wwwwwwww", "wwwwwwww", "wwteewww", "weewebpw", "weewewew", "weaeebtw", "weeeewww", "wwwwwwww"} _ '第5关 } Dim Shared level(B_NUM -1) As ZString * B_NUM + 1 Dim Shared Players As player '玩家全局变量 Dim Shared As Long targetNum, achievedNum '目标位置个数、完成目标个数 Dim Shared As Long currentLevelNum ' 当前玩到第几关 Sub startup() '初始化函数 Dim i As Long, j As Long For i = 0 To B_NUM -1 '首先获得当前关的地图数据 level(i) = levels(currentLevelNum, i) Next targetNum = 0 ' 目标个数，初始为0 For i = 0 To B_NUM -1 '遍历关卡二维数组数据 For j = 0 To B_NUM -1 If Mid(level(i), j + 1, 1) = "p" Then '找到地图中player的位置 Players.i = i '设定player的位置 Players.j = j Mid(level(i), j + 1, 1) = "e" '把地图元素变成空白empty ElseIf Mid(level(i), j + 1, 1) = "t" Or Mid(level(i), j + 1, 1) = "a" Then ' 如果元素是target或achieved targetNum += 1 '目标个数+1 End If Next Next End Sub Sub show(gg As yGDI) '绘制函数 gg.Cls BGR(150, 150, 150) '灰色背景。 Dim i As Long, j As Long For i = 0 To B_NUM -1 '遍历关卡二维数组数据 For j = 0 To B_NUM -1 If Mid(level(i), j + 1, 1) = "e" Then 'empty元素是空白区域 gg.Pen 0, 0 '框 gg.Brush BGR(150, 150, 150) '绘制灰色地面 gg.DrawFrame j *B_SIZE, i *B_SIZE, B_SIZE, B_SIZE ElseIf Mid(level(i), j + 1, 1) = "w" Then 'wall元素是墙 gg.Pen 1, BGR(120, 120, 120) '框 gg.Brush BGR(155, 0, 0) '绘制淡红色、灰色线的方框 gg.DrawFrame j *B_SIZE, i *B_SIZE, B_SIZE, B_SIZE ElseIf Mid(level(i), j + 1, 1) = "b" Then 'box元素是可移动的箱子 gg.Pen 1, BGR(150, 150, 150) '框 gg.Brush BGR(255, 255, 0) '绘制一个黄色的方块 gg.DrawFrame j *B_SIZE, i *B_SIZE, B_SIZE, B_SIZE ElseIf Mid(level(i), j + 1, 1) = "t" Then 'target元素是目标 gg.Pen 0, 0 '框 gg.Brush BGR(255, 255, 255) gg.DrawFrame(j + 0.25) *B_SIZE, (i + 0.25) *B_SIZE, B_SIZE * 0.5, B_SIZE * 0.5 ElseIf Mid(level(i), j + 1, 1) = "a" Then 'achieved 元素是已完成目标 gg.Pen 0, 0 '框 gg.Brush BGR(255, 255, 0) '绘制一个黄色的方块 gg.DrawFrame j *B_SIZE, i *B_SIZE, B_SIZE, B_SIZE gg.Pen 1, BGR(150, 150, 150) '框 gg.Brush BGR(255, 255, 255) gg.DrawFrame(j + 0.25) *B_SIZE, (i + 0.25) *B_SIZE, B_SIZE * 0.5, B_SIZE * 0.5 ElseIf Mid(level(i), j + 1, 1) = "p" Then 'player 元素是玩家，绘制一个人脸图案 End If Next Next i = Players.i j = Players.j '一个红色圆脸 gg.Pen 0, 0 '框 gg.Brush BGR(255, 0, 0) '一个红色圆脸 gg.DrawEllipse(j + 0.1) *B_SIZE, (i + 0.1) *B_SIZE, B_SIZE * 0.8, B_SIZE * 0.8 '两个黑色眼睛 gg.Brush BGR(90, 90, 90) 'GDI的颜色值。 gg.DrawEllipse(j + 0.2) *B_SIZE, (i + 0.35) *B_SIZE, B_SIZE * 0.25, B_SIZE * 0.25 gg.DrawEllipse(j + 0.55) *B_SIZE, (i + 0.35) *B_SIZE, B_SIZE * 0.25, B_SIZE * 0.25 '一个深灰色嘴巴 gg.DrawFrame(j + 0.3) *B_SIZE, (i + 0.7) *B_SIZE, B_SIZE * 0.4, B_SIZE * 0.1 gg.Font "黑体", 20 gg.SetColor BGR(0, 255, 255) 'GDI的颜色值。 gg.DrawString 300, 30, "第" & currentLevelNum + 1 & "关" gg.Font "黑体", 11 gg.DrawString 265, 230, "按空格键重玩当前关" If (achievedNum = targetNum) And currentLevelNum = LEVEL_TOTALNUM-1 Then ' 如果完成目标个数等于目标个数 gg.Font "黑体", 30 gg.SetColor BGR(0, 255, 255) 'GDI的颜色值。 gg.DrawString 15, 100, "游 戏 胜 利" End If gg.Redraw End Sub Sub updateWithoutInput() '与输入无关的更新 Sleep 10 '暂停若干毫秒 End Sub Sub updateWithInput(hWndForm As hWnd, gg As ygdi) ' 和输入有关的更新 Static pp As Long '预防一直按下，造成一直移动 If pp = 1 Then If IsKeyPress(&H57) = 0 And IsKeyPress(&H53) = 0 And IsKeyPress(&H41) = 0 And IsKeyPress(&H44) = 0 And IsKeyPress(VK_SPACE) = 0 Then pp = 0 End If Else If IsKeyPress(VK_SPACE) Then pp = 1 startup() Return ElseIf IsKeyPress(&H57) Then ' 上 pp = 1 ElseIf IsKeyPress(&H53) Then ' 下 pp = 1 ElseIf IsKeyPress(&H41) Then ' 左 pp = 1 ElseIf IsKeyPress(&H44) Then ' 右 pp = 1 End If If pp = 1 Then Dim goal_i As Long = players.i ' 移动的目标位置 Dim goal_j As Long = players.j Dim goalNext_i As Long = goal_i '目标位置再向前的一个位置 Dim goalNext_j As Long = goal_j ' 根据用户的不同按键输入,获得目标位置、再向前的一个位置 If IsKeyPress(&H57) Then ' 上 goal_i = Players.i - 1 ' 目标位置在玩家位置的下边 goalNext_i = goal_i - 1 ' 目标的下一个位置,在其再下边 ElseIf IsKeyPress(&H53) Then ' 下 goal_i = Players.i + 1 ' 目标位置在玩家位置的下边 goalNext_i = goal_i + 1 ' 目标的下一个位置,在其再下边 ElseIf IsKeyPress(&H41) Then ' 左 goal_j = Players.j -1 ' 目标位置在玩家位置的左边 goalNext_j = goal_j -1 ' 目标的下一个位置,在其再左边 ElseIf IsKeyPress(&H44) Then ' 右 goal_j = Players.j + 1 ' 目标位置在玩家位置的右边 goalNext_j = goal_j + 1 ' 目标的下一个位置,在其再右边 End If '根据不同地图元素的情况，判断如何移动角色和更新地图元素 If Mid(level(goal_i), goal_j + 1, 1) = "e" Or Mid(level(goal_i), goal_j + 1, 1) = "t" Then '如果目标位置是empty，或者target Players.i = goal_i Players.j = goal_j ElseIf Mid(level(goal_i), goal_j + 1, 1) = "b" And Mid(level(goalNext_i), goalNext_j + 1, 1) = "e" Then ' 如果目标位置是box，再前面一个是empty Players.i = goal_i ' 玩家移动到目标位置 Players.j = goal_j Mid(level(goal_i), goal_j + 1, 1) = "e" ' 目标位置变成empty Mid(level(goalNext_i), goalNext_j + 1, 1) = "b" ' 再前面变成box ElseIf Mid(level(goal_i), goal_j + 1, 1) = "b" And Mid(level(goalNext_i), goalNext_j + 1, 1) = "t" Then ' 如果目标位置是box,再前面一个是target Players.i = goal_i ' 玩家移动到目标位置 Players.j = goal_j Mid(level(goal_i), goal_j + 1, 1) = "e" ' 目标位置变成empty Mid(level(goalNext_i), goalNext_j + 1, 1) = "a" '再前面变成achieved ElseIf Mid(level(goal_i), goal_j + 1, 1) = "a" And Mid(level(goalNext_i), goalNext_j + 1, 1) = "e" Then '如果目标位置是achieved,再前面一个是empty Players.i = goal_i ' 玩家移动到目标位置 Players.j = goal_j Mid(level(goal_i), goal_j + 1, 1) = "t" ' 目标位置变成target Mid(level(goalNext_i), goalNext_j + 1, 1) = "b" ' 再前面变成box ElseIf Mid(level(goal_i), goal_j + 1, 1) = "a" And Mid(level(goalNext_i), goalNext_j + 1, 1) = "t" Then '如果目标位置是achieved,再前面一个是target Players.i = goal_i ' 玩家移动到目标位置 Players.j = goal_j Mid(level(goal_i), goal_j + 1, 1) = "t" ' 目标位置变成target Mid(level(goalNext_i), goalNext_j + 1, 1) = "a" ' 再前面变成achieved Else '其他情况都推不动 Return ' 不做任何处理,函数直接返回 End If Dim i As Long, j As Long achievedNum = 0 ' 完成目标个数，初始为0 For i = 0 To B_NUM -1 '遍历关卡二维数组数据 For j = 0 To B_NUM -1 If Mid(level(i), j + 1, 1) = "a" Then ' 如果元素是achieved achievedNum += 1 '完成目标个数+1 If (achievedNum = targetNum) Then ' 如果完成当前关卡了 If (currentLevelNum < LEVEL_TOTALNUM -1) Then currentLevelNum += 1 ' 进入下一关 achievedNum =0 startup() ' 开始下一关卡的初始化 End If End If End If Next Next End If End If End Sub Sub 游戏执行过程(hWndForm As hWnd) Dim gg As yGDI = hWndForm startup() Do show(gg) updateWithInput(hWndForm, gg) updateWithoutInput() Loop End Sub -
VisualFreeBasic游戏趣味编程_9.5_游戏胜利判断 当玩家把所有箱子推到目标位置时游戏胜利，如图9-6所示。 首先定义全局变量存储地图中目标位置的个数、完成目标的个数： Dim Shared As Long targetNum,achievedNum '目标位置个数、完成目标个数 在startup()函数中对二维数组进行遍历，如果地图元素为target或achieved，则将目标个数targetNum加1： Sub startup() '初始化函数 Dim i As Long, j As Long targetNum = 0 ' 目标个数，初始为0 For i = 0 To B_NUM -1 '遍历关卡二维数组数据 For j = 0 To B_NUM -1 If Mid(level(i), j + 1, 1) = "p" Then '找到地图中player的位置 Players.i = i '设定player的位置 Players.j = j Mid(level(i), j + 1, 1) = "e" '把地图元素变成空白empty ElseIf Mid(level(i), j + 1, 1) = "t" Or Mid(level(i), j + 1, 1) = "a" Then ' 如果元素是target或achieved targetNum += 1 '目标个数+1 End If Next Next End Sub 在update( )函数中统计元素更新后的完成目标个数： Dim i As Long, j As Long achievedNum = 0 ' 完成目标个数，初始为0 For i = 0 To B_NUM -1 '遍历关卡二维数组数据 For j = 0 To B_NUM -1 If Mid(level(i), j + 1, 1) = "a" Then ' 如果元素是achieved achievedNum += 1 '完成目标个数+1 End If Next Next 如果完成目标个数等于目标个数，在show( )函数中显示游戏胜利信息： If (achievedNum = targetNum) Then ' 如果完成目标个数等于目标个数 gg.Font "黑体", 30 gg.SetColor BGR(0,255,255) 'GDI的颜色值。 gg.DrawString 15,100,"游 戏 胜 利" End If 读者可以自己更改代码，看看是否和预料的结果一样。如果不同，自己试着排除错误。 完整代码如下： Type Player ' 结构体，用于记录玩家位置 i As Long j As Long End Type #define B_SIZE 32 ' 方块大小 #define B_NUM 8 ' 方块个数,一共8*8个方块 '用字符型二维数组存储地图数据 'e: empty w: wall t: target b: box a: achieved p:player '全局变量定义 Dim Shared level(B_NUM -1) As ZString * B_NUM + 1 = {"wwwwwwww", "wwwtbeew", "weeeeeew", "weeeeeew", "weeeeeew", "weepaeew", "weeewwww", "wwwwwwww"} Dim Shared Players As player '玩家全局变量 Dim Shared As Long targetNum, achievedNum '目标位置个数、完成目标个数 Sub startup() '初始化函数 Dim i As Long, j As Long targetNum = 0 ' 目标个数，初始为0 For i = 0 To B_NUM -1 '遍历关卡二维数组数据 For j = 0 To B_NUM -1 If Mid(level(i), j + 1, 1) = "p" Then '找到地图中player的位置 Players.i = i '设定player的位置 Players.j = j Mid(level(i), j + 1, 1) = "e" '把地图元素变成空白empty ElseIf Mid(level(i), j + 1, 1) = "t" Or Mid(level(i), j + 1, 1) = "a" Then ' 如果元素是target或achieved targetNum += 1 '目标个数+1 End If Next Next End Sub Sub show(gg As yGDI) '绘制函数 gg.Cls BGR(150, 150, 150) '灰色背景。 Dim i As Long, j As Long For i = 0 To B_NUM -1 '遍历关卡二维数组数据 For j = 0 To B_NUM -1 If Mid(level(i), j+1, 1) = "e" Then 'empty元素是空白区域 gg.Pen 0, 0 '框 gg.Brush BGR(150, 150, 150) '绘制灰色地面 gg.DrawFrame j *B_SIZE, i *B_SIZE, B_SIZE, B_SIZE ElseIf Mid(level(i), j+1, 1) = "w" Then 'wall元素是墙 gg.Pen 1, BGR(120, 120, 120) '框 gg.Brush BGR(155, 0, 0) '绘制淡红色、灰色线的方框 gg.DrawFrame j *B_SIZE, i *B_SIZE, B_SIZE, B_SIZE ElseIf Mid(level(i), j+1, 1) = "b" Then 'box元素是可移动的箱子 gg.Pen 1, BGR(150, 150, 150) '框 gg.Brush BGR(255, 255, 0) '绘制一个黄色的方块 gg.DrawFrame j *B_SIZE, i *B_SIZE, B_SIZE, B_SIZE ElseIf Mid(level(i), j+1, 1) = "t" Then 'target元素是目标 gg.Pen 0, 0 '框 gg.Brush BGR(255, 255, 255) gg.DrawFrame(j + 0.25) *B_SIZE, (i + 0.25) *B_SIZE, B_SIZE * 0.5, B_SIZE * 0.5 ElseIf Mid(level(i), j+1, 1) = "a" Then 'achieved 元素是已完成目标 gg.Pen 0, 0 '框 gg.Brush BGR(255, 255, 0) '绘制一个黄色的方块 gg.DrawFrame j *B_SIZE, i *B_SIZE, B_SIZE, B_SIZE gg.Pen 1, BGR(150, 150, 150) '框 gg.Brush BGR(255, 255, 255) gg.DrawFrame(j + 0.25) *B_SIZE, (i + 0.25) *B_SIZE, B_SIZE * 0.5, B_SIZE * 0.5 ElseIf Mid(level(i), j+1, 1) = "p" Then 'player 元素是玩家，绘制一个人脸图案 End If Next Next i = Players.i j = Players.j '一个红色圆脸 gg.Pen 0, 0 '框 gg.Brush BGR(255, 0, 0) '一个红色圆脸 gg.DrawEllipse(j + 0.1) *B_SIZE, (i + 0.1) *B_SIZE, B_SIZE * 0.8, B_SIZE * 0.8 '两个黑色眼睛 gg.Brush BGR(90, 90, 90) 'GDI的颜色值。 gg.DrawEllipse(j + 0.2) *B_SIZE, (i + 0.35) *B_SIZE, B_SIZE * 0.25, B_SIZE * 0.25 gg.DrawEllipse(j + 0.55) *B_SIZE, (i + 0.35) *B_SIZE, B_SIZE * 0.25, B_SIZE * 0.25 '一个深灰色嘴巴 gg.DrawFrame(j + 0.3) *B_SIZE, (i + 0.7) *B_SIZE, B_SIZE * 0.4, B_SIZE * 0.1 If (achievedNum = targetNum) Then ' 如果完成目标个数等于目标个数 gg.Font "黑体", 30 gg.SetColor BGR(0,255,255) 'GDI的颜色值。 gg.DrawString 15,100,"游 戏 胜 利" End If gg.Redraw End Sub Sub updateWithoutInput() '与输入无关的更新 Sleep 10 '暂停若干毫秒 End Sub Sub updateWithInput(hWndForm As hWnd, gg As ygdi) ' 和输入有关的更新 Static pp As Long '预防一直按下，造成一直移动 If pp = 1 Then If IsKeyPress(&H57) = 0 And IsKeyPress(&H53) = 0 And IsKeyPress(&H41) = 0 And IsKeyPress(&H44) = 0 Then pp = 0 End If Else If IsKeyPress(&H57) Then ' 上 pp = 1 ElseIf IsKeyPress(&H53) Then ' 下 pp = 1 ElseIf IsKeyPress(&H41) Then ' 左 pp = 1 ElseIf IsKeyPress(&H44) Then ' 右 pp = 1 End If If pp = 1 Then Dim goal_i As Long = players.i ' 移动的目标位置 Dim goal_j As Long = players.j Dim goalNext_i As Long = goal_i '目标位置再向前的一个位置 Dim goalNext_j As Long = goal_j ' 根据用户的不同按键输入,获得目标位置、再向前的一个位置 If IsKeyPress(&H57) Then ' 上 goal_i = Players.i - 1 ' 目标位置在玩家位置的下边 goalNext_i = goal_i - 1 ' 目标的下一个位置,在其再下边 ElseIf IsKeyPress(&H53) Then ' 下 goal_i = Players.i + 1 ' 目标位置在玩家位置的下边 goalNext_i = goal_i + 1 ' 目标的下一个位置,在其再下边 ElseIf IsKeyPress(&H41) Then ' 左 goal_j = Players.j -1 ' 目标位置在玩家位置的左边 goalNext_j = goal_j -1 ' 目标的下一个位置,在其再左边 ElseIf IsKeyPress(&H44) Then ' 右 goal_j = Players.j + 1 ' 目标位置在玩家位置的右边 goalNext_j = goal_j + 1 ' 目标的下一个位置,在其再右边 End If '根据不同地图元素的情况，判断如何移动角色和更新地图元素 If Mid(level(goal_i), goal_j + 1, 1) = "e" Or Mid(level(goal_i), goal_j + 1, 1) = "t" Then '如果目标位置是empty，或者target Players.i = goal_i Players.j = goal_j ElseIf Mid(level(goal_i), goal_j + 1, 1) = "b" And Mid(level(goalNext_i), goalNext_j + 1, 1) = "e" Then ' 如果目标位置是box，再前面一个是empty Players.i = goal_i ' 玩家移动到目标位置 Players.j = goal_j Mid(level(goal_i), goal_j + 1, 1) = "e" ' 目标位置变成empty Mid(level(goalNext_i), goalNext_j + 1, 1) = "b" ' 再前面变成box ElseIf Mid(level(goal_i), goal_j + 1, 1) = "b" And Mid(level(goalNext_i), goalNext_j + 1, 1) = "t" Then ' 如果目标位置是box,再前面一个是target Players.i = goal_i ' 玩家移动到目标位置 Players.j = goal_j Mid(level(goal_i), goal_j + 1, 1) = "e" ' 目标位置变成empty Mid(level(goalNext_i), goalNext_j + 1, 1) = "a" '再前面变成achieved ElseIf Mid(level(goal_i), goal_j + 1, 1) = "a" And Mid(level(goalNext_i), goalNext_j + 1, 1) = "e" Then '如果目标位置是achieved,再前面一个是empty Players.i = goal_i ' 玩家移动到目标位置 Players.j = goal_j Mid(level(goal_i), goal_j + 1, 1) = "t" ' 目标位置变成target Mid(level(goalNext_i), goalNext_j + 1, 1) = "b" ' 再前面变成box ElseIf Mid(level(goal_i), goal_j + 1, 1) = "a" And Mid(level(goalNext_i), goalNext_j + 1, 1) = "t" Then '如果目标位置是achieved,再前面一个是target Players.i = goal_i ' 玩家移动到目标位置 Players.j = goal_j Mid(level(goal_i), goal_j + 1, 1) = "t" ' 目标位置变成target Mid(level(goalNext_i), goalNext_j + 1, 1) = "a" ' 再前面变成achieved Else '其他情况都推不动 Return ' 不做任何处理,函数直接返回 End If Dim i As Long, j As Long achievedNum = 0 ' 完成目标个数，初始为0 For i = 0 To B_NUM -1 '遍历关卡二维数组数据 For j = 0 To B_NUM -1 If Mid(level(i), j + 1, 1) = "a" Then ' 如果元素是achieved achievedNum += 1 '完成目标个数+1 End If Next Next End If End If End Sub Sub 游戏执行过程(hWndForm As hWnd) Dim gg As yGDI = hWndForm startup() Do show(gg) updateWithInput(hWndForm, gg) updateWithoutInput() Loop End Sub -
VisualFreeBasic游戏趣味编程_9.4_元素更新的实现 假设键盘控制游戏角色向右移动，根据其右侧目标位置、再右侧位置的元素，有表9-2所示情况。 根据用户的不同输入，变量goal_i、goal_j存储游戏角色移动的目标位置， goalNext_i、goalNext_j存储目标位置再向前的一个位置。根据表9-2，共有6种情况会移动游戏角色及更新关卡元素，在update()函数中实现相应的处理： Sub updateWithInput(hWndForm As hWnd, gg As ygdi) ' 和输入有关的更新 Static pp As Long '预防一直按下，造成一直移动 If pp = 1 Then If IsKeyPress(&H57) = 0 And IsKeyPress(&H53) = 0 And IsKeyPress(&H41) = 0 And IsKeyPress(&H44) = 0 Then pp = 0 End If Else If IsKeyPress(&H57) Then ' 上 pp = 1 ElseIf IsKeyPress(&H53) Then ' 下 pp = 1 ElseIf IsKeyPress(&H41) Then ' 左 pp = 1 ElseIf IsKeyPress(&H44) Then ' 右 pp = 1 End If If pp = 1 Then Dim goal_i As Long = players.i ' 移动的目标位置 Dim goal_j As Long = players.j Dim goalNext_i As Long = goal_i '目标位置再向前的一个位置 Dim goalNext_j As Long = goal_j ' 根据用户的不同按键输入,获得目标位置、再向前的一个位置 If IsKeyPress(&H57) Then ' 上 goal_i = Players.i - 1 ' 目标位置在玩家位置的下边 goalNext_i = goal_i - 1 ' 目标的下一个位置,在其再下边 ElseIf IsKeyPress(&H53) Then ' 下 goal_i = Players.i + 1 ' 目标位置在玩家位置的下边 goalNext_i = goal_i + 1 ' 目标的下一个位置,在其再下边 ElseIf IsKeyPress(&H41) Then ' 左 goal_j = Players.j -1 ' 目标位置在玩家位置的左边 goalNext_j = goal_j -1 ' 目标的下一个位置,在其再左边 ElseIf IsKeyPress(&H44) Then ' 右 goal_j = Players.j + 1 ' 目标位置在玩家位置的右边 goalNext_j = goal_j + 1 ' 目标的下一个位置,在其再右边 End If '根据不同地图元素的情况，判断如何移动角色和更新地图元素 If Mid(level(goal_i), goal_j + 1, 1) = "e" Or Mid(level(goal_i), goal_j + 1, 1) = "t" Then '如果目标位置是empty，或者target Players.i = goal_i Players.j = goal_j ElseIf Mid(level(goal_i), goal_j + 1, 1) = "b" And Mid(level(goalNext_i), goalNext_j + 1, 1) = "e" Then ' 如果目标位置是box，再前面一个是empty Players.i = goal_i ' 玩家移动到目标位置 Players.j = goal_j Mid(level(goal_i), goal_j + 1, 1) = "e" ' 目标位置变成empty Mid(level(goalNext_i), goalNext_j + 1, 1) = "b" ' 再前面变成box ElseIf Mid(level(goal_i), goal_j + 1, 1) = "b" And Mid(level(goalNext_i), goalNext_j + 1, 1) = "t" Then ' 如果目标位置是box,再前面一个是target Players.i = goal_i ' 玩家移动到目标位置 Players.j = goal_j Mid(level(goal_i), goal_j + 1, 1) = "e" ' 目标位置变成empty Mid(level(goalNext_i), goalNext_j + 1, 1) = "a" '再前面变成achieved ElseIf Mid(level(goal_i), goal_j + 1, 1) = "a" And Mid(level(goalNext_i), goalNext_j + 1, 1) = "e" Then '如果目标位置是achieved,再前面一个是empty Players.i = goal_i ' 玩家移动到目标位置 Players.j = goal_j Mid(level(goal_i), goal_j + 1, 1) = "t" ' 目标位置变成target Mid(level(goalNext_i), goalNext_j + 1, 1) = "b" ' 再前面变成box ElseIf Mid(level(goal_i), goal_j + 1, 1) = "a" And Mid(level(goalNext_i), goalNext_j + 1, 1) = "t" Then '如果目标位置是achieved,再前面一个是target Players.i = goal_i ' 玩家移动到目标位置 Players.j = goal_j Mid(level(goal_i), goal_j + 1, 1) = "t" ' 目标位置变成target Mid(level(goalNext_i), goalNext_j + 1, 1) = "a" ' 再前面变成achieved Else '其他情况都推不动 Return ' 不做任何处理,函数直接返回 End If End If End If End Sub 读者可以自己更改代码，看看是否和预料的结果一样。如果不同，自己试着排除错误。 -
VisualFreeBasic游戏趣味编程_9.3_键盘控制游戏角色移动 为了实现键盘控制游戏角色移动，首先定义结构体用于记录玩家位置： Type Player ' 结构体，用于记录玩家位置 i As Long j As Long End Type 定义全局变量player储存游戏角色的位置： Dim Shared Players As player '玩家全局变量 在初始化时，找到二维数组level中值为'p'的元素，得到玩家位置赋给变量player，再把元素值变成'e'： Sub startup() '初始化函数 Dim i As Long, j As Long For i = 0 To B_NUM -1 '遍历关卡二维数组数据 For j = 1 To B_NUM If Mid(level(i), j, 1) = "p" Then '找到地图中player的位置 Players.i = i '设定player的位置 Players.j = j Mid(level(i), j, 1) = "e" '把地图元素变成空白empty Exit For, For '连续跳出2个循环 End If Next Next End Sub 其中 Mid 语句/函数 是读取或设置字符串中的字符 修改show()函数，根据player中存储的位置，绘制出玩家图案： i = Players.i j = Players.j '一个红色圆脸 gg.Pen 0, 0 '框 gg.Brush BGR(255, 0, 0) '一个红色圆脸 gg.DrawEllipse(j + 0.1) *B_SIZE, (i + 0.1) *B_SIZE, B_SIZE * 0.8, B_SIZE * 0.8 '两个黑色眼睛 gg.Brush BGR(90, 90, 90) 'GDI的颜色值。 gg.DrawEllipse(j + 0.2) *B_SIZE, (i + 0.35) *B_SIZE, B_SIZE * 0.25, B_SIZE * 0.25 gg.DrawEllipse(j + 0.55) *B_SIZE, (i + 0.35) *B_SIZE, B_SIZE * 0.25, B_SIZE * 0.25 '一个深灰色嘴巴 gg.DrawFrame(j + 0.3) *B_SIZE, (i + 0.7) *B_SIZE, B_SIZE * 0.4, B_SIZE * 0.1 在update()函数中，根据用户按下的A、S、D、W键，控制角色向左、下、右、上移动： Sub updateWithInput(hWndForm As hWnd, gg As ygdi) ' 和输入有关的更新 Static pp As Long '预防一直按下，造成一直移动 If pp = 1 Then If IsKeyPress(&H57) = 0 And IsKeyPress(&H53) = 0 And IsKeyPress(&H41) = 0 And IsKeyPress(&H44) = 0 Then pp = 0 End If Else If IsKeyPress(&H57) Then ' 上 Players.i = Players.i -1 pp = 1 ElseIf IsKeyPress(&H53) Then ' 下 Players.i = Players.i + 1 pp = 1 ElseIf IsKeyPress(&H41) Then ' 左 Players.j = Players.j -1 pp = 1 ElseIf IsKeyPress(&H44) Then ' 右 Players.j = Players.j + 1 pp = 1 End If End If End Sub 读者可以自己更改代码，看看是否和预料的结果一样。如果不同，自己试着排除错误。 -
VisualFreeBasic游戏趣味编程_9.2_应用字符数组存储关卡数据 推箱子游戏效果如图9-4所示。 图9-4中的“推箱子”游戏一共有表9-1所示的几种元素。 表9-1 元素图片 功能描述 英文名称 缩写字符 空白区域：玩家可以穿过，箱子可以推上去 empty 'e' 墙：玩家不能经过，箱子不能推过去 wall 'w' 箱子：在前方没有障碍物的情况下，玩家可以推动 box 'b' 空白目标：需要玩家将箱子推上去 target 't' 完成目标：一个箱子在目标上的叠加状态 achieved 'a' 游戏角色：可以键盘控制移动，推动箱子到达目标 player 'p' 我们可以采用二维字符数组的形式描述关卡地图数据。用表9-1中对应的缩写字符，图9-4的地图可以表示为： Dim level(63) As String = _ {"w", "w", "w", "w", "w", "w", "w", "w", _ "w", "w", "w", "t", "b", "e", "e", "w", _ "w", "e", "e", "e", "e", "e", "e", "w", _ "w", "e", "e", "e", "e", "e", "e", "w", _ "w", "e", "e", "e", "e", "e", "e", "w", _ "w", "e", "e", "p", "a", "e", "e", "w", _ "w", "e", "e", "e", "w", "w", "w", "w", _ "w", "w", "w", "w", "w", "w", "w", "w"} 用字符串的形式对二维数组初始化，代码可写为： Dim level(7) As String = {"wwwwwwww", "wwwtbeew", "weeeeeew", "weeeeeew", "weeeeeew", "weepaeew", "weeewwww", "wwwwwwww"} dim level(7) 是有8个数据，0~7 8个。 定义全局变量level储存地图数据，在show()函数中根据level的值绘制出表9-1中的对应图案，完整代码如9-2所示。 #define B_SIZE 32 ' 方块大小 #define B_NUM 8 ' 方块个数,一共8*8个方块 '用字符型二维数组存储地图数据 'e: empty w: wall t: target b: box a: achieved p:player '全局变量定义 Dim Shared level(B_NUM -1) As ZString * B_NUM + 1 = {"wwwwwwww", "wwwtbeew", "weeeeeew", "weeeeeew", "weeeeeew", "weepaeew", "weeewwww", "wwwwwwww"} Sub startup() '初始化函数 End Sub Sub show(gg As yGDI) '绘制函数 gg.Cls BGR(150,150,150) '灰色背景。 Dim i As Long, j As Long For i = 0 To B_NUM -1 '遍历关卡二维数组数据 For j=0 To B_NUM -1 If Chr(level(i) [j]) = "e" Then 'empty元素是空白区域 gg.Pen 0,0 '框 gg.Brush BGR(150, 150, 150) '绘制灰色地面 gg.DrawFrame j*B_SIZE,i*B_SIZE,B_SIZE,B_SIZE ElseIf Chr(level(i) [j]) = "w" Then 'wall元素是墙 gg.Pen 1,BGR(120, 120, 120) '框 gg.Brush BGR(155, 0, 0) '绘制淡红色、灰色线的方框 gg.DrawFrame j*B_SIZE,i*B_SIZE,B_SIZE,B_SIZE ElseIf Chr(level(i) [j]) = "b" Then 'box元素是可移动的箱子 gg.Pen 1,BGR(150, 150, 150) '框 gg.Brush BGR(255, 255, 0) '绘制一个黄色的方块 gg.DrawFrame j*B_SIZE,i*B_SIZE,B_SIZE,B_SIZE ElseIf Chr(level(i) [j]) = "t" Then 'target元素是目标 gg.Pen 0,0 '框 gg.Brush BGR(255,255,255) gg.DrawFrame (j+0.25)*B_SIZE,(i+0.25)*B_SIZE,B_SIZE*0.5,B_SIZE*0.5 ElseIf Chr(level(i) [j]) = "a" Then 'achieved 元素是已完成目标 gg.Pen 0,0 '框 gg.Brush BGR(255, 255, 0) '绘制一个黄色的方块 gg.DrawFrame j *B_SIZE, i *B_SIZE, B_SIZE, B_SIZE gg.Pen 1,BGR(150, 150, 150) '框 gg.Brush BGR(255,255,255) gg.DrawFrame (j+0.25)*B_SIZE,(i+0.25)*B_SIZE,B_SIZE*0.5,B_SIZE*0.5 ElseIf Chr(level(i) [j]) = "p" Then 'player 元素是玩家，绘制一个人脸图案 '一个红色圆脸 gg.Pen 0,0 '框 gg.Brush BGR(255,0,0) '一个红色圆脸 gg.DrawEllipse (j+0.1)*B_SIZE,(i+0.1)*B_SIZE,B_SIZE*0.8,B_SIZE*0.8 '两个黑色眼睛 gg.Brush BGR(90, 90, 90) 'GDI的颜色值。 gg.DrawEllipse (j+0.2)*B_SIZE,(i+0.35)*B_SIZE,B_SIZE*0.25,B_SIZE*0.25 gg.DrawEllipse (j+0.55)*B_SIZE,(i+0.35)*B_SIZE,B_SIZE*0.25,B_SIZE*0.25 '一个深灰色嘴巴 gg.DrawFrame (j+0.3)*B_SIZE,(i+0.7)*B_SIZE,B_SIZE*0.4,B_SIZE*0.1 End If 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