技术宅的结界

 找回密码
 立即注册→加入我们

QQ登录

只需一步,快速开始

搜索
热搜: 下载 VB C 实现 编写
查看: 286|回复: 1
收起左侧

【VFB】平台接力游戏

[复制链接]

47

主题

68

帖子

594

积分

用户组: 大·技术宅

UID
3260
精华
7
威望
12 点
宅币
466 个
贡献
1 次
宅之契约
0 份
在线时间
19 小时
注册时间
2017-12-26
发表于 2018-3-9 14:16:03 | 显示全部楼层 |阅读模式

欢迎访问技术宅的结界,请注册或者登录吧。

您需要 登录 才可以下载或查看,没有帐号?立即注册→加入我们

x

1520575826668257.jpg

一个VFB写的小游戏,

鼠标左键给小球撘桥,按下时间越长,这小桥越长。

游戏失败,点右键,重新开始。


源码下载:Basic语言编程群 78458582 进QQ群后,在群共享里下载。




[Visual Basic] 纯文本查看 复制代码
#define Yes                   1
#define No                      0

' COLORS
#define colPlatForm         RGB(50,50,50)
#define colPlatFormTop         RGB(250,200,0)
#define colWater            RGB(100,100,200)
#define colWaterTop          RGB(255,255,255)
#define colSky            RGB(180,200,250)
#define colStick            colPlatFormTop   'RGB(0,0,250)
#define colPlayerCircle         RGB(250,50,150)
#define colPlayerCircleBorder RGB(250,250,250)

' MOUSE BUTTOMS
#define LeftButton             1
#define RightButton             2

' PLATFORM, WATER, ETC POSITIONS AND DIMENSIONS
#define PlatformHeight         200
#define PlatformTop             480 - 200      ' Y-Screen Coordinte
#define PlatformBottom          480            ' Y-Screen Coordinte
#define FirstPlatformLeft      0                ' 50  ' correction required
#define WaterTop               480 - 30         ' Y-Screen Coordinte
#define UnitWidth             30
#define StickThickness         5               ' = platform decoration height
#define MaxStickLength         8 * UnitWidth

' STATES OF THE STICK
#define NoStick               0
#define VerticalStick         1
#define HorizontalStick         2
#define TurningStick            3
#define CircleRadius            10

#define AsciiLine               "========================================="
#define GameInfo               "    PLATFORM WALKER (c) De'Nivra 2015    "
#define GameMoreInfo            "    A Short Game Written In FreeBasic    " 
#define SayPressMouse         "     Press Mouse Left Button To Play     "
#define PlayInstruction         "  Use Mouse Left Button to Play the game "
#define FullScreenInst         "   Press Alt+F4 to play in full screen   "
#define GameLostMessage       "================  GAMELOST  =============="
#define PlayAgainInst         "Press Mouse Right Button To Play New Game"

Type SpacerInfo                 ' for platform width and for gap between platforms
   StartX                      As Integer
   EndX                         As Integer
End Type

Type PlayerInfo
   X                            As Integer
   Y                            As Integer
   ShouldFall                  As Integer
End Type

Type StickInfo
   X                            As Integer
   Y                            As Integer
   Thickness                  As Integer
   Length                     As Integer
   PerfectLength               As Integer
   State                        As Integer
End Type

Dim Shared As SpacerInfo       Platform1, Gap, Platform2, newGap, newPlatform
Dim Shared As PlayerInfo       Player
Dim Shared As Integer          WalkLength, MinWalkLength, MaxWalkLength, FallHeight
Dim Shared As StickInfo         Stick
Dim Shared As Integer          mx,my,mb ' mouse variables
Dim Shared As Integer          BackScreen
Dim Shared As Integer          PlatformsCrossed = -1
Dim Shared As Integer         NextReward ' Points added if player croses platform
Dim Shared As Integer          Score = 0

Function FF_WINMAIN( ByVal hInstance     As HINSTANCE, _
                     ByVal hPrevInstance As HINSTANCE, _
                     ByRef lpCmdLine     As String, _  
                     ByVal iCmdShow      As Long ) As Long


Screen 18,24,2


'Dim Shared As Integer         PreviousBestScore = 0 ' in current game session


'    LET THE FUN BEGIN
   
   RenderSkyAndWater
   Draw String (160,160) , GameInfo
   Draw String (160,180) , GameMoreInfo
   Draw String (160,200) , AsciiLine
   Draw String (160,240) , PlayInstruction
   Draw String (160,260) , FullScreenInst
   Draw String (160,280) , SayPressMouse
   While mb <> LeftButton: GetMouse mx,my,,mb : Wend 
   Sleep 500

   Randomize ,1                ' SEED ... METHOD USING C'S RAND()
   StartNewGame

Do   ' GAME LOOP

   GetMouse mx,my,,mb

   If mb = LeftButton Then

      DoGrowStickAnimation      ' Stick lengthincreases as long as mouse button is pressed
      DoStickTurnAnimation      ' Turn Stick from vertical to horizontal
      ShowStickBridge         ' The Horizontal Stick acts like a bridge
      DoPlayerWalkAnimation   ' Player Walks on Stick Bridge

      ' CHECK WHETHER CURRENT GAME ENDS OR CONTINUES   
         
      Player.ShouldFall = DoPlayerFallCheck()
      
      If Player.ShouldFall = Yes Then
         
         DoPlayerFallAnimation
         ' WAIT FOR USER TO PRESS RIGHT BUTTON
         While mb <> RightButton: GetMouse mx,my,,mb : Wend
         StartNewGame

      Else
         
         ' IF PLAYER DID NOT FALL
         PlatformsCrossed = PlatformsCrossed + 1
         Score = Score + NextReward*10
         NextPlatformSequence
         
      EndIf

      '   REMOVE STICK AND START AGAIN
      Stick.State = NoStick
      
   EndIf
   Sleep 10

Loop Until Len(Inkey)
   Function = True    '如果你想让程序结束,则函数返回 TRUE 。
 
End Function

Sub RenderStick

   Select Case Stick.State
      Case NoStick: ' draw nothing
      Case VerticalStick: Line (Stick.X,Stick.Y)-Step(StickThickness,-Stick.Length),colStick,BF
      Case HorizontalStick: Line (Stick.X,Stick.Y)-Step(Stick.Length,-StickThickness),colStick,BF
   End Select

End Sub
Sub RenderPlayer

   Circle (Player.X,Player.Y), CircleRadius,colPlayerCircleBorder ,,,,F
   Circle (Player.X,Player.Y), CircleRadius-2, colPlayerCircle   ,,,,f

End Sub

Sub RenderPlatform

   ' Platform 1
   Line (Platform1.StartX,PlatformTop)-(Platform1.EndX,PlatformBottom),colPlatForm,BF ' platform
   Line (Platform1.StartX,PlatformTop)-(Platform1.EndX,PlatformTop-StickThickness),colPlatFormTop,BF   ' platform top

   ' Platform 2
   Line (Platform2.StartX,PlatformTop)-(Platform2.EndX,PlatformBottom),colPlatForm,BF ' platform
   Line (Platform2.StartX,PlatformTop)-(Platform2.EndX,PlatformTop-StickThickness),colPlatFormTop,BF   ' platform top

End Sub
Sub RenderSkyAndWater
   
   Line(0,0)-(640,480),colSky,BF                  ' sky
   Line (0,WaterTop)-(640,480),colWater,BF      ' water
   Line (0,WaterTop)-(640,WaterTop),colWaterTop ' water top

   ShowStatusBar 'temp

End Sub

Function GetRandomWidth As Integer
   
   #define Smallest 1
   #define Largest  4
   Return Smallest + Rnd * (Largest - Smallest)
   
End Function

Sub NextPlatformSequence

   Sleep 1000   'pause for some time

   ' CREAT NEXT PLATFORM (temporary)
   newGap.StartX = Platform2.EndX + 1
   newGap.EndX = newGap.StartX + UnitWidth *GetRandomWidth
   newPlatform.StartX = newGap.EndX + 1
   newPlatform.EndX = newPlatform.StartX  + UnitWidth *GetRandomWidth

   ' DISPLAY NEW PLATFORM
   ScreenSet BackScreen, BackScreen Xor 1
   Line (newPlatform.StartX,PlatformTop)-(newPlatform.EndX,PlatformBottom),colPlatForm,BF ' platform
   Line (newPlatform.StartX,PlatformTop)-(newPlatform.EndX,PlatformTop-StickThickness),colPlatFormTop,BF   ' platform top
   BackScreen = BackScreen Xor 1
   Flip
   Sleep 1000   'PAUSE FOR SOME TIME ... SO THAT USER SEES NEW PLATFORM
   '--------------

   ' SCROLL SCREEN LEFT
   Dim imgtemp As Any Pointer
   imgtemp = ImageCreate (640,480-100)
   Get (0,100)-(639,479), imgtemp
   
   Dim As Integer offset
   Offset = 10
   
   While Platform2.StartX > offset + 10

      Offset = Offset + 4
      
       ' ... PROBLEM HERE: NON SMOOTH SCROLLING ... JITTERY
      ScreenSet BackScreen, BackScreen Xor 1
      Put (-offset,100), imgtemp,PSet
      BackScreen = BackScreen Xor 1
      Flip
      Sleep 17

   Wend
   
   '------------------------------------
   ' UPDATE TO NEW PLATFORMS  ... the temporary platform is then not required
   Platform1.StartX = FirstPlatformLeft
   Platform1.EndX = Platform2.EndX - Platform2.StartX ' move ahead ... second platform becomes first platform
   gap.StartX = Platform1.EndX + 1 ' gap between platforms
   gap.EndX = gap.StartX + newGap.EndX - newGap.StartX
   Platform2.StartX = gap.EndX + 1
   Platform2.EndX = Platform2.StartX  + newPlatform.EndX - newPlatform.StartX
   Player.X = Platform1.EndX- StickThickness - CircleRadius
   Player.Y = PlatformTop-CircleRadius-StickThickness
   Stick.X = Platform1.EndX- StickThickness
   Stick.Y = PlatformTop
   Stick.Length = 0
   NextReward = (5- (Platform2.EndX-Platform2.StartX)/UnitWidth)*1 ' shorter gap more score

   '------------------------------------
   ' RENDER NEW PLATFORMS
   ScreenSet BackScreen, BackScreen Xor 1
   RenderSkyAndWater
   RenderPlatform
   RenderPlayer
   BackScreen = BackScreen Xor 1
   Flip
   Sleep 1000

End Sub

Sub StartNewGame

   ' INITIALISE 2 PLATFORMS WITH GAP

   Platform1.StartX = FirstPlatformLeft
   Platform1.EndX = Platform1.StartX + UnitWidth * GetRandomWidth

   gap.StartX = Platform1.EndX + 1 ' gap between platforms
   gap.EndX = gap.StartX + UnitWidth *GetRandomWidth

   Platform2.StartX = gap.EndX + 1
   Platform2.EndX = Platform2.StartX  + UnitWidth *GetRandomWidth

   Player.X = Platform1.EndX- StickThickness - CircleRadius
   Player.Y = PlatformTop-CircleRadius-StickThickness

   Stick.X = Platform1.EndX- StickThickness
   Stick.Y = PlatformTop
   Stick.Length = 0

   NextReward = (5- (Platform2.EndX-Platform2.StartX)/UnitWidth)*1 ' shorter gap more score
   PlatformsCrossed = 0
   Score = 0

   ScreenSet BackScreen, BackScreen Xor 1
   RenderSkyAndWater
   RenderPlatform
   RenderPlayer
   BackScreen = BackScreen Xor 1
   Flip
   Sleep 1000

End Sub


Sub ShowStatusBar

   Draw String (10,25) , "PLATFORM: " & PlatformsCrossed +1
   Draw String (280,25) , "SCORE: " & Score
   Draw String (500,25) , "NEXT REWARD: " & NextReward * 10

End Sub

Sub ThickLine(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, Thickness As Integer, LineColor As Long)

   Dim Slope As Single
   Dim As Integer xDelta = x2-x1, yDelta = y2-y1

   If xDelta = 0 And yDelta = 0 Then
      Circle (x1, y1), Thickness, LineColor, , , , f
      Exit Sub
   EndIf

   If Abs(xDelta) >= Abs(yDelta) Then
      Slope  = yDelta / xDelta
      For I As Integer = x1 To x2 Step Sgn(xDelta)
         Circle (I, Slope * (I - x1) + y1), Thickness, LineColor, , , , f
      Next
   Else
      Slope = xDelta / yDelta
      For I As Integer = y1 To y2 Step Sgn(yDelta)
         Circle (Slope * (I - y1) + x1, I), Thickness, LineColor, , , , f
      Next
   End If

End Sub

Sub DoStickTurnAnimation

   #define Pi             4 * Atn(1)
   #define NintyDegree    Pi/2
   #define TenDegree    NintyDegree/9

   Dim Angle As Single
   For Angle = NintyDegree To 0 Step -TenDegree
      ScreenSet BackScreen, BackScreen Xor 1
      RenderSkyAndWater
      RenderPlatform
      ThickLine Stick.X,Stick.Y, _
      Stick.X+Stick.Length * Cos(Angle), Stick.Y-Stick.Length * Sin(Angle), _
      StickThickness/2,colStick
      RenderPlayer
      BackScreen = BackScreen Xor 1
      Flip
      Sleep 10
   Next

End Sub

Sub DoPlayerWalkAnimation

   WalkLength = Platform2.EndX - Platform1.EndX ' default

   If Stick.Length < gap.EndX - gap.StartX Then WalkLength = Stick.Length
   If Stick.Length > Platform2.EndX - gap.StartX Then WalkLength = Stick.Length

   While (WalkLength > 0 )
      WalkLength = WalkLength - 5
      Player.X = Player.X + 5
      ' Render
      ScreenSet BackScreen, BackScreen Xor 1
      RenderSkyAndWater
      RenderPlatform
      RenderPlayer
      RenderStick
      BackScreen = BackScreen Xor 1
      Flip
      Sleep 10
   Wend

End Sub

Sub ShowStickBridge

   Stick.State = HorizontalStick      ' After Turn, the stick becomes horizontal

   ScreenSet BackScreen, BackScreen Xor 1
   RenderSkyAndWater
   RenderPlatform
   RenderPlayer
   RenderStick
   BackScreen = BackScreen Xor 1
   Flip
   Sleep 10

End Sub

Sub DoGrowStickAnimation

   Stick.State = VerticalStick
   While mb = LeftButton   'Increase Stick and Draw
      GetMouse mx,my,,mb ' check mouse again
      Stick.Length = Stick.Length+5
      If Stick.Length > MaxStickLength Then  Stick.Length = MaxStickLength
      ' Render
      ScreenSet BackScreen, BackScreen Xor 1
      RenderSkyAndWater
      RenderPlatform
      RenderPlayer
      RenderStick
      BackScreen = BackScreen Xor 1
      Flip
      Sleep 10
   Wend

End Sub

Sub DoPlayerFallAnimation

   FallHeight = 200
   Player.X = Player.X + 10

   While (FallHeight > 0 )
      FallHeight = FallHeight - 5
      Player.Y = Player.Y + 5
      ' Render
      ScreenSet BackScreen, BackScreen Xor 1
      RenderSkyAndWater
      RenderPlatform
      RenderPlayer
      RenderStick
      Draw String (160,160) , GameLostMessage
      Draw String (160,200) , PlayAgainInst
      BackScreen = BackScreen Xor 1
      Flip
      Sleep 10
   Wend

End Sub

Function DoPlayerFallCheck As Integer

   MinWalkLength = gap.EndX- gap.StartX
   MaxWalkLength = Platform2.EndX- gap.StartX

   If Stick.Length < MinWalkLength Then Return Yes
   If Stick.Length > MaxWalkLength Then Return Yes
   Return No

End Function

0

主题

2

帖子

11

积分

用户组: 初·技术宅

UID
3554
精华
0
威望
0 点
宅币
9 个
贡献
0 次
宅之契约
0 份
在线时间
0 小时
注册时间
2018-3-11
发表于 2018-3-11 15:18:55 | 显示全部楼层
66666666666

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|技术宅的结界 ( 滇ICP备16008837号|网站地图

GMT+8, 2018-10-19 11:44 , Processed in 0.100170 second(s), 40 queries , Gzip On.

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表