- 最新文章
-
VisualFreeBasic游戏趣味编程_10.9_指针与数组 数组名作为函数参数时可以修改实际参数的值（8.4节），这是因为数组的名字就是一个指针： Sub 游戏执行过程(hWndForm As hWnd) Dim a(4) As Long ={1,2,3,4,5} Print @a(0) End Sub 将指针变量p赋为数组的首地址，则可以通过以下方式访问数组元素： Sub 游戏执行过程(hWndForm As hWnd) Dim a(4) As Long = {1, 2, 3, 4, 5} Dim p As Long Ptr = @a(0) Dim i As Long For i = 0 To 4 Print a(i) Next For i = 0 To 4 Print p[i] Next For i = 0 To 4 Print *p p +=1 Next End Sub 程序运行后输出： 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5 由于数组元素在内存中是依次排列的，由于p=a，因此 p[i]也等于a(i)。 在消除类游戏中，经常会有游戏难度越大、画面越大的需求，这时就需要用变量设定数组的大小，比如： Sub 游戏执行过程(hWndForm As hWnd) Dim a() As Long Print UBound(a) ReDim a(5) Print UBound(a) ReDim a(6) Print UBound(a) End Sub 程序运行后输出： -1 5 6 Dim a() As Long 是定义动态数组 ，ReDim a(5) 执行代码时随时改变数组大小 UBound(a) 获取数组大小。返回-1 表示 数组没初始化，不可用，一用就崩溃。 读者可以修改的代码，实现随着游戏关卡数的增加，游戏画面越来越大、方块个数越来越多的效果，如图10-13所示 -
VisualFreeBasic游戏趣味编程_10.8_地址与指针 FB语言中所有变量都存储在内存中，而存放变量特定内存单元的编号就称为地址，输入并运行以下代码： Sub 游戏执行过程(hWndForm As hWnd) Dim a As Long a = 1 Print a Print @a End Sub 程序运行后输出 1 54394640 其中@称为取地址运算符，@a即为变量a的地址。注意，每次运行时，程序为变量a分配的地址可能不一样。54394640 的数字每次运行都会不同 为了处理地址，我们可以定义一类特殊的变量——指针（变量）： Sub 游戏执行过程(hWndForm As hWnd) Dim a As Long =1 Dim p As Long Ptr p=@a Print @a Print p Print a Print *p End Sub 程序运行后输出： 54394640 54394640 1 1 其中，Dim p As Long Ptr定义了指针变量p，Ptr 表示为指针变量，Long 表示p可以记录整型变量的地址。 p = @a 将变量a的地址赋给指针p，这样p就指向a所在的内存空间。因此print @a 和print p 输出同样的结果。 printf *p *为取内容运算符，表示取p指向的内存空间的内容，即为a的值1。 同一般变量一样，指针变量之间也可以相互赋值： Sub 游戏执行过程(hWndForm As hWnd) Dim a As Long Dim p As Long Ptr ,q As Long Ptr p = @a q=p *q = 2 Print a Print *p Print *q End Sub 经过赋值后，指针变量p、q均指向整型变量a。因此通过q=2赋值后，a、p的值也变成2，程序输出： 2 2 2 利用指针，我们可以在调用函数时修改实际参数的值： Sub fun(a As Long Ptr) *a = *a + 1 End Sub Sub 游戏执行过程(hWndForm As hWnd) Dim x As Long = 1 Print x fun(@x) Print x End Sub 程序运行后输出： 1 2 运行fun(@x)，将变量x的地址传递给形式参数a。a即为实际参数x的地址。在fun()函数中通过*a修改x的内存空间，返回到主函数后，x的值也改变了。 和8.4节中讲解的值调用不同，这种参数传递方式称为地址传递。 提示 使用指针可以减少全局变量的使用，使得程序更加模块化。比如，将全局变量改为函数内部的局部变量，当需要调用其他函数修改变量值时，可以利用地址传递的方式。 除了利用地址传递外，我们还可以利用引用传递在调用函数时修改实际参数的值： Sub fun(ByRef a As Long) a = a + 1 End Sub Sub 游戏执行过程(hWndForm As hWnd) Dim x As Long = 1 Print x fun(x) Print x End Sub 程序运行后输出： 1 2 Sub fun(ByRef a As Long)中的 ByRef 表示引用传递，a相当于是实际参数x的一个别名，在fun()函数中修改a的值，游戏执行过程()函数中实际参数x的值也随之变化。 -
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所示。 本章首先讲解了如何实现随机颜色方块的表示与绘制，鼠标点击与十字消除算法；然后讲解了如何绘制提示框和倒计时进度条；接着讲解了如何开发得分计算、胜负判断、多关卡功能；接下来介绍了地址与指针的概念，并讲解了如何利用地址传递使得程序更加模块化；最后介绍了指针和数组的知识，应用动态数组讲解了如何实现游戏尺寸的动态大小调整。