一个VFB写的小游戏，
鼠标左键给小球撘桥，按下时间越长，这小桥越长。
游戏失败，点右键，重新开始。
源码下载：Basic语言编程群 78458582 进QQ群后，在群共享里下载。
#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