-
VisualFreeBasic游戏趣味编程_8.2_鼠标交互 回顾7.4节中讲解的键盘交互处理函数： Sub updateWithInput(moveDirection As String) ' 和输入有关的更新 If IsKeyPress(&H57) Then moveDirection = "上" ElseIf IsKeyPress(&H53) Then moveDirection = "下" ElseIf IsKeyPress(&H41) Then moveDirection = "左" ElseIf IsKeyPress(&H44) Then moveDirection = "右" End If End Sub 对于很多游戏，鼠标交互是一种更加自然的交互方式。和键盘交互代码结构类似，我们也可以实现基于鼠标的交互处理： Sub updateWithInput() ' 和输入有关的更新 If IsKeyPress(VK_LBUTTON) Then '鼠标左键点击 Dim ps As Point GetCursorPos(@ps) '获取鼠标位置 '执行相应的操作 'ps.x 当前鼠标的x坐标 ps.y 为当前鼠标的y坐标 End If End Sub 以下代码实现点击鼠标时，在鼠标位置绘制一个红色圆圈： Sub 游戏执行过程(hWndForm As hWnd) Dim gg As yGDI = hWndForm Do If IsKeyPress(VK_LBUTTON) Then '鼠标左键点击 Dim ps As Point GetCursorPos(@ps) '获取鼠标在屏幕的位置 MapWindowPoints HWND_DESKTOP, hWndForm, @ps, 1 '将鼠标位置从屏幕转换到游戏窗口的位置 ps.x = DpiUnScaleI(ps.x) '响应系统DPI ps.y = DpiUnScaleI(ps.y) gg.Brush BGR(229, 0, 0) 'GDI的颜色值。 gg.DrawEllipse ps.x - 10, ps.y - 10, 20, 20 '画小圆圈 gg.Redraw End If Sleep 10 Loop End Sub 程序运行后输出如图所示。 同样，也可以实现鼠标移动时，绘制一系列绿色的小圆圈： Sub 游戏执行过程(hWndForm As hWnd) Dim gg As yGDI = hWndForm Do Dim ps As Point GetCursorPos(@ps) '获取鼠标在屏幕的位置 MapWindowPoints HWND_DESKTOP, hWndForm, @ps, 1 '将鼠标位置从屏幕转换到游戏窗口的位置 If ps.x >= 0 and ps.x <= Form1.ScaleWidth And ps.y >= 0 and ps.y < Form1.ScaleHeight then ps.x = DpiUnScaleI(ps.x) '响应系统DPI ps.y = DpiUnScaleI(ps.y) gg.Brush BGR(0, 204, 0) 'GDI的颜色值。 gg.DrawEllipse ps.x - 5, ps.y - 5, 10, 10 '画小圆圈 gg.Redraw End If Sleep 10 Loop End Sub -
VisualFreeBasic游戏趣味编程_8.1_结构体 图8-1中的绘制单元由一个白色圆圈、一个红色指针组成。记录白色圆圈的信息需要定义3个变量： Dim As Long x,y '小圆圈的圆心坐标 Dim As Long r ' 小圆圈半径 红色指针起点在圆心，长度为圆半径，其角度只能有0、90、180、270 这4种可能。定义取值范围为[0,3]的整型变量angleNum Dim As Long angleNum ' 对应的角度种类，只能是0、1、2、3，表示对应的4个角度值 要记录图8-1中的5行5列所有圆圈信息，我们可以采用数组的形式： Dim As Long x(24),y(24) '小圆圈的圆心坐标 Dim As Long r(24) ' 小圆圈半径 Dim As Long angleNum(24) ' 对应的角度种类，只能是0、1、2、3，表示对应的4个角度值 数组可以处理大量的同类型数据，其中每一个元素都属于同一种数据类型。而利用结构体，可以将一个物体的不同类型数据集合在一起，形成一个整体，使代码更加直观、简洁： Type Round '定义结构体，用来表示带角度指示的小圆圈 As Long x, y '小圆圈的圆心坐标 As Long r ' 小圆圈半径 angleNum As Long ' 对应的角度种类，只能是0、1、2、3，表示对应的4个角度值 End Type 其中，Type 是定义结构体的关键词，Round是自定义的结构体类型名。 内定义了结构体的成员变量，成员变量的数据类型可以不同。最后 End Type 结束 定义结构体类型Round后，我们就可以用Round来定义变量： Dim Rounds As Round '定义结构体变量 Round 可以理解为一种Round类型的变量，可以通过如下形式设定round的成员变量： Rounds.x = 300 '设定小圆圈的圆心坐标 Rounds.y =300 Rounds.r=30 '设定小圆圈的半径 Rounds.angleNum = 270 也可以通过访问round的成员变量，绘制出对应的小圆圈： Sub show(gg As yGDI) '绘制函数 gg.Cls BGR(0, 0, 0) '背景为黑色 Dim Rounds As Round '定义结构体变量 Rounds.x = 100 '设定小圆圈的圆心坐标 Rounds.y = 100 Rounds.r = 30 '设定小圆圈的半径 Rounds.angleNum = 270 gg.Pen 1, BGR(255, 255, 255) '设置圆圈颜色为白灰色 gg.Brush '无填充 gg.DrawEllipse Rounds.x - Rounds.r, Rounds.y - Rounds.r, Rounds.r * 2, Rounds.r * 2 '画小圆圈 '用三角函数，画出这根红线 gg.Pen 1, BGR(255, 51, 51) 'GDI的颜色值。 gg.DrawLine Rounds.x, Rounds.y, Rounds.x + Rounds.r *Cos(Rounds.angleNum * (3.1415926 / 180)) ,Rounds.y + Rounds.r *Sin(Rounds.angleNum * (3.1415926 / 180)) gg.Redraw End Sub 绘制效果 进一步，定义结构体二维数组，存储图8-1中5行5列所有圆圈的信息： Rounds(i, j).x = 100 '设定小圆圈的圆心坐标 Rounds(i, j).y = 200 Rounds(i, j).r = 30 '设定小圆圈的半径 Rounds(i, j).angleNum = 270 利用结构体二维数组和游戏开发框架，实现代码如下 Type Round '定义结构体，用来表示带角度指示的小圆圈 As Long x, y '小圆圈的圆心坐标 As Long r ' 小圆圈半径 angleNum As Long ' 对应的角度种类，只能是0、90、180、270，表示对应的4个角度值 End Type '全局变量定义 Dim Shared Rounds(4, 4) As Round '定义结构体变量 Sub startup(gg As yGDI) '初始化函数 Dim i As Long Dim j As Long For i = 0 To 4 For j = 0 To 4 Rounds(i, j).x = j * 45 + 45 '设定小圆圈的圆心坐标 Rounds(i, j).y = i * 45 + 45 Rounds(i, j).r = 15 '设定小圆圈的半径 Rounds(i, j).angleNum = 270 Next Next End Sub Sub show(gg As yGDI) '绘制函数 gg.Cls BGR(0, 0, 0) '背景为黑色 Dim i As Long Dim j As Long '对所有小圆圈遍历 For i = 0 To 4 For j = 0 To 4 gg.Pen 1, BGR(255, 255, 255) '设置圆圈颜色为白灰色 gg.Brush '无填充 gg.DrawEllipse Rounds(i, j).x - Rounds(i, j).r, Rounds(i, j).y - Rounds(i, j).r, Rounds(i, j).r * 2, Rounds(i, j).r * 2 '画小圆圈 '用三角函数，画出这根红线 gg.Pen 1, BGR(255, 51, 51) 'GDI的颜色值。 gg.DrawLine Rounds(i, j).x, Rounds(i, j).y, Rounds(i, j).x + Rounds(i, j).r *Cos(Rounds(i, j).angleNum * (3.1415926 / 180)), _ Rounds(i, j).y + Rounds(i, j).r *Sin(Rounds(i, j).angleNum * (3.1415926 / 180)) Next Next gg.Redraw End Sub Sub updateWithoutInput() '与输入无关的更新 Sleep 10 '暂停若干毫秒 End Sub Sub updateWithInput() ' 和输入有关的更新 End Sub Sub 游戏执行过程(hWndForm As hWnd) Dim gg As yGDI = hWndForm startup(gg) '初始化函数，仅执行一次 Do show(gg) ' 进行绘制 updateWithInput() ' 和输入有关的更新 updateWithoutInput() ' 和输入无关的更新 Loop End Sub 程序运行后输出如图 -
-
VisualFreeBasic游戏趣味编程_7.7_添加食物 添加全局变量记录食物的位置： Dim Shared As Long food_i,food_j '食物的位置 在startup()函数中初始化食物的位置： Sub startup(gg As yGDI) '初始化函数 Randomize food_i = Rnd * (BLOCK_HEIGHT -5) + 2 ' 初始化随机食物位置 Randomize food_j = Rnd * (BLOCK_WIDTH -5) + 2 在show()函数中在食物位置处绘制一个绿色的小方块： Sub show(gg As yGDI) '绘制函数 gg.Brush BGR(0, 178, 0) '食物颜色为绿色 gg.DrawFrame food_j *BLOCK_SIZE, food_i *BLOCK_SIZE, BLOCK_SIZE, BLOCK_SIZE ' 绘制食物小方块 程序运行后输出如图7-9所示。 当新蛇头碰到食物时，只需保留原蛇尾，不将最大值变为0，即可让蛇的长度加1，如图7-10所示。 在moveSnake()函数中修改代码，当吃到食物时，食物位置重新随机出现，蛇长度加1；当没有吃到食物时，旧蛇尾变成空白，蛇长度保持不变。 Blocks(newHead_i, newHead_j) = 1 ' 新蛇头位置数值为1 If food_j = newHead_j And food_i = newHead_i Then '如果新蛇头正好碰到食物 Randomize food_i = Rnd * (BLOCK_HEIGHT -5) + 2 ' 初始化随机食物位置 Randomize food_j = Rnd * (BLOCK_WIDTH -5) + 2 '不对旧蛇尾处理，相当于蛇的长度+1 Else '新蛇头没有碰到食物 Blocks(oldTail_i, oldTail_j) = 0 ' 旧蛇尾变成空白，不吃食物时蛇的长度保持不变 End If 完整代码 #define BLOCK_HEIGHT 17 ' 高度上一共30个小格子 #define BLOCK_WIDTH 27 ' 宽度上一共40个小格子 #define BLOCK_SIZE 15 ' 每个小格子的长宽大小 '全局变量定义 Dim Shared Blocks(BLOCK_HEIGHT -1, BLOCK_WIDTH -1) As Long ' 二维数组，用于记录所有的游戏数据 Dim Shared isFailure As Long '是否游戏失败 Dim Shared As Long food_i,food_j '食物的位置 Sub startup(gg As yGDI) '初始化函数 Dim i As Long, j As Long Blocks(BLOCK_HEIGHT / 2, Int(BLOCK_WIDTH / 2)) = 1 '画面中间画蛇头，数字为1 For i = 1 To 4 Blocks(BLOCK_HEIGHT / 2, Int(BLOCK_WIDTH / 2) - i) = i + 1 '向左依次4个蛇身，数值依次为2、3、4、5 Next gg.Pen 1, BGR(255, 255, 255) Randomize food_i = Rnd * (BLOCK_HEIGHT -5) + 2 ' 初始化随机食物位置 Randomize food_j = Rnd * (BLOCK_WIDTH -5) + 2 End Sub Sub show(gg As yGDI) '绘制函数 gg.Cls Dim i As Long, j As Long '对二维数组所有元素遍历 For i = 0 To BLOCK_HEIGHT -1 For j = 0 To BLOCK_WIDTH -1 If Blocks(i, j) > 0 Then gg.Brush HSBtoRGB_Gdi(HSB(Blocks(i, j) * 10, 90, 100, 255)) '根据元素值设定填充颜色 Else gg.Brush BGR(165, 165, 165) 'GDI的颜色值。 End If gg.DrawFrame j *BLOCK_SIZE, i *BLOCK_SIZE, BLOCK_SIZE, BLOCK_SIZE Next Next gg.Brush BGR(0, 178, 0) '食物颜色为绿色 gg.DrawFrame food_j *BLOCK_SIZE, food_i *BLOCK_SIZE, BLOCK_SIZE, BLOCK_SIZE ' 绘制食物小方块 If isFailure Then gg.Font "黑体", 50, True gg.SetColor BGR(204, 0, 0) 'GDI的颜色值。 gg.DrawString 60, 50, "游戏失败" End If gg.Redraw End Sub Sub moveSnake(moveDirection As String) ' 移动小蛇及相关处理函数 Dim i As Long, j As Long For i = 0 To BLOCK_HEIGHT -1 '对行遍历 For j = 0 To BLOCK_WIDTH -1 '对列遍历 If Blocks(i, j) > 0 Then '大于0的为小蛇元素 Blocks(i, j) += 1 '让其+1 End If Next Next Dim As Long oldTail_i, oldTail_j, oldHead_i, oldHead_j '定义变量，存储旧蛇尾、旧蛇头坐标 Dim mm As Long '用于记录最大值 For i = 0 To BLOCK_HEIGHT -1 '对行遍历 For j = 0 To BLOCK_WIDTH -1 '对列遍历 If mm < Blocks(i, j) Then '如果当前元素值比max大 mm = Blocks(i, j) '更新max的值 oldTail_i = i ' 记录最大值的坐标,就是旧蛇尾的位置 oldTail_j = j End If If Blocks(i, j) = 2 Then '找到数值为2 oldHead_i = i ' 数值为2恰好是旧蛇头的位置 oldHead_j = j ' End If Next Next Dim newHead_i As Long = oldHead_i ' 设定变量存储新蛇头的位置 Dim newHead_j As Long = oldHead_j If (moveDirection = "左") Then newHead_j = oldHead_j -1 ' 向左移动 ElseIf (moveDirection = "右") Then newHead_j = oldHead_j + 1 '向右移动 ElseIf (moveDirection = "上") Then newHead_i = oldHead_i -1 ' 向上移动 ElseIf (moveDirection = "下") Then newHead_i = oldHead_i + 1 ' 向下移动 End If Print newHead_j, BLOCK_WIDTH '当小蛇碰到画面边界时 If newHead_i >= BLOCK_HEIGHT Or newHead_i < 0 Or newHead_j >= BLOCK_WIDTH Or newHead_j < 0 Then isFailure = 1 Return End If '当蛇头与蛇自身发生碰撞时 If Blocks(newHead_i, newHead_j) > 0 Then isFailure = 1 Return End If Blocks(newHead_i, newHead_j) = 1 ' 新蛇头位置数值为1 If food_j = newHead_j And food_i = newHead_i Then '如果新蛇头正好碰到食物 Randomize food_i = Rnd * (BLOCK_HEIGHT -5) + 2 ' 初始化随机食物位置 Randomize food_j = Rnd * (BLOCK_WIDTH -5) + 2 '不对旧蛇尾处理，相当于蛇的长度+1 Else '新蛇头没有碰到食物 Blocks(oldTail_i, oldTail_j) = 0 ' 旧蛇尾变成空白，不吃食物时蛇的长度保持不变 End If End Sub Sub updateWithoutInput(moveDirection As String) '与输入无关的更新 If isFailure Then Return Static waitIndex As Long = 1 ' 静态局部变量，初始化时为1 waitIndex += 1 '每一帧+1 If waitIndex =10 Then '等于10才执行，这样小蛇每隔10帧移动一次 moveSnake(moveDirection) '调用小蛇移动函数 waitIndex =1 '再变成1 End If Sleep 10 '暂停若干毫秒 End Sub Sub updateWithInput(moveDirection As String) ' 和输入有关的更新 If isFailure Then Return If IsKeyPress(&H57) Then moveDirection = "上" ElseIf IsKeyPress(&H53) Then moveDirection = "下" ElseIf IsKeyPress(&H41) Then moveDirection = "左" ElseIf IsKeyPress(&H44) Then moveDirection = "右" End If End Sub Sub 游戏执行过程(hWndForm As hWnd) Dim gg As yGDI = hWndForm startup(gg) '初始化函数，仅执行一次 Dim moveDirection As String ="右" '小蛇移动方向 Do show(gg) ' 进行绘制 updateWithInput(moveDirection) ' 和输入有关的更新 updateWithoutInput(moveDirection) ' 和输入无关的更新 Loop End Sub -
VisualFreeBasic游戏趣味编程_7.6_失败判断与显示 定义全局变量isFailure表示游戏是否失败，初始化为0： Dim Shared isFailure As Long '是否游戏失败 当小蛇碰到画面边界时，则认为游戏失败。由于每次只有蛇头是新生成的位置，所以在moveSnake()函数中只需判断蛇头是否越过边界： If newHead_i >= BLOCK_HEIGHT Or newHead_i < 0 Or newHead_j >= BLOCK_WIDTH Or newHead_j < 0 Then isFailure = 1 Return End If 蛇头越过边界，游戏失败，将isFailure设为1；执行return，即函数返回，不运行moveSnake()后面的语句。 另外，当蛇头与蛇自身发生碰撞时，游戏也失败： If Blocks(newHead_i, newHead_j) > 0 Then isFailure = 1 Return End If 在show()函数中添加游戏失败后的显示信息： If isFailure Then gg.Font "黑体", 50, True gg.SetColor BGR(204,0,0) 'GDI的颜色值。 gg.DrawString 60, 50, "游戏失败" End If 在updateWithoutInput()中添加代码，当isFailure为1时，直接返回，不运行后面的语句： Sub updateWithoutInput(moveDirection As String) '与输入无关的更新 If isFailure Then Return 在updateWithInput()中，只有当按下键盘且isFailure为0时，才进行相应的处理： Sub updateWithInput(moveDirection As String) ' 和输入有关的更新 If isFailure Then Return 程序运行后输出如图7-8所示。 完整代码 #define BLOCK_HEIGHT 17 ' 高度上一共30个小格子 #define BLOCK_WIDTH 27 ' 宽度上一共40个小格子 #define BLOCK_SIZE 15 ' 每个小格子的长宽大小 '全局变量定义 Dim Shared Blocks(BLOCK_HEIGHT -1, BLOCK_WIDTH -1) As Long ' 二维数组，用于记录所有的游戏数据 Dim Shared isFailure As Long '是否游戏失败 Sub startup(gg As yGDI) '初始化函数 Dim i As Long, j As Long Blocks(BLOCK_HEIGHT / 2, Int(BLOCK_WIDTH / 2)) = 1 '画面中间画蛇头，数字为1 For i = 1 To 4 Blocks(BLOCK_HEIGHT / 2, Int(BLOCK_WIDTH / 2) - i) = i + 1 '向左依次4个蛇身，数值依次为2、3、4、5 Next gg.Pen 1, BGR(255, 255, 255) End Sub Sub show(gg As yGDI) '绘制函数 gg.Cls Dim i As Long, j As Long '对二维数组所有元素遍历 For i = 0 To BLOCK_HEIGHT -1 For j = 0 To BLOCK_WIDTH -1 If Blocks(i, j) > 0 Then gg.Brush HSBtoRGB_Gdi(HSB(Blocks(i, j) * 10, 90, 100, 255)) '根据元素值设定填充颜色 Else gg.Brush BGR(165, 165, 165) 'GDI的颜色值。 End If gg.DrawFrame j *BLOCK_SIZE, i *BLOCK_SIZE, BLOCK_SIZE, BLOCK_SIZE Next Next If isFailure Then gg.Font "黑体", 50, True gg.SetColor BGR(204,0,0) 'GDI的颜色值。 gg.DrawString 60, 50, "游戏失败" End If gg.Redraw End Sub Sub moveSnake(moveDirection As String) ' 移动小蛇及相关处理函数 Dim i As Long, j As Long For i = 0 To BLOCK_HEIGHT -1 '对行遍历 For j = 0 To BLOCK_WIDTH -1 '对列遍历 If Blocks(i, j) > 0 Then '大于0的为小蛇元素 Blocks(i, j) += 1 '让其+1 End If Next Next Dim As Long oldTail_i, oldTail_j, oldHead_i, oldHead_j '定义变量，存储旧蛇尾、旧蛇头坐标 Dim mm As Long '用于记录最大值 For i = 0 To BLOCK_HEIGHT -1 '对行遍历 For j = 0 To BLOCK_WIDTH -1 '对列遍历 If mm < Blocks(i, j) Then '如果当前元素值比max大 mm = Blocks(i, j) '更新max的值 oldTail_i = i ' 记录最大值的坐标,就是旧蛇尾的位置 oldTail_j = j End If If Blocks(i, j) = 2 Then '找到数值为2 oldHead_i = i ' 数值为2恰好是旧蛇头的位置 oldHead_j = j ' End If Next Next Dim newHead_i As Long = oldHead_i ' 设定变量存储新蛇头的位置 Dim newHead_j As Long = oldHead_j If (moveDirection = "左") Then newHead_j = oldHead_j -1 ' 向左移动 ElseIf (moveDirection = "右") Then newHead_j = oldHead_j + 1 '向右移动 ElseIf (moveDirection = "上") Then newHead_i = oldHead_i -1 ' 向上移动 ElseIf (moveDirection = "下") Then newHead_i = oldHead_i + 1 ' 向下移动 End If Print newHead_j , BLOCK_WIDTH '当小蛇碰到画面边界时 If newHead_i >= BLOCK_HEIGHT Or newHead_i < 0 Or newHead_j >= BLOCK_WIDTH Or newHead_j < 0 Then isFailure = 1 Return End If '当蛇头与蛇自身发生碰撞时 If Blocks(newHead_i, newHead_j) > 0 Then isFailure = 1 Return End If Blocks(newHead_i, newHead_j) = 1 ' 新蛇头位置数值为1 Blocks(oldTail_i, oldTail_j) = 0 ' 旧蛇尾位置变成空白 End Sub Sub updateWithoutInput(moveDirection As String) '与输入无关的更新 If isFailure Then Return Static waitIndex As Long = 1 ' 静态局部变量，初始化时为1 waitIndex += 1 '每一帧+1 If waitIndex =10 Then '等于10才执行，这样小蛇每隔10帧移动一次 moveSnake(moveDirection) '调用小蛇移动函数 waitIndex =1 '再变成1 End If Sleep 10 '暂停若干毫秒 End Sub Sub updateWithInput(moveDirection As String) ' 和输入有关的更新 If isFailure Then Return If IsKeyPress(&H57) Then moveDirection = "上" ElseIf IsKeyPress(&H53) Then moveDirection = "下" ElseIf IsKeyPress(&H41) Then moveDirection = "左" ElseIf IsKeyPress(&H44) Then moveDirection = "右" End If End Sub Sub 游戏执行过程(hWndForm As hWnd) Dim gg As yGDI = hWndForm startup(gg) '初始化函数，仅执行一次 Dim moveDirection As String ="右" '小蛇移动方向 Do show(gg) ' 进行绘制 updateWithInput(moveDirection) ' 和输入有关的更新 updateWithoutInput(moveDirection) ' 和输入无关的更新 Loop End Sub -
VisualFreeBasic游戏趣味编程_7.4_控制小蛇向4个方向移动 变量oldHead_i、oldHead_j存储移动前的蛇头位置（对应元素在二维数组中的行号、列号），newHead_i、newHead_j存储移动后的蛇头位置。小蛇向上移动，只需把新蛇头的坐标设为旧蛇头的上方即可，如图7-6所示。 在7-3代码的基础上修改代码就可以让小蛇向上移动： newHead_i = oldTail_j -1 '向上移动 进一步， 我们让玩家用键盘控制小蛇的移动。除了上、下、左、右键外，很多游戏使用A、S、D、W键控制游戏角色的移动，如图7-7所示。 定义字符变量moveDirection表示小蛇运动方向，在moveSnake()函数中对其值进行判断，取'a'向左运动、'd'向右运动、'w'向上运动、's'向下运动： Dim moveDirection As String '小蛇移动方向 If (moveDirection = "a") Then newHead_j = oldHead_j -1 ' 向左移动 If (moveDirection = "d") Then newHead_j = oldHead_j + 1 '向右移动 If (moveDirection = "w") Then newHead_i = oldHead_i -1 ' 向上移动 If (moveDirection = "s") Then newHead_i = oldHead_i + 1 ' 向下移动 除了if语句，FB语言还提供了if-else双选择语句 Sub 游戏执行过程(hWndForm As hWnd) Dim x As Long = 7 If x Mod 2 = 0 Then Print x & "是偶数" Else Print x & "奇数" End If End Sub 程序运行后输出：7是奇数 if语句首先判断条件 x Mod 2 = 0 是否满足，如果条件满足，就执行if后面的 Print x & "是偶数"语句；如果条件不满足，则执行else之后的Print x & "奇数"语句。 提示 else不能单独出现，必须和if配套使用。 当有一系列条件要判断时，FB语言还提供了多条件的if语句，以下代码把百分制得分转换为五级评分标准。 Sub 游戏执行过程(hWndForm As hWnd) Dim 文本 As CWSTR = AfxInputBox(hWndForm,,,"数字输入","输入 1到 100 的数字","100",260) Dim x As Long = Val(文本) If x>=90 Then Print "优秀" ElseIf x>=80 Then Print "良好" ElseIf x>=70 Then Print "中等" ElseIf x>=60 Then Print "及格" Else Print "不及格" End If End Sub 其中，AfxInputBox 等待用户键盘输入整数，按回车键后赋给变量x。 代码首先判断得分是否大于等于90，如果条件满足，就输出“优秀”； 否则，判断得分是否大于等于80，如果条件满足，说明得分在80～89之间，就输出“良好”； 否则，判断得分是否大于等于70，如果条件满足，说明得分在70～79之间，就输出“中等”； 否则，判断得分是否大于等于60，如果条件满足，说明得分在60～69之间，就输出“及格”； 否则，就说明得分小于60，输出“不及格”。 利用else语句，我们可以改进小蛇运动的控制代码，减少不必要的重复判断： If (moveDirection = "a") Then newHead_j = oldHead_j -1 ' 向左移动 ElseIf (moveDirection = "d") Then newHead_j = oldHead_j + 1 '向右移动 ElseIf (moveDirection = "w") Then newHead_i = oldHead_i -1 ' 向上移动 ElseIf (moveDirection = "s") Then newHead_i = oldHead_i + 1 ' 向下移动 End If 练习题7-2：身体质量指数（Body Mass Index，BMI）是衡量人体肥胖程度的重要标准，读者可以搜索相应的计算方法与标准，尝试编写程序判断体重是否正常。输入样例，程序运行后输出如下。 在updateWithInput()函数中获得用户按键输入，如果是A、S、D、W键之一，就更新moveDirection变量，执行moveSnake()函数让小蛇向对应方向移动： Sub updateWithInput(moveDirection As String) ' 和输入有关的更新 If IsKeyPress(&H57) Then moveDirection = "上" ElseIf IsKeyPress(&H53) Then moveDirection = "下" ElseIf IsKeyPress(&H41) Then moveDirection = "左" ElseIf IsKeyPress(&H44) Then moveDirection = "右" End If End Sub 全部源码 #define BLOCK_HEIGHT 17 ' 高度上一共30个小格子 #define BLOCK_WIDTH 27 ' 宽度上一共40个小格子 #define BLOCK_SIZE 15 ' 每个小格子的长宽大小 '全局变量定义 Dim Shared Blocks(BLOCK_HEIGHT -1, BLOCK_WIDTH -1) As Long ' 二维数组，用于记录所有的游戏数据 Sub startup(gg As yGDI) '初始化函数 Dim i As Long, j As Long Blocks(BLOCK_HEIGHT / 2, Int(BLOCK_WIDTH / 2)) = 1 '画面中间画蛇头，数字为1 For i = 1 To 4 Blocks(BLOCK_HEIGHT / 2, Int(BLOCK_WIDTH / 2) - i) = i + 1 '向左依次4个蛇身，数值依次为2、3、4、5 Next gg.Pen 1, BGR(255, 255, 255) End Sub Sub show(gg As yGDI) '绘制函数 gg.Cls Dim i As Long, j As Long '对二维数组所有元素遍历 For i = 0 To BLOCK_HEIGHT -1 For j = 0 To BLOCK_WIDTH -1 If Blocks(i, j) > 0 Then gg.Brush HSBtoRGB_Gdi(HSB(Blocks(i, j) * 10, 90, 100, 255)) '根据元素值设定填充颜色 Else gg.Brush BGR(165, 165, 165) 'GDI的颜色值。 End If gg.DrawFrame j *BLOCK_SIZE, i *BLOCK_SIZE, BLOCK_SIZE, BLOCK_SIZE Next Next gg.Redraw End Sub Sub moveSnake(moveDirection As String) ' 移动小蛇及相关处理函数 Dim i As Long, j As Long For i = 0 To BLOCK_HEIGHT -1 '对行遍历 For j = 0 To BLOCK_WIDTH -1 '对列遍历 If Blocks(i, j) > 0 Then '大于0的为小蛇元素 Blocks(i, j) += 1 '让其+1 End If Next Next Dim As Long oldTail_i, oldTail_j, oldHead_i, oldHead_j '定义变量，存储旧蛇尾、旧蛇头坐标 Dim mm As Long '用于记录最大值 For i = 0 To BLOCK_HEIGHT -1 '对行遍历 For j = 0 To BLOCK_WIDTH -1 '对列遍历 If mm < Blocks(i, j) Then '如果当前元素值比max大 mm = Blocks(i, j) '更新max的值 oldTail_i = i ' 记录最大值的坐标,就是旧蛇尾的位置 oldTail_j = j End If If Blocks(i, j) = 2 Then '找到数值为2 oldHead_i = i ' 数值为2恰好是旧蛇头的位置 oldHead_j = j ' End If Next Next Dim newHead_i As Long = oldHead_i ' 设定变量存储新蛇头的位置 Dim newHead_j As Long = oldHead_j If (moveDirection = "左") Then newHead_j = oldHead_j -1 ' 向左移动 If newHead_j < 0 Then newHead_j = BLOCK_WIDTH -1 ElseIf (moveDirection = "右") Then newHead_j = oldHead_j + 1 '向右移动 If newHead_j >= BLOCK_WIDTH Then newHead_j = 0 ElseIf (moveDirection = "上") Then newHead_i = oldHead_i -1 ' 向上移动 If newHead_i < 0 Then newHead_i = BLOCK_HEIGHT -1 ElseIf (moveDirection = "下") Then newHead_i = oldHead_i + 1 ' 向下移动 If newHead_i >= BLOCK_HEIGHT Then newHead_i = 0 End If Blocks(newHead_i, newHead_j) = 1 ' 新蛇头位置数值为1 Blocks(oldTail_i, oldTail_j) = 0 ' 旧蛇尾位置变成空白 End Sub Sub updateWithoutInput(moveDirection As String) '与输入无关的更新 moveSnake(moveDirection) '调用小蛇移动函数 Sleep 100 '暂停若干毫秒 End Sub Sub updateWithInput(moveDirection As String) ' 和输入有关的更新 If IsKeyPress(&H57) Then moveDirection = "上" ElseIf IsKeyPress(&H53) Then moveDirection = "下" ElseIf IsKeyPress(&H41) Then moveDirection = "左" ElseIf IsKeyPress(&H44) Then moveDirection = "右" End If End Sub Sub 游戏执行过程(hWndForm As hWnd) Dim gg As yGDI = hWndForm startup(gg) '初始化函数，仅执行一次 Dim moveDirection As String ="右" '小蛇移动方向 Do show(gg) ' 进行绘制 updateWithInput(moveDirection) ' 和输入有关的更新 updateWithoutInput(moveDirection) ' 和输入无关的更新 Loop End Sub -
VisualFreeBasic游戏趣味编程_7.3_小蛇向右移动 实现小蛇的移动功能是“贪吃蛇”游戏的开发难点，图7-4列出了小蛇向右移动前后二维数组的元素值，虚线框内为对应代码的实现步骤： 假设小蛇初始元素值为54321，其中1为蛇头、5432为蛇身、最大值5为蛇尾。首先将二维数组中所有大于0的元素加1，得到65432；然后将最大值6变为0，即去除了原来的蛇尾；最后将2右边的元素由0变成1，即实现了小蛇向右移动。 定义函数moveSnake( )处理小蛇移动的相关操作： Sub moveSnake() ' 移动小蛇及相关处理函数 Dim i As Long, j As Long For i = 0 To BLOCK_HEIGHT -1 '对行遍历 For j = 0 To BLOCK_WIDTH -1 '对列遍历 If Blocks(i, j) > 0 Then '大于0的为小蛇元素 Blocks(i, j) += 1 '让其+1 End If Next Next Dim As Long oldTail_i, oldTail_j, oldHead_i, oldHead_j '定义变量，存储旧蛇尾、旧蛇头坐标 Dim mm As Long '用于记录最大值 For i = 0 To BLOCK_HEIGHT -1 '对行遍历 For j = 0 To BLOCK_WIDTH -1 '对列遍历 If mm < Blocks(i, j) Then '如果当前元素值比max大 mm = Blocks(i, j) '更新max的值 oldTail_i = i ' 记录最大值的坐标,就是旧蛇尾的位置 oldTail_j = j End If If Blocks(i, j) = 2 Then '找到数值为2 oldHead_i = i ' 数值为2恰好是旧蛇头的位置 oldHead_j = j ' End If Next Next Dim newHead_i As Long = oldHead_i ' 设定变量存储新蛇头的位置 Dim newHead_j As Long = oldHead_j newHead_j = oldHead_j + 1 ' 向右移动，更新蛇头坐标 If newHead_j = BLOCK_WIDTH Then newHead_j = 0 Blocks(newHead_i, newHead_j) = 1 ' 新蛇头位置数值为1 Blocks(oldTail_i, oldTail_j) = 0 ' 旧蛇尾位置变成空白 End Sub 在updateWithoutInput( )函数中调用moveSnake( )： Sub updateWithoutInput() '与输入无关的更新 moveSnake() '调用小蛇移动函数 End Sub 通过以上操作则实现了小蛇自动向右移动，效果如图7-5所示。 -
VisualFreeBasic游戏趣味编程_7.1_变量作用域与游戏框架 在程序中变量起作用的范围，称为变量的作用域。根据作用域的不同，FB语言中的变量可分为局部变量和全局变量。 在函数内部定义的变量称为局部变量，其作用域从变量定义处开始，到}处结束。 Sub fun() Dim a As Long '局部变量，仅能在fun函数内部使用 a=10 End Sub Sub 游戏执行过程(hWndForm As hWnd) Dim x As Long '局部变量，仅能在[游戏执行过程]函数内部使用 x = 1 End Sub 在以上代码中，变量a的作用域在函数fun()内部，如果在其他区域使用变量a，程序报错；变量x的作用域在函数【游戏执行过程()】内部，如果在其他区域使用变量x，程序报错。 在所有函数之外定义的变量称为全局变量，其作用域从变量定义处开始，到整个程序最后结束。 Dim Shared m As Long '全局变量，整个程序都可以访问 Sub fun() m=3 End Sub Sub 游戏执行过程(hWndForm As hWnd) Print mm = 2 Print m fun() Print m End Sub 在上面代码中，变量m在函数外定义，为全局变量，因此在函数外、函数fun()与main()内都可以访问。程序运行后输出： 1 2 3 提示 如果全局变量与局部变量同名，则在局部变量的作用域内访问的是局部变量，全局变量将被“屏蔽” 利用函数和变量作用域的知识，我们设定了一个简化的游戏开发框架： '全局变量定义 Sub startup() '初始化函数 End Sub Sub show() '绘制函数 End Sub Sub updateWithoutInput() '与输入无关的更新 End Sub Sub updateWithInput() ' 和输入有关的更新 End Sub Sub 游戏执行过程(hWndForm As hWnd) Dim gg As yGDI = hWndForm startup() ' 初始化函数,仅执行一次 Do gg.Cls show() ' 进行绘制 updateWithoutInput() '和输入无关的更新 updateWithInput() ' 和输入有关的更新 gg.Redraw Sleep 100 Loop End Sub 首先在函数外定义一些游戏数据变量，这些全局变量在整个程序中均可以访问。具体的游戏功能在startup()、show()、updateWithoutInput()、updateWithInput()这4个函数中实现。 程序从主函数开始，首先运行一次startup()，进行游戏的初始化。然后开始循环执行3个函数：show()进行绘制、updateWithoutInput()执行和输入无关的更新、updateWithInput()执行和输入有关的更新。 -
VisualFreeBasic游戏趣味编程_6.7_按键互动 当按下空格键后，将circleNum设为0，相当于清除所有已有的圆；将drawMode加1，从而切换为下一种绘图模式： Do If IsKeyPress(VK_SPACE) Then '按下空格键 drawMode += 1 If drawMode > 4 Then drawMode = 1 Exit Do End If Sleep 100 Loop 全部代码 Sub 游戏执行过程(hWndForm As hWnd) Dim gg As yGDI = hWndForm Dim 圆心x(99) As Long '数组存储所有圆心的x坐标 Dim 圆心y(99) As Long '数组存储所有圆心的y坐标 Dim 半径(99) As Long '数组存储所有圆的半径 Dim 圆的个数 As Long = 0 Dim 游戏W As Long = DpiunScaleI(Form1.ScaleWidth) '游戏区的尺寸 Dim 游戏H As Long = DpiunScaleI(Form1.ScaleHeight) Dim 圆的最小半径 As Long = 5 Dim 圆的最大半径 As Long = 40 Dim circleNum As Long ' 生成的圆的个数 Dim As Long x, y, r ' 新增圆的圆心坐标、半径 Dim isNewCircleOK As Long '用于判断新生成的圆是否OK '生成圆，把数据保存在数组中 Dim i As Long Dim drawMode As Long = 1 Do While 圆的个数 < 100 '当圆的个数小于100时，循环运行 isNewCircleOK = 0 ' 假设开始不OK While isNewCircleOK = 0 ' 当新生成的圆不OK时，重复生成新圆进行比较 Randomize x = Int(Rnd *游戏W) '新圆的圆心x坐标 Randomize y = Int(Rnd *游戏H) '新圆的圆心y坐标 ' r = 圆的最小半径 For i = 0 To 圆的个数 -1 If isTwoCirclesIntersect(圆心x(i), 圆心y(i), 半径(i), x, y, r) Then Exit For ' 如果已有圆和新圆相交跳出循环，此时i<圆的个数 Next If (i = 圆的个数) Then ' 如果上面for语句都不跳出，说明i等于circleNum isNewCircleOK = 1 ' 这个新生成的圆和已有圆都不相交 End If Wend isNewCircleOK = 0 ' 继续设为不OK，下面要让这个新圆的半径最大 While isNewCircleOK = 0 And r < 圆的最大半径 ' 当不OK，并且新圆的半径小于最大半径时 r += 1 For i = 0 To 圆的个数 -1 If isTwoCirclesIntersect(圆心x(i), 圆心y(i), 半径(i), x, y, r) Then isNewCircleOK = 1 ' 一旦和一个旧圆相交，这时新圆OK Exit For ' 因为新圆半径已经达到最大的情况，这时跳出循环 End If Next Wend 圆心x(圆的个数) = x '把新圆的圆心坐标添加到数组中 圆心y(圆的个数) = y 半径(圆的个数) = r '把新圆的半径添加到数组中 圆的个数 += 1 '圆的个数+1 Wend gg.Cls For i = 0 To 圆的个数 -1 'Dim drawMode As Long = randBetweenMinMax(1, 4) ' 随机生成一种绘制模式 ' 根据不同绘图模式进行绘制 If (drawMode = 1) Then DrawCircles1(gg, 圆心x(i), 圆心y(i), 半径(i)) ElseIf (drawMode = 2) Then DrawCircles2(gg, 圆心x(i), 圆心y(i), 半径(i)) ElseIf (drawMode = 3) Then DrawCircles3(gg, 圆心x(i), 圆心y(i), 半径(i)) ElseIf (drawMode = 4) Then DrawCircles4(gg, 圆心x(i), 圆心y(i), 半径(i)) End If Next gg.Redraw Sleep 500 Do If IsKeyPress(VK_SPACE) Then '按下空格键 圆的个数 =0 drawMode += 1 If drawMode > 4 Then drawMode = 1 Exit Do End If Sleep 100 Loop Loop End Sub -
VisualFreeBasic游戏趣味编程_6.6_函数封装多种绘制效果 对于圆心坐标(x,y)、半径r的圆，定义4个函数，可以实现不同的绘制效果： '填充黄色圆绘制 Sub DrawCircles1(gg As yGDI, x As Long, y As Long, r As Long) gg.Pen 1, BGR(105, 105, 105) 'GDI的颜色值。 gg.Brush BGR(204, 204, 0) 'GDI的颜色值。 gg.DrawEllipse x - r, y - r, r * 2, r * 2 End Sub '填充随机颜色圆绘制 Sub DrawCircles2(gg As yGDI, x As Long, y As Long, r As Long) gg.Pen 1, BGR(255, 255, 255) 'GDI的颜色值。 Randomize Dim h As Long = Rnd *360 gg.Brush HSBtoRGB_Gdi(HSB(h,60,80,255) ) 'GDI的颜色值。 gg.DrawEllipse x - r, y - r, r * 2, r * 2 End Sub '填充随机颜色同心圆绘制 Sub DrawCircles3(gg As yGDI, x As Long, y As Long, r As Long) gg.Pen 1, BGR(255, 255, 255) 'GDI的颜色值。 While r > 0 Randomize Dim h As Long = Rnd * 360 gg.Brush HSBtoRGB_Gdi(HSB(h, 60, 80, 255)) 'GDI的颜色值。 gg.DrawEllipse x - r, y - r, r * 2, r * 2 r -= 5 Wend End Sub '随机颜色同心圆线条绘制 Sub DrawCircles4(gg As yGDI, x As Long, y As Long, r As Long) gg.Brush While r > 0 Randomize Dim h As Long = Rnd * 360 gg.Pen 1, HSBtoRGB_Gdi(HSB(h, 90, 80, 255)) 'GDI的颜色值。 gg.DrawEllipse x - r, y - r, r * 2, r * 2 r -= 5 Wend End Sub 在主函数中首先生成[1,4]之间的随机数drawMode，然后根据drawMode的值分别调用不同的绘制函数，即可生成对应的绘制效果。 For i = 0 To 圆的个数 -1 Dim drawMode As Long = randBetweenMinMax(1, 4) ' 随机生成一种绘制模式 ' 根据不同绘图模式进行绘制 If (drawMode = 1) Then DrawCircles1(gg,圆心x(i), 圆心y(i), 半径(i)) ElseIf (drawMode = 2) Then DrawCircles2(gg,圆心x(i), 圆心y(i), 半径(i)) ElseIf (drawMode = 3) Then DrawCircles3(gg,圆心x(i), 圆心y(i), 半径(i)) ElseIf (drawMode = 4) Then DrawCircles4(gg,圆心x(i), 圆心y(i), 半径(i)) End If Next 绘制效果如图6-8所示。 完整代码 ' 判断两个圆是否相交 Function isTwoCirclesIntersect(x1 As Long, y1 As Long,r1 As Long , x2 As Long, y2 As Long, r2 As Long ) As Long If (Dist2Points(x1, y1, x2, y2) < r1 + r2) Then Return 1 Else Return 0 End Function ' 求解两个点之间的距离 Function Dist2Points(x1 As Long, y1 As Long, x2 As Long, y2 As Long) As Long Dim result As Long result = Sqr((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2)) Return result End Function '生成[min,max]之间的随机整数 Function randBetweenMinMax(小 As Long, 大 As Long) As Long Randomize Dim r As Long = int(Rnd * (大 - 小 + 1)) + 小 Return r End Function '填充黄色圆绘制 Sub DrawCircles1(gg As yGDI, x As Long, y As Long, r As Long) gg.Pen 1, BGR(105, 105, 105) 'GDI的颜色值。 gg.Brush BGR(204, 204, 0) 'GDI的颜色值。 gg.DrawEllipse x - r, y - r, r * 2, r * 2 End Sub '填充随机颜色圆绘制 Sub DrawCircles2(gg As yGDI, x As Long, y As Long, r As Long) gg.Pen 1, BGR(255, 255, 255) 'GDI的颜色值。 Randomize Dim h As Long = Rnd *360 gg.Brush HSBtoRGB_Gdi(HSB(h,60,80,255) ) 'GDI的颜色值。 gg.DrawEllipse x - r, y - r, r * 2, r * 2 End Sub '填充随机颜色同心圆绘制 Sub DrawCircles3(gg As yGDI, x As Long, y As Long, r As Long) gg.Pen 1, BGR(255, 255, 255) 'GDI的颜色值。 While r > 0 Randomize Dim h As Long = Rnd * 360 gg.Brush HSBtoRGB_Gdi(HSB(h, 60, 80, 255)) 'GDI的颜色值。 gg.DrawEllipse x - r, y - r, r * 2, r * 2 r -= 5 Wend End Sub '随机颜色同心圆线条绘制 Sub DrawCircles4(gg As yGDI, x As Long, y As Long, r As Long) gg.Brush While r > 0 Randomize Dim h As Long = Rnd * 360 gg.Pen 1, HSBtoRGB_Gdi(HSB(h, 90, 80, 255)) 'GDI的颜色值。 gg.DrawEllipse x - r, y - r, r * 2, r * 2 r -= 5 Wend End Sub Sub 游戏执行过程(hWndForm As hWnd) Dim gg As yGDI = hWndForm Dim 圆心x(99) As Long '数组存储所有圆心的x坐标 Dim 圆心y(99) As Long '数组存储所有圆心的y坐标 Dim 半径(99) As Long '数组存储所有圆的半径 Dim 圆的个数 As Long = 0 Dim 游戏W As Long = DpiunScaleI(Form1.ScaleWidth) '游戏区的尺寸 Dim 游戏H As Long = DpiunScaleI(Form1.ScaleHeight) Dim 圆的最小半径 As Long = 5 Dim 圆的最大半径 As Long = 40 Dim circleNum As Long ' 生成的圆的个数 Dim As Long x, y, r ' 新增圆的圆心坐标、半径 Dim isNewCircleOK As Long '用于判断新生成的圆是否OK '生成圆，把数据保存在数组中 Dim i As Long While 圆的个数 < 100 '当圆的个数小于100时，循环运行 isNewCircleOK = 0 ' 假设开始不OK While isNewCircleOK = 0 ' 当新生成的圆不OK时，重复生成新圆进行比较 x = Int(Rnd *游戏W) '新圆的圆心x坐标 y = Int(Rnd *游戏H) '新圆的圆心y坐标 ' r = 圆的最小半径 For i = 0 To 圆的个数 -1 If isTwoCirclesIntersect(圆心x(i), 圆心y(i), 半径(i), x, y, r) Then Exit For ' 如果已有圆和新圆相交跳出循环，此时i<圆的个数 Next If (i = 圆的个数) Then ' 如果上面for语句都不跳出，说明i等于circleNum isNewCircleOK = 1 ' 这个新生成的圆和已有圆都不相交 End If Wend isNewCircleOK = 0 ' 继续设为不OK，下面要让这个新圆的半径最大 While isNewCircleOK = 0 And r < 圆的最大半径 ' 当不OK，并且新圆的半径小于最大半径时 r += 1 For i = 0 To 圆的个数 -1 If isTwoCirclesIntersect(圆心x(i), 圆心y(i), 半径(i), x, y, r) Then isNewCircleOK = 1 ' 一旦和一个旧圆相交，这时新圆OK Exit For ' 因为新圆半径已经达到最大的情况，这时跳出循环 End If Next Wend 圆心x(圆的个数) = x '把新圆的圆心坐标添加到数组中 圆心y(圆的个数) = y 半径(圆的个数) = r '把新圆的半径添加到数组中 圆的个数 += 1 '圆的个数+1 Wend gg.Pen 1, BGR(105, 105, 105) 'GDI的颜色值。 gg.Brush BGR(204, 204, 0) 'GDI的颜色值。 For i = 0 To 圆的个数 -1 Dim drawMode As Long = randBetweenMinMax(1, 4) ' 随机生成一种绘制模式 ' 根据不同绘图模式进行绘制 If (drawMode = 1) Then DrawCircles1(gg,圆心x(i), 圆心y(i), 半径(i)) ElseIf (drawMode = 2) Then DrawCircles2(gg,圆心x(i), 圆心y(i), 半径(i)) ElseIf (drawMode = 3) Then DrawCircles3(gg,圆心x(i), 圆心y(i), 半径(i)) ElseIf (drawMode = 4) Then DrawCircles4(gg,圆心x(i), 圆心y(i), 半径(i)) End If Next End Sub