编程高手之路—vb入门和游戏编写—VB贪吃蛇单人版游戏(四)刷新蛇身坐标，更新地图网格属性以及画面'参数：蛇头的新坐标_X，蛇头的新坐标_Y，是否增加蛇身长度（T＝增加）PrivateSubRefreshSnake(NewHead_XAsInteger,NewHead_YAsInteger,blnAddLengthAsBoolean)DimiAsIntegerDimOldTailAsthePosition'用于在更新蛇身坐标之前，保存原来的蛇尾坐标OldTail=Snake_P1(UBound(Snake_P1))'保存旧的蛇尾坐标picDisplay.Line(Snake_P1(0).X*MAP_SCALE,Snake_P1(0).Y*MAP_SCALE)-Step(MAP_SCALE,MAP_SCALE),P1.BodyColor,BF'在地图上擦除旧的的蛇头picDisplay.Line(NewHead_X*MAP_SCALE,NewHead_Y*MAP_SCALE)-Step(MAP_SCALE,MAP_SCALE),P1.HeadColor,BF'在地图上绘画出新的蛇头MapProperty(NewHead_X,NewHead_Y)=MAP_SNAKE'标记蛇头新坐标下的地图格属性为玩家蛇身'必须先更新蛇身除蛇头外其余部分的坐标。否则会出错Fori=(UBound(Snake_P1))To1Step-1Snake_P1(i)=Snake_P1(i-1)Next'然后更新蛇头的坐标Snake_P1(0).X=NewHead_XSnake_P1(0).Y=NewHead_Y'判断是否需要增加蛇身长度IfblnAddLengthThen'增加长度ReDimPreserveSnake_P1(UBound(Snake_P1)+1)'最后才设定新的蛇尾坐标（关键字“Preserve”的作用是：保留原数组的内容）Snake_P1(UBound(Snake_P1))=OldTail'旧蛇尾的坐标不变P1.SnakeLength=UBound(Snake_P1)+1'蛇身长度+1Else'蛇身长度不变'如果蛇头的新坐标与旧蛇尾的坐标重合，就不用在旧蛇尾的坐标下绘画空白地的图案（因为该网格属性已经是蛇头，而不是空白地）IfNot(NewHead_X=OldTail.XAndNewHead_Y=OldTail.Y)ThenMapProperty(OldTail.X,OldTail.Y)=MAP_EMPTY'在地图上把旧蛇尾坐标下的地图格的属性设置为空白地picDisplay.Line(OldTail.X*MAP_SCALE,OldTail.Y*MAP_SCALE)-Step(MAP_SCALE,MAP_SCALE),Map_Empty_Color,BF'在地图上擦除旧蛇尾，绘画空白地EndIfEndIftmrMove.Enabled=TrueEndSub'检查得分能否上榜－－如果能上榜，则更新排行榜PublicSubCheckRecord(ScoreAsInteger)DimFileNumAsIntegerDimposAsInteger,iAsInteger,listAsListBox'pos--排名DimNameAsString'记录玩家名称DimTopTenAsBoolean'判断得分是否进入前十名DimAnsAsIntegerFileNum=FreeFileSetlist=frmScoreList.lstScore'映射到列表框frmScoreList.lstscoreDoIfScore>=Val(list.list(pos))ThenTopTen=TrueDo'循环，设置玩家玩家名称Name=InputBox("你的得分是第"&pos+1&"名"&vbCrLf&"请输入你的名称(不超过15个字符)","进入前10名！")IfLen(Name)=0ThenMsgBox"你取消了Top10得分登记",vbInformationExitSubEndIfIfLen(RTrim(Name))>15ThenAns=MsgBox("玩家名称的长度不能超过15个字符！"&vbCrLf&"你输入的“"&Name&"”"&"将自动改为“"&Left(Name,15)&"”"&"是否同意？",vbQuestionOrvbYesNo,"输入玩家名称")IfAns=vbYesThenName=Left(Name,15)EndIfLoopUntilLen(RTrim(Name))<=15AndLen(RTrim(Name))>0'直到玩家名称的长度符合规定，才退出循环EndIfpos=pos+1LoopUntilpos=10OrTopTen=TrueIfTopTen=TrueThenlist.AddItemScore,pos-1frmScoreList.lstName.AddItemName,pos-1Iflist.ListCount>10Thenlist.RemoveItemlist.ListCount-1IffrmScoreList.lstName.ListCount>10ThenfrmScoreList.lstName.RemoveItemfrmScoreList.lstName.ListCount-1CallPutRecord'刷新记录文件的内容EndIfEndSub'往文件里写入得分记录PrivateSubPutRecord()DimFileNumAsInteger,iAsIntegerFileNum=FreeFileOpenApp.Path&RECORD_FILE_NAMEForRandomAs#FileNumLen=Len(Record(0))Fori=0To9Record(i).Score=Val(frmScoreList.lstScore.list(i))Record(i).Name=frmScoreList.lstName.list(i)Put#FileNum,,Record(i)NextClose#FileNumEndSub'不断减少奖励的分数PrivateSubtmrPrize_Timer()DimtempColorAsLongPrizeRemain=PrizeRemain-1IfPrizeRemain=0ThenCallShowPrize(False)'当奖励的分数减少到零，就擦除奖品ExitSubEndIftempColor=Int(Rnd()*(FULL_COLOR+1))'产生随机颜色picDisplay.Line(PrizePos.X*MAP_SCALE,PrizePos.Y*M...