论坛的首页
勇芳的软件
教程和帮助
VisualFreeBasic编程文档
勇芳系列软件帮助说明教程
留言或交流
登录
搜索
登录
搜索
勇芳
累计撰写
330
篇文章
累计收到
0
条评论
首页
栏目
论坛的首页
勇芳的软件
教程和帮助
VisualFreeBasic编程文档
勇芳系列软件帮助说明教程
留言或交流
登录
自定义幻灯片
最新文章
2026-1-22
VisualFreeBasic游戏趣味编程_8.5_旋转的传播
当鼠标点中一个小圆圈时,小圆圈顺时针旋转90度,然后其指向的下一个圆圈继续旋转90度,如此迭代下去,直到不指向任何小圆圈为止(此时指向边界),如图8-7所示。 首先定义一维数组indexes存储被鼠标点中的小圆圈在二维数组rounds中的行列序号: Dim indexes(1) As Long '数组存储点击小圆圈的行列序号 定义函数int GetNextIndexes(int indexes[2]),根据当前小圆圈的序号indexes[0]、indexes[1]和当前小圆圈的角度angleNum,首先求出其指向的小圆圈的序号。如果指向的小圆圈超出边界,函数返回0;如果指向一个有效的小圆圈,就把其序号更新到数组indexes中,函数返回1。 ' 获得当前圆圈指向的下一个圆圈的序号 ' 当前圆圈序号存储在数组int indexes[2]中,下一个圆圈序号也存储在这个数组中 ' 如果有下一个指向的圆圈,则返回1;如果指向边界了,则返回0 Function GetNextIndexes(indexes() As Long) As Long Dim i As Long = indexes(0) '当前圆圈的i、j序号 dim j as long = indexes(1) ' 根据当前圆圈的角度,获得下一个小圆圈的序号 If (Rounds[i][j].angleNum = = 0) Then ' 指向右边的小圆圈 j += 1 ' right ElseIf (Rounds[i][j].angleNum = 3) Then ' 指向下边的小圆圈 i += 1 ' down ElseIf (Rounds[i][j].angleNum = 2) Then _ ' 指向左边的小圆圈 j -= 1 ' left ElseIf (rounds[i][j].angleNum = 1) Then _ ' 指向上边的小圆圈 i -= 1 ' up End If indexes(0) = i ' 在数组中更新指向的下一个圆圈的序号 indexes(1) = j If (i >= 0 And i < 5 And j >= 0 And j < 5) Then ' 如果序号没有越界 Return 1 ' 说明指向了一个圆圈,返回1 Else Return 0 ' 没有指向有效圆圈,返回0 End If End Function 循环调用GetNextIndexes( )函数,即实现了旋转的迭代传播: Dim indexes(1) As Long={clicked_i, clicked_j} '数组存储点击小圆圈的行列序号 While GetNextIndexes(indexes()) rotateRound(indexes(0),indexes(1)) show(gg) Sleep 800 Wend 完整代码 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() '初始化函数 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 rotateRound(i As Long, j As Long) If i >= 0 And j >= 0 And i < 5 And j < 5 Then Rounds(i, j).angleNum += 90 If Rounds(i, j).angleNum >= 360 Then Rounds(i, j).angleNum = 0 End If End Sub Sub updateWithInput(hWndForm As hWnd,gg As ygdi ) ' 和输入有关的更新 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 -45) / 45 Dim clicked_j As Long = int(ps.x -45) / 45 rotateRound(clicked_i, clicked_j) '把当前圆圈顺时针旋转90度 Dim indexes(1) As Long={clicked_i, clicked_j} '数组存储点击小圆圈的行列序号 While GetNextIndexes(indexes()) rotateRound(indexes(0),indexes(1)) show(gg) Sleep 800 Wend End If Else pp = 0 '表示鼠标放开 End If End Sub ' 获得当前圆圈指向的下一个圆圈的序号 ' 当前圆圈序号存储在数组int indexes[2]中,下一个圆圈序号也存储在这个数组中 ' 如果有下一个指向的圆圈,则返回1;如果指向边界了,则返回0 Function GetNextIndexes(indexes() As Long) As Long Dim i As Long = indexes(0) '当前圆圈的i、j序号 dim j as long = indexes(1) ' 根据当前圆圈的角度,获得下一个小圆圈的序号 If (Rounds(i,j).angleNum = 0) Then ' 指向右边的小圆圈 j += 1 ' right ElseIf (Rounds(i,j).angleNum = 90) Then ' 指向下边的小圆圈 i += 1 ' down ElseIf (Rounds(i,j).angleNum = 180) Then _ ' 指向左边的小圆圈 j -= 1 ' left ElseIf (Rounds(i,j).angleNum = 270) Then _ ' 指向上边的小圆圈 i -= 1 ' up End If indexes(0) = i ' 在数组中更新指向的下一个圆圈的序号 indexes(1) = j If (i >= 0 And i < 5 And j >= 0 And j < 5) Then ' 如果序号没有越界 Return 1 ' 说明指向了一个圆圈,返回1 Else Return 0 ' 没有指向有效圆圈,返回0 End If End Function Sub 游戏执行过程(hWndForm As hWnd) Dim gg As yGDI = hWndForm startup() Do show(gg) updateWithInput(hWndForm, gg) updateWithoutInput() Loop End Sub
2026年-1月-22日
46 阅读
0 评论
VisualFreeBasic编程文档
2026-1-22
VisualFreeBasic游戏趣味编程_8.4_函数的参数传递
在本节我们介绍一般变量、数组元素、数组名作为函数参数的几种情况。输入并运行以下代码: Sub fun(a As Long) a += 1 Print a End Sub Sub 游戏执行过程(hWndForm As hWnd) Dim x As Long = 1 Print x fun(x) Print x End Sub 程序运行后输出: 1 2 1 程序从主函数开始运行,首先定义变量x并初始化为1,print x 输出1。 接着执行fun(x) 进入fun()函数,为变量a分配内存空间,将实际参数x的值赋给形式参数a。执行fun()函数内部的语句a+=1 ,print a 输出2。fun()运行结束后,收回变量a的内存空间。 回到主函数中,x的值没有改变,print x 仍然输出1。 一般变量作为函数的参数,这种调用方式称为单向值调用,函数内形式参数的值改变不会影响主函数中对应实际参数的值。 以下代码将数组元素传递给函数: Sub fun(i As Long,j As Long ) i += 1 j+=1 End Sub Sub 游戏执行过程(hWndForm As hWnd) Dim x(1) As Long = {1,2} Print x(0),x(1) fun(x(0),x(1)) Print x(0),x(1) End Sub 程序运行后输出: 1 2 1 2 数组元素作为函数实际参数的用法和一般变量作为实际参数的用法一样,都是单向的值传递。 为了能在函数中修改实际参数的值,我们可以把数组名作为参数进行传递。输入并运行以下代码: Sub fun(a() As Long) a(0) = 3 a(1) = 4 End Sub Sub 游戏执行过程(hWndForm As hWnd) Dim x(1) As Long = {1,2} Print x(0),x(1) fun( x() ) Print x(0),x(1) End Sub 程序运行后输出: 1 2 3 4 在下一节我们将讲解利用数组作为函数的参数,实现圆圈旋转的迭代传播。
2026年-1月-22日
42 阅读
0 评论
VisualFreeBasic编程文档
2026-1-22
VisualFreeBasic游戏趣味编程_8.3_被鼠标点击后旋转
鼠标点击位置的坐标为(m.x,m.y),根据图8-3中5行5列小圆圈的坐标设置(代码8-1-2.cpp),被鼠标点中的小圆圈在二维数组rounds中的行、列序号为: Dim clicked_i As Long = Int(ps.y -45)/45 Dim clicked_j As Long = int(ps.x -45)/45 被点中的小圆圈需要顺时针旋转90度,如图8-6所示。 只需要将其angleNum值依次+90即可: Rounds(i, j).angleNum += 90 If Rounds(i, j).angleNum >= 360 Then Rounds(i, j).angleNum = 0 其中“+=”为复合运算符,x += 1等价于x = x ++ 1。 练习题8-2:写出以下程序并运行结果。 Dim a As Long = 1 a += 4 Print a a -= 2 Print a a *= 3 Print a a /= 2 Print a a Mod= 3 Print a 把小圆圈顺时针旋转的功能封装在函数rotateRound( )中,修改代码如下: 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 -45) / 45 Dim clicked_j As Long = int(ps.x -45) / 45 rotateRound(clicked_i, clicked_j) '把当前圆圈顺时针旋转90度 End If Else pp = 0 '表示鼠标放开 End If End Sub
2026年-1月-22日
40 阅读
0 评论
VisualFreeBasic编程文档
2026-1-22
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
2026年-1月-22日
51 阅读
0 评论
VisualFreeBasic编程文档
2026-1-22
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 程序运行后输出如图
2026年-1月-22日
41 阅读
0 评论
VisualFreeBasic编程文档
2026-1-22
VisualFreeBasic游戏趣味编程_第8章_“十步万度”游戏
在本章我们将探讨如何编写“十步万度”游戏,效果如图8-1所示。用鼠标点击任意一个小圆圈,其指针顺时针旋转90度,后续被指向的圆圈指针也依次旋转,所有圆圈的旋转度数累积。玩家点击10次,尝试得到尽量高的旋转度数。 本章首先介绍了结构体的概念,并展示利用结构体数组存储所有小圆圈信息;然后讲解了鼠标交互的方法,以及如何实现被鼠标点中的小圆圈的旋转;接着讲解了数组作为函数的参数,以及如何实现旋转的迭代传播;最后解析了如何实现操作步数和旋转度数的统计与显示。
2026年-1月-22日
56 阅读
0 评论
VisualFreeBasic编程文档
2026-1-22
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
2026年-1月-22日
76 阅读
0 评论
VisualFreeBasic编程文档
2026-1-22
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
2026年-1月-22日
63 阅读
0 评论
VisualFreeBasic编程文档
2026-1-22
VisualFreeBasic游戏趣味编程_7.5_时间控制的改进
之前代码通过在updateWithoutInput()函数中调用Sleep()函数来降低小蛇的移动速度。然而Sleep()函数运行时,整个程序都会暂停,包括用户输入模块。用户会感觉到卡顿,明明按了键,小蛇却没有反应。 为了解决这一问题,这一节介绍动态变量、静态变量的概念。输入并运行以下代码: Sub fun() Dim m As Long m += 1 Print m End Sub Sub 游戏执行过程(hWndForm As hWnd) fun() fun() fun() End Sub 程序运行后输出: 1 1 1 函数中定义的变量默认为动态变量,程序从变量的作用域开始,为其动态分配内存空间;到变量的作用域结束,动态收回变量的内存空间。 主函数中第一次调用fun()时,动态分配内存空间,m初始化为0,加1,输出,fun()运行结束,程序收回m的内存空间。第二次调用fun(),继续动态分配m的内存空间,m初始化为0,加1,输出1,收回内存空间。第三次调用也输出1。 用关键词static修饰的变量称为静态变量,即程序开始运行时就为其分配内存空间,直到程序运行完收回,修改代码如下: Sub fun() Static m As Long m += 1 Print m End Sub 程序运行后输出: 1 2 3 程序运行后为m分配内存空间,并初始化为0。主函数中第一次调用fun()时,m加1,输出1,fun()运行结束,程序不收回m的内存空间。第二次调用fun(),m继续加1,输出2。第三次调用输出3。 利用静态变量,将updateWithoutInput( )修改如下: Sub updateWithoutInput(moveDirection As String) '与输入无关的更新 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 其中,waitIndex为静态变量,程序运行后初始化为1。updateWithoutInput()每次运行时,waitIndex加1,每隔10帧,才执行一次小蛇移动函数moveSnake()。这样可在不影响用户按键输入的情况下,降低小蛇的移动速度。
2026年-1月-22日
42 阅读
0 评论
VisualFreeBasic编程文档
2026-1-22
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
2026年-1月-22日
38 阅读
0 评论
VisualFreeBasic编程文档
9
10
11
12
13