YSO小游戏·VB6版代码

Form1：

tmrFPS	Inteval = 1000 Enable = False
tmrAudio	Inteval = 100 Enable = False
tmrLine	Inteval = 10000 Enable = False
Form1	ScaleMode = 3 BorderStyle = 1 MaxButton = False Width = 12900 Height = 94890

Form1代码：

Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'----------- Image -------------------------------------------------------
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdcDest As Long, ByVal xDest As Long, ByVal yDest As Long, ByVal WidthDest As Long, ByVal HeightDest As Long, ByVal hdcSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long, ByVal Blendfunc As Long) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const LR_CREATEDIBSECTION As Long = &H2000
Private Const LR_DEFAULTSIZE As Long = &H40
Private Const LR_LOADFROMFILE As Long = &H10
Private Const IMAGE_BITMAP = 0
Private Const AC_SRC_OVER = &H0
Private Const AC_SRC_ALPHA = &H1
Private Const SRCCOPY = &HCC0020
Private YunikaDC(0 To 2, 1 To 8, 1 To 11) As Long
Private hYunikaBitmap(0 To 2, 1 To 8, 1 To 11) As Long   'state,direction,num
'Stage1---------------------------------------
Private hDCTitle As Long
Private hTitle As Long
Private Choice As Long
Private hDCTitleChoice(1 To 3) As Long
Private hTitleChoice(1 To 3) As Long
'---------------------------------------------
'Stage5
Private hDCStage As Long
Private hStage As Long
Private hDCShadow As Long
Private hShadow As Long
'Stage 7 --------------------------
Private hDCCapture As Long
Private hCapture As Long
Private hDCGameOverAgain As Long
Private hGameOverAgain As Long
Private hDCGameOverBack As Long
Private hGameOverBack As Long
Private hDCGameOverGameOver As Long
Private hGameOverGameOver As Long
'Stage Control----------------------------------
Private bEnterStage5 As Boolean
Private bExitStage5 As Boolean 'Enter Stage6
Private bExitStage6 As Boolean
'Direction System-------------------------------------------------------
Private bRunning As Boolean 'Position Changing state
Private bJumping As Boolean 'Position Changing state
Private bAlreadyJumping As Boolean
Private Direction As Long
Private ActionState As Long 'Running or Jumping or Walking (Picture State)
Public ActionNum As Long '8 or 11
Private ActionNumCount(0 To 2) As Long
Private bLeft As Boolean
Private bUp As Boolean
Private bRight As Boolean
Private bDown As Boolean
'Jump System -----------------------------------------------------------
Private H As Single 'pixel
Private T As Single 'seconds
Private g As Single 'pixel/s^2
Private v0 As Single 'pixel/s
Private dt As Single
Private dY As Single
'Present Direction
Private LeftRight As Long 'for <Left> after <Right>
Private UpDown As Long
Private KeyCount4 As Long
Private Enum Directions
eRight = 1
eRightUp = 2
eUp = 3
eLeftUp = 4
eLeft = 5
eLeftDown = 6
eDown = 7
eRightDown = 8
End Enum
Private Enum Key
LeftUp = -1
None = 0
RightDown = 1
End Enum
Private Enum State
Standing = 0
Running = 1
Jumping = 2
End Enum
'Line System -------------------------------------------------------------
'ax + by + c
Private LineA() As Single
Private LineB() As Single
Private LineC() As Single
Private LineC0() As Single
Private LineType() As Long
Private LineSpeed() As Single
Private SpeedSign() As Long '-1 or 1
Private LineX1o() As Single
Private LineY1o() As Single
Private LineX2o() As Single
Private LineY2o() As Single
Private LineX1n() As Single
Private LineY1n() As Single
Private LineX2n() As Single
Private LineY2n() As Single
Private tLinePass() As Single
Private bLinePass() As Boolean
Private bLineBeforeYunika() As Boolean
Private LinePassCount As Long
Private LineCount(1 To 2) As Long
Private LineSpeedMax(1 To 4) As Single
Private LPS As Long
Private blsAlreadyStart As Boolean
Private tPos() As Single
Private tLine As Single
Private tLine1 As Single
Private tLine2 As Single
Private Enum Lines
Horizontal = 1
Vertical = 2
UpwardDiagonal = 3
DownwardDiagonal = 4
End Enum
'Other variables---------------------------------------------------------
Private Stage As Long '
Private ResFolder As String
Private CounterThisSecond As Long
Private FPS As Long
Private bAlreadyStart As Boolean
Private bExit As Boolean
Private DebugStart As Boolean
Private SleepDelay As Long 'ms
Private cAS As AudioSystem
Private XO As Single, YO As Single
Private XN As Single, YN As Single
Private XR As Single, YR As Single
Private XL As Single, YL As Single
'------------------------------ Key System -------------------------------
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'Exit ?
If KeyCode = 123 Then
bExit = True
Exit Sub
End If
If Stage = 2 Then
If KeyCode = 38 Then 'Up
Choice = Choice - 1
If Choice = 0 Then Choice = 3
BitBlt Me.hdc, 310, 430, 210, 100, hDCTitleChoice(Choice), 0, 0, SRCCOPY
Form1.Refresh
ElseIf KeyCode = 40 Then
Choice = Choice + 1
If Choice = 4 Then Choice = 1
BitBlt Me.hdc, 310, 430, 210, 100, hDCTitleChoice(Choice), 0, 0, SRCCOPY
Form1.Refresh
ElseIf KeyCode = 13 Or KeyCode = 90 Then 'Enter or Z
If Choice = 3 Then 'Exit
bExit = True
ElseIf Choice = 2 Then 'Instructin
'....
MsgBox "这里还没想好该怎么做。" & vbCrLf & vbCrLf & "X: 跳跃" & vbCrLf & "Z 或 Enter: 确认" & vbCrLf & "F12: 退出", vbOKOnly + vbInformation, "嗨，老兄！"
ElseIf Choice = 1 Then 'Start Game
bEnterStage5 = True
End If
End If
Beep
'MsgBox KeyCode
ElseIf Stage = 5 Then
If KeyCode = 88 Then
bJumping = True
ActionState = State.Jumping
Else
dsKeyDown (KeyCode)
End If
ElseIf Stage = 6 Then
If KeyCode = 38 Or KeyCode = 40 Then
If Choice = 1 Then
Choice = 2
BitBlt Me.hdc, 250, 400, 300, 170, hDCCapture, 250, 400, SRCCOPY
AlphaBlend Me.hdc, 250, 400, 300, 170, hDCGameOverBack, 0, 0, 300, 170, MakeBlendFunction(AC_SRC_OVER, 0, 255, AC_SRC_ALPHA)
Form1.Refresh
Else
Choice = 1
BitBlt Me.hdc, 250, 400, 300, 170, hDCCapture, 250, 400, SRCCOPY
AlphaBlend Me.hdc, 250, 400, 300, 170, hDCGameOverAgain, 0, 0, 300, 170, MakeBlendFunction(AC_SRC_OVER, 0, 255, AC_SRC_ALPHA)
Form1.Refresh
End If
ElseIf KeyCode = 13 Or KeyCode = 90 Then
If Choice = 1 Then 'Again
bExitStage6 = True
bEnterStage5 = True
ElseIf Choice = 2 Then
bExitStage6 = True
bEnterStage5 = False
End If
End If
End If
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If Stage = 5 Then
dsKeyUp (KeyCode)
End If
End Sub
'------------------------------ Initialize --------------------------------
Private Sub form_load()
bExit = False
ResFolder = App.Path
If Right(ResFolder, 1) <> "/" Then ResFolder = ResFolder & "/"
ResFolder = ResFolder & "res/"
Set cAS = New AudioSystem
Call cAS.BuildString(ResFolder)
ActionNumCount(0) = 8
ActionNumCount(1) = 8
ActionNumCount(2) = 11
End Sub
Private Sub Form_Resize()
If bAlreadyStart = False Then
bAlreadyStart = True
Call ShowStage1
End If
cAS.StopIt
Call Form_Unload(False)
End
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim n As Long, m As Long
DeleteDC hDCTitle
DeleteDC hDCTitleChoice(1)
DeleteDC hDCTitleChoice(2)
DeleteDC hDCTitleChoice(3)
DeleteObject hTitle
DeleteObject hTitleChoice(1)
DeleteObject hTitleChoice(2)
DeleteObject hTitleChoice(3)
DeleteDC hDCStage
DeleteObject hStage
DeleteDC hDCShadow
DeleteObject hShadow
DeleteDC hDCGameOverAgain
DeleteDC hDCGameOverBack
DeleteDC hDCGameOverGameOver
DeleteDC hDCCapture
DeleteObject hGameOverAgain
DeleteObject hGameOverAgain
DeleteObject hGameOverGameOver
DeleteObject hCapture
For n = 1 To 8
For m = 1 To 8
DeleteDC YunikaDC(State.Running, n, m)
DeleteObject hYunikaBitmap(State.Running, n, m)
Next
Next
For n = 1 To 8
For m = 1 To 11
DeleteDC YunikaDC(State.Jumping, n, m)
DeleteObject hYunikaBitmap(State.Jumping, n, m)
Next
Next
For n = 1 To 8
For m = 1 To 8
DeleteDC YunikaDC(State.Standing, n, m)
DeleteObject hYunikaBitmap(State.Standing, n, m)
Next
Next
End Sub
'----------------------------- Audio System ------------------------------
Private Sub tmrAudio_Timer()
Dim S As String
S = Space(256)
mciSendString "status MEDIA mode", S, Len(S), 0
If Left(S, 7) = "stopped" Or Left(S, 2) = "停止" Then
cAS.PlaySong (cAS.sCurrent)
End If
End Sub
'---------------------------- Image --------------------------------------
Private Function MakeBlendFunction(ByVal blendOp As Long, ByVal blendFlags As Long, ByVal SourceConstantAlpha As Long, ByVal alphaFormat As Long) As Long
MakeBlendFunction = (blendOp And &HFF&) Or _
((blendFlags And &HFF&) * &H100&) Or _
((SourceConstantAlpha And &HFF&) * &H10000) Or _
((alphaFormat And &H7F&) * &H1000000)
If alphaFormat And &H80& Then MakeBlendFunction = MakeBlendFunction Or &H80000000
End Function
Private Sub LoadBitmap(hdc As Long, n As Long, m As Long, ActionState As String, lActionState As Long)
hYunikaBitmap(lActionState, n, m) = LoadImage(App.hInstance, ResFolder & ActionState & "_" & n & "_" & m & ".bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_DEFAULTSIZE Or LR_CREATEDIBSECTION)
SelectObject hdc, hYunikaBitmap(lActionState, n, m)
End Sub
'Direction System *************************************************************
Public Sub dsKeyDown(KeyCode As Integer)
'37 38 39 40 88 =Left Up Right Down X
If KeyCode >= 37 And KeyCode <= 40 And bJumping = False Then ActionState = State.Running
Select Case KeyCode
Case 37
bRunning = True
If bLeft = True Then Exit Sub
bLeft = True
LeftRight = Key.LeftUp
If bUp = False And bDown = False Then UpDown = Key.None
Case 38
bRunning = True
If bUp = True Then Exit Sub
bUp = True
UpDown = Key.LeftUp
If bLeft = False And bRight = False Then LeftRight = Key.None
Case 39
bRunning = True
If bRight = True Then Exit Sub
bRight = True
LeftRight = Key.RightDown
If bUp = False And bDown = False Then UpDown = Key.None
Case 40
bRunning = True
If bDown = True Then Exit Sub
bDown = True
UpDown = Key.RightDown
If bLeft = False And bRight = False Then LeftRight = Key.None
Case 88
End Select
Call dsCount4Key
If KeyCount4 > 1 Then
If KeyCount4 = 2 And bLeft = True And bRight = True Then
If LeftRight = Key.LeftUp Then
Direction = Directions.eLeft
Else
Direction = Directions.eRight
End If
ElseIf KeyCount4 = 2 And bUp = True And bDown = True Then
If UpDown = Key.LeftUp Then
Direction = Directions.eUp
Else
Direction = Directions.eDown
End If
Else
If LeftRight = Key.LeftUp And UpDown = Key.LeftUp Then
Direction = Directions.eLeftUp
ElseIf LeftRight = Key.RightDown And UpDown = Key.LeftUp Then
Direction = Directions.eRightUp
ElseIf LeftRight = Key.RightDown And UpDown = Key.RightDown Then
Direction = Directions.eRightDown
ElseIf LeftRight = Key.LeftUp And UpDown = Key.RightDown Then
Direction = Directions.eLeftDown
End If
End If
ElseIf KeyCount4 = 1 Then
If LeftRight = Key.LeftUp Then
Direction = Directions.eLeft
ElseIf UpDown = Key.LeftUp Then
Direction = Directions.eUp
ElseIf LeftRight = Key.RightDown Then
Direction = Directions.eRight
ElseIf UpDown = Key.RightDown Then
Direction = Directions.eDown
End If
End If
End Sub
Private Sub dsKeyUp(KeyCode As Integer)
'37 38 39 40 88 =Left Up Right Down X
Select Case KeyCode
Case 37
bLeft = False
If bUp = False And bDown = False Then
If bRight = False Then
LeftRight = Key.LeftUp
Else
LeftRight = Key.RightDown
End If
Else
If bRight = False Then
LeftRight = Key.None
Else
LeftRight = Key.RightDown
End If
End If
Case 38
bUp = False
If bLeft = False And bRight = False Then
If bDown = False Then
UpDown = Key.LeftUp
Else
UpDown = Key.RightDown
End If
Else
If bDown = False Then
UpDown = Key.None
Else
UpDown = Key.RightDown
End If
End If
Case 39
bRight = False
If bUp = False And bDown = False Then
If bLeft = False Then
LeftRight = Key.RightDown
Else
LeftRight = Key.LeftUp
End If
Else
If bLeft = False Then
LeftRight = Key.None
Else
LeftRight = Key.LeftUp
End If
End If
Case 40
bDown = False
If bLeft = False And bRight = False Then
If bUp = False Then
UpDown = Key.RightDown
Else
UpDown = Key.LeftUp
End If
Else
If bUp = False Then
UpDown = Key.None
Else
UpDown = Key.LeftUp
End If
End If
End Select
Call dsCount4Key
If KeyCount4 > 1 Then
bRunning = True
If LeftRight = Key.LeftUp And UpDown = Key.LeftUp Then
Direction = Directions.eLeftUp
ElseIf LeftRight = Key.RightDown And UpDown = Key.LeftUp Then
Direction = Directions.eRightUp
ElseIf LeftRight = Key.RightDown And UpDown = Key.RightDown Then
Direction = Directions.eRightDown
ElseIf LeftRight = Key.LeftUp And UpDown = Key.RightDown Then
Direction = Directions.eLeftDown
End If
ElseIf KeyCount4 = 1 Then
bRunning = True
If LeftRight = Key.LeftUp Then
Direction = Directions.eLeft
ElseIf UpDown = Key.LeftUp Then
Direction = Directions.eUp
ElseIf LeftRight = Key.RightDown Then
Direction = Directions.eRight
ElseIf UpDown = Key.RightDown Then
Direction = Directions.eDown
End If
Else
If bJumping = False Then ActionState = State.Standing
bRunning = False
End If
End Sub
Private Sub dsSettingAfterJump()
Call dsCount4Key
If KeyCount4 > 1 Then
bRunning = True
ActionState = State.Running
If LeftRight = Key.LeftUp And UpDown = Key.LeftUp Then
Direction = Directions.eLeftUp
ElseIf LeftRight = Key.RightDown And UpDown = Key.LeftUp Then
Direction = Directions.eRightUp
ElseIf LeftRight = Key.RightDown And UpDown = Key.RightDown Then
Direction = Directions.eRightDown
ElseIf LeftRight = Key.LeftUp And UpDown = Key.RightDown Then
Direction = Directions.eLeftDown
End If
ElseIf KeyCount4 = 1 Then
bRunning = True
ActionState = State.Running
If LeftRight = Key.LeftUp Then
Direction = Directions.eLeft
ElseIf UpDown = Key.LeftUp Then
Direction = Directions.eUp
ElseIf LeftRight = Key.RightDown Then
Direction = Directions.eRight
ElseIf UpDown = Key.RightDown Then
Direction = Directions.eDown
End If
Else
If bJumping = False Then ActionState = State.Standing
bRunning = False
End If
End Sub
Private Sub dsCount4Key()
Dim a As Long
a = 0
If bLeft = True Then a = a + 1
If bUp = True Then a = a + 1
If bRight = True Then a = a + 1
If bDown = True Then a = a + 1
KeyCount4 = a
End Sub
'Jump System *******************************************************************
Private Sub jsNextJump(dt As Single)
If dt > 2 * T Then
ActionNum = 1
bJumping = False
bAlreadyJumping = False
dY = 0
Call dsSettingAfterJump
Else
dY = v0 * dt - 1 / 2 * g * dt * dt
End If
End Sub
'Move & Matrix System ***********************************************************
Private Sub mmsYunikaMove(dt As Single)
Dim x As Single, y As Single
x = XO
y = YO
Select Case Direction
Case Directions.eRight
x = x + 300 * dt
If x - y > 580 Then y = x - 580
If x + y > 1340 Then y = 1340 - x
If x > 760 Then x = 760
Case Directions.eLeft
x = x - 300 * dt
If x + y < 220 Then y = 220 - x
If y - x > 540 Then y = 540 + x
If x < 30 Then x = 30
Case Directions.eDown
y = y + 300 * dt
If y - x > 540 Then x = y - 540
If x + y > 1340 Then x = 1340 - y
If y > 700 Then y = 700
Case Directions.eUp
y = y - 300 * dt
If x + y < 220 Then x = 220 - y
If x - y > 580 Then x = y + 580
If y < 60 Then y = 60
Case Directions.eLeftDown
x = x - 300 * dt
y = y + 300 * dt
If x < 30 Then x = 30
If y > 700 Then y = 700
If y - x > 540 Then
x = x + 0.5 * (y - x - 540)
y = y - 0.5 * (y - x - 540)
End If
Case Directions.eRightDown
x = x + 300 * dt
y = y + 300 * dt
If x > 760 Then x = 760
If y > 700 Then y = 700
If x + y > 1340 Then
x = x - 0.5 * (x + y - 1340)
y = y - 0.5 * (x + y - 1345)
End If
Case Directions.eLeftUp
x = x - 300 * dt
y = y - 300 * dt
If x < 30 Then x = 30
If y < 60 Then y = 60
If x + y < 220 Then
x = x + 0.5 * (220 - x - y)
y = y + 0.5 * (220 - x - y)
End If
Case Directions.eRightUp
x = x + 300 * dt
y = y - 300 * dt
If y < 60 Then y = 60
If x > 760 Then x = 760
If x - y > 580 Then
x = x - 0.5 * (x - y - 580)
y = y + 0.5 * (x - y - 580)
End If
End Select
XO = x
YO = y
mmsSetPointNow
End Sub
Private Sub mmsSetPointNow()
Dim x As Single, y As Single
Dim X1 As Single, Y1 As Single
Dim X2 As Single, Y2 As Single
'Dim k As Single, rou As Single, rou2 As Single
'k = 0.34
'rou = 0.00225
'rou2 = 1.141
x = XO - 400
y = -YO + 705
y = y / 1.141
Y1 = (Sqr(640000 + 2880 * y) - 800) / 1.8
X1 = x
Y2 = y
X2 = X1 / (Y1 * 0.000811 + 1)
XN = X2 + 352
YN = -Y1 + 372
XR = XN + 48
YR = YN + 88
XL = XR
YL = YR + 5
End Sub
Private Sub mmsSetPointNowByRef(mxo As Single, myo As Single)
Dim x As Single, y As Single
Dim X1 As Single, Y1 As Single
Dim X2 As Single, Y2 As Single
x = mxo - 400
y = -myo + 705
y = y / 1.141
Y1 = (Sqr(640000 + 2880 * y) - 800) / 1.8
X1 = x
Y2 = y
X2 = X1 / (Y1 * 0.000811 + 1)
mxo = X2 + 400
myo = -Y1 + 465
End Sub
'Line System ************************************************************************
Private Sub MoveLine(index1 As Long, index2 As Long, dt As Single)
LineC(index1, index2) = LineC0(index1, index2) - SpeedSign(index1, index2) * LineSpeed(index1, index2) * dt
End Sub
Private Sub SetHorizontalLine(index1 As Long, index2 As Long, yPosition As Single)
'y=yPosition    0x + 1y - yposition = 0
LineA(index1, index2) = 0
LineB(index1, index2) = 1
LineC0(index1, index2) = -yPosition
LineC(index1, index2) = -yPosition
End Sub
Private Sub SetVerticalLine(index1 As Long, index2 As Long, xPosition As Single)
'x=xPosition    x + 0y - xPosition = 0
LineA(index1, index2) = 1
LineB(index1, index2) = 0
LineC0(index1, index2) = -xPosition
LineC(index1, index2) = -xPosition
End Sub
Private Sub SetUpwardDiagonalLine(index1 As Long, index2 As Long, XPY As Single)
LineA(index1, index2) = 1
LineB(index1, index2) = 1
LineC0(index1, index2) = -XPY
LineC(index1, index2) = -XPY
End Sub
Private Sub SetDownwardDiagonalLine(index1 As Long, index2 As Long, XMY As Single)
' x-y = xmy
LineA(index1, index2) = 1
LineB(index1, index2) = -1
LineC0(index1, index2) = -XMY
LineC(index1, index2) = -XMY
End Sub
Private Sub SetLineXYo(index1 As Long, index2 As Long)
Select Case LineType(index1, index2)
Case Lines.Horizontal
Select Case -LineC(index1, index2)
Case Is > 705
LineX1o(index1, index2) = 0
LineY1o(index1, index2) = 0
LineX2o(index1, index2) = 0
LineY2o(index1, index2) = 0
Case Is > 565
LineX1o(index1, index2) = -558 - LineC(index1, index2)
LineY1o(index1, index2) = -LineC(index1, index2)
LineX2o(index1, index2) = 1358 + LineC(index1, index2)
LineY2o(index1, index2) = -LineC(index1, index2)
Case Is > 142
LineX1o(index1, index2) = 7
LineY1o(index1, index2) = -LineC(index1, index2)
LineX2o(index1, index2) = 793
LineY2o(index1, index2) = -LineC(index1, index2)
Case Is > 2
LineX1o(index1, index2) = 149 + LineC(index1, index2)
LineY1o(index1, index2) = -LineC(index1, index2)
LineX2o(index1, index2) = 651 - LineC(index1, index2)
LineY2o(index1, index2) = -LineC(index1, index2)
Case Else
LineX1o(index1, index2) = 0
LineY1o(index1, index2) = 0
LineX2o(index1, index2) = 0
LineY2o(index1, index2) = 0
End Select
Case Lines.Vertical
Select Case -LineC(index1, index2)
Case Is > 793
LineX1o(index1, index2) = 0
LineY1o(index1, index2) = 0
LineX2o(index1, index2) = 0
LineY2o(index1, index2) = 0
Case Is > 653
LineX1o(index1, index2) = -LineC(index1, index2)
LineY1o(index1, index2) = -LineC(index1, index2) - 651
LineX2o(index1, index2) = -LineC(index1, index2)
LineY2o(index1, index2) = LineC(index1, index2) + 1358
Case Is > 147
LineX1o(index1, index2) = -LineC(index1, index2)
LineY1o(index1, index2) = 2
LineX2o(index1, index2) = -LineC(index1, index2)
LineY2o(index1, index2) = 705
Case Is > 7
LineX1o(index1, index2) = -LineC(index1, index2)
LineY1o(index1, index2) = LineC(index1, index2) + 149
LineX2o(index1, index2) = -LineC(index1, index2)
LineY2o(index1, index2) = -LineC(index1, index2) + 558
Case Else
LineX1o(index1, index2) = 0
LineY1o(index1, index2) = 0
LineX2o(index1, index2) = 0
LineY2o(index1, index2) = 0
End Select
Case Lines.UpwardDiagonal
Select Case -LineC(index1, index2)
Case Is < 149
LineX1o(index1, index2) = 0
LineY1o(index1, index2) = 0
LineX2o(index1, index2) = 0
LineY2o(index1, index2) = 0
Case Is < 572
LineX1o(index1, index2) = -2 - LineC(index1, index2)
LineY1o(index1, index2) = 2
LineX2o(index1, index2) = 7
LineY2o(index1, index2) = -7 - LineC(index1, index2)
Case Is < 655
LineX1o(index1, index2) = -2 - LineC(index1, index2)
LineY1o(index1, index2) = 2
LineX2o(index1, index2) = -279 - LineC(index1, index2) / 2
LineY2o(index1, index2) = 279 - LineC(index1, index2) / 2
Case Is < 852
LineX1o(index1, index2) = 325.5 - LineC(index1, index2) / 2
LineY1o(index1, index2) = -325.5 - LineC(index1, index2) / 2
LineX2o(index1, index2) = -279 - LineC(index1, index2) / 2
LineY2o(index1, index2) = 279 - LineC(index1, index2) / 2
Case Is < 935
LineX1o(index1, index2) = 325.5 - LineC(index1, index2) / 2
LineY1o(index1, index2) = -325.5 - LineC(index1, index2) / 2
LineX2o(index1, index2) = -705 - LineC(index1, index2)
LineY2o(index1, index2) = 705
Case Is < 1358
LineX1o(index1, index2) = 793
LineY1o(index1, index2) = -793 - LineC(index1, index2)
LineX2o(index1, index2) = -705 - LineC(index1, index2)
LineY2o(index1, index2) = 705
Case Else
LineX1o(index1, index2) = 0
LineY1o(index1, index2) = 0
LineX2o(index1, index2) = 0
LineY2o(index1, index2) = 0
End Select
Case Lines.DownwardDiagonal
Select Case LineC(index1, index2)
Case Is < -561
LineX1o(index1, index2) = 0
LineY1o(index1, index2) = 0
LineX2o(index1, index2) = 0
LineY2o(index1, index2) = 0
Case Is < -228
LineX1o(index1, index2) = 2 - LineC(index1, index2)
LineY1o(index1, index2) = 2
LineX2o(index1, index2) = 793
LineY2o(index1, index2) = 793 + LineC(index1, index2)
Case Is < -145
LineX1o(index1, index2) = 2 - LineC(index1, index2)
LineY1o(index1, index2) = 2
LineX2o(index1, index2) = 679 - LineC(index1, index2) / 2
LineY2o(index1, index2) = 679 + LineC(index1, index2) / 2
Case Is < 52
LineX1o(index1, index2) = 679 - LineC(index1, index2) / 2
LineY1o(index1, index2) = 679 + LineC(index1, index2) / 2
LineX2o(index1, index2) = 74.5 - LineC(index1, index2) / 2
LineY2o(index1, index2) = 74.5 + LineC(index1, index2) / 2
Case Is < 135
LineX1o(index1, index2) = 74.5 - LineC(index1, index2) / 2
LineY1o(index1, index2) = 74.5 + LineC(index1, index2) / 2
LineX2o(index1, index2) = 705 - LineC(index1, index2)
LineY2o(index1, index2) = 705
Case Is < 558
LineX1o(index1, index2) = 7
LineY1o(index1, index2) = 7 + LineC(index1, index2)
LineX2o(index1, index2) = 705 - LineC(index1, index2)
LineY2o(index1, index2) = 705
Case Else
LineX1o(index1, index2) = 0
LineY1o(index1, index2) = 0
LineX2o(index1, index2) = 0
LineY2o(index1, index2) = 0
End Select
End Select
End Sub
Private Sub tmrLine_Timer()
Call Randomize
Dim k As Long
If blsAlreadyStart = False Then
tLine1 = Timer
LPS = 5
ReDim LineA(1 To 2, 1 To 5) As Single
ReDim LineB(1 To 2, 1 To 5) As Single
ReDim LineC(1 To 2, 1 To 5) As Single
ReDim LineC0(1 To 2, 1 To 5) As Single
ReDim LineType(1 To 2, 1 To 5) As Long
ReDim LineSpeed(1 To 2, 1 To 5) As Single
ReDim SpeedSign(1 To 2, 1 To 5) As Long
ReDim LineX1o(1 To 2, 1 To 5) As Single
ReDim LineY1o(1 To 2, 1 To 5) As Single
ReDim LineX2o(1 To 2, 1 To 5) As Single
ReDim LineY2o(1 To 2, 1 To 5) As Single
ReDim LineX1n(1 To 2, 1 To 5) As Single
ReDim LineY1n(1 To 2, 1 To 5) As Single
ReDim LineX2n(1 To 2, 1 To 5) As Single
ReDim LineY2n(1 To 2, 1 To 5) As Single
ReDim tLinePass(1 To 2, 1 To 5) As Single
ReDim bLinePass(1 To 2, 1 To 5) As Boolean
ReDim bLineBeforeYunika(1 To 2, 1 To 5) As Boolean
LinePassCount = 0
LineCount(1) = 5
LineCount(2) = 0
ReDim tPos(1 To 5) As Single
For k = 1 To 5
tPos(k) = Rnd * 10
LineType(1, k) = Int(Rnd * 3 + 1)
LineSpeedMax(1) = 70.3   'pixel per second
LineSpeedMax(2) = 78.5
LineSpeedMax(3) = 129.8
LineSpeedMax(4) = 129.8
LineSpeed(1, k) = (Rnd * 4 + 1) * LineSpeedMax(LineType(1, k))
SpeedSign(1, k) = IIf(Rnd > 0.5, 1, -1)
bLinePass(1, k) = False
If SpeedSign(1, k) = 1 Then
Select Case LineType(1, k)
Case Lines.Horizontal
SetHorizontalLine 1, k, 2 - LineSpeed(1, k) * tPos(k)
tLinePass(1, k) = Timer + tPos(k) + 705 / LineSpeed(1, k)
Case Lines.Vertical
SetVerticalLine 1, k, 8 - LineSpeed(1, k) * tPos(k)
tLinePass(1, k) = Timer + tPos(k) + 793 / LineSpeed(1, k)
Case Lines.UpwardDiagonal
SetUpwardDiagonalLine 1, k, 148 - LineSpeed(1, k) * tPos(k)
tLinePass(1, k) = Timer + tPos(k) + 1298 / LineSpeed(1, k)
Case Lines.DownwardDiagonal
SetDownwardDiagonalLine 1, k, -558 - LineSpeed(1, k) * tPos(k)
tLinePass(1, k) = Timer + tPos(k) + 1298 / LineSpeed(1, k)
End Select
Else
Select Case LineType(1, k)
Case Lines.Horizontal
SetHorizontalLine 1, k, 705 + LineSpeed(1, k) * tPos(k)
tLinePass(1, k) = Timer + tPos(k) + 705 / LineSpeed(1, k)
Case Lines.Vertical
SetVerticalLine 1, k, 793 + LineSpeed(1, k) * tPos(k)
tLinePass(1, k) = Timer + tPos(k) + 793 / LineSpeed(1, k)
Case Lines.UpwardDiagonal
SetUpwardDiagonalLine 1, k, 1446 + LineSpeed(1, k) * tPos(k)
tLinePass(1, k) = Timer + tPos(k) + 1298 / LineSpeed(1, k)
Case Lines.DownwardDiagonal
SetDownwardDiagonalLine 1, k, 653 + LineSpeed(1, k) * tPos(k)
tLinePass(1, k) = Timer + tPos(k) + 1298 / LineSpeed(1, k)
End Select
End If
Next
blsAlreadyStart = True
Else
tLine2 = tLine1
tLine1 = Timer
LPS = LPS + 1
ReDim Preserve LineA(1 To 2, 1 To LPS) As Single
ReDim Preserve LineB(1 To 2, 1 To LPS) As Single
ReDim Preserve LineC(1 To 2, 1 To LPS) As Single
ReDim Preserve LineC0(1 To 2, 1 To LPS) As Single
ReDim Preserve LineType(1 To 2, 1 To LPS) As Long
ReDim Preserve LineSpeed(1 To 2, 1 To LPS) As Single
ReDim Preserve SpeedSign(1 To 2, 1 To LPS) As Long
ReDim Preserve LineX1o(1 To 2, 1 To LPS) As Single
ReDim Preserve LineY1o(1 To 2, 1 To LPS) As Single
ReDim Preserve LineX2o(1 To 2, 1 To LPS) As Single
ReDim Preserve LineY2o(1 To 2, 1 To LPS) As Single
ReDim Preserve LineX1n(1 To 2, 1 To LPS) As Single
ReDim Preserve LineY1n(1 To 2, 1 To LPS) As Single
ReDim Preserve LineX2n(1 To 2, 1 To LPS) As Single
ReDim Preserve LineY2n(1 To 2, 1 To LPS) As Single
ReDim Preserve tLinePass(1 To 2, 1 To LPS) As Single
ReDim Preserve bLineBeforeYunika(1 To 2, 1 To LPS) As Boolean
ReDim Preserve bLinePass(1 To 2, 1 To LPS) As Boolean
LineCount(1) = LPS
LineCount(2) = LPS - 1
'Copy
Dim i As Long
For i = 1 To LPS - 1
LineA(2, i) = LineA(1, i)
LineB(2, i) = LineB(1, i)
LineC(2, i) = LineC(1, i)
LineC0(2, i) = LineC0(1, i)
LineSpeed(2, i) = LineSpeed(1, i)
SpeedSign(2, i) = SpeedSign(1, i)
LineType(2, i) = LineType(1, i)
tLinePass(2, i) = tLinePass(1, i)
bLinePass(2, i) = bLinePass(1, i)
bLineBeforeYunika(2, i) = bLineBeforeYunika(1, i)
Next
ReDim tPos(1 To LPS) As Single
For k = 1 To LPS
tPos(k) = Rnd * 10
LineType(1, k) = Int(Rnd * 4 + 1)
LineSpeedMax(1) = 70   'pixel per second
LineSpeedMax(2) = 79
LineSpeedMax(3) = 130
LineSpeedMax(4) = 130
LineSpeed(1, k) = (Rnd * 4 + 1) * LineSpeedMax(LineType(1, k))
SpeedSign(1, k) = IIf(Rnd > 0.5, 1, -1)
bLinePass(1, k) = False
If SpeedSign(1, k) = 1 Then
Select Case LineType(1, k)
Case Lines.Horizontal
SetHorizontalLine 1, k, 2 - LineSpeed(1, k) * tPos(k)
tLinePass(1, k) = Timer + tPos(k) + 640 / LineSpeed(1, k)
Case Lines.Vertical
SetVerticalLine 1, k, 8 - LineSpeed(1, k) * tPos(k)
tLinePass(1, k) = Timer + tPos(k) + 730 / LineSpeed(1, k)
Case Lines.UpwardDiagonal
SetUpwardDiagonalLine 1, k, 148 - LineSpeed(1, k) * tPos(k)
tLinePass(1, k) = Timer + tPos(k) + 1120 / LineSpeed(1, k)
Case Lines.DownwardDiagonal
SetDownwardDiagonalLine 1, k, -558 - LineSpeed(1, k) * tPos(k)
tLinePass(1, k) = Timer + tPos(k) + 1120 / LineSpeed(1, k)
End Select
Else
Select Case LineType(1, k)
Case Lines.Horizontal
SetHorizontalLine 1, k, 705 + LineSpeed(1, k) * tPos(k)
tLinePass(1, k) = Timer + tPos(k) + 640 / LineSpeed(1, k)
Case Lines.Vertical
SetVerticalLine 1, k, 793 + LineSpeed(1, k) * tPos(k)
tLinePass(1, k) = Timer + tPos(k) + 730 / LineSpeed(1, k)
Case Lines.UpwardDiagonal
SetUpwardDiagonalLine 1, k, 1446 + LineSpeed(1, k) * tPos(k)
tLinePass(1, k) = Timer + tPos(k) + 1120 / LineSpeed(1, k)
Case Lines.DownwardDiagonal
SetDownwardDiagonalLine 1, k, 653 + LineSpeed(1, k) * tPos(k)
tLinePass(1, k) = Timer + tPos(k) + 1120 / LineSpeed(1, k)
End Select
End If
Next
End If
End Sub
Private Function GetDistance(x As Single, y As Single, index1 As Long, index2 As Long) As Single
Dim a As Single, b As Single, c As Single
a = LineA(index1, index2)
b = LineB(index1, index2)
c = LineC(index1, index2)
GetDistance = Abs(a * x + b * y + c) / Sqr(a * a + b * b)
End Function
'Stage Sub *******************************************************************
Private Sub ShowStage1() 'Load
Stage = 1
Dim n As Long, m As Long
'Stage2 --------------------------------------------
hDCTitle = CreateCompatibleDC(Form1.hdc)
hDCTitleChoice(1) = CreateCompatibleDC(Form1.hdc)
hDCTitleChoice(2) = CreateCompatibleDC(Form1.hdc)
hDCTitleChoice(3) = CreateCompatibleDC(Form1.hdc)
hTitle = LoadImage(App.hInstance, ResFolder & "titlec.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_DEFAULTSIZE Or LR_CREATEDIBSECTION)
hTitleChoice(1) = LoadImage(App.hInstance, ResFolder & "title_1c.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_DEFAULTSIZE Or LR_CREATEDIBSECTION)
hTitleChoice(2) = LoadImage(App.hInstance, ResFolder & "title_2c.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_DEFAULTSIZE Or LR_CREATEDIBSECTION)
hTitleChoice(3) = LoadImage(App.hInstance, ResFolder & "title_3c.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_DEFAULTSIZE Or LR_CREATEDIBSECTION)
SelectObject hDCTitle, hTitle
SelectObject hDCTitleChoice(1), hTitleChoice(1)
SelectObject hDCTitleChoice(2), hTitleChoice(2)
SelectObject hDCTitleChoice(3), hTitleChoice(3)
'Stage5 ---------------------------------------------
hDCStage = CreateCompatibleDC(Form1.hdc)
hStage = LoadImage(App.hInstance, ResFolder & "stage.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_DEFAULTSIZE Or LR_CREATEDIBSECTION)
SelectObject hDCStage, hStage
hDCShadow = CreateCompatibleDC(Form1.hdc)
hShadow = LoadImage(App.hInstance, ResFolder & "shadow2.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_DEFAULTSIZE Or LR_CREATEDIBSECTION)
SelectObject hDCShadow, hShadow
'Stage7 ---------------------------------------------
hDCGameOverAgain = CreateCompatibleDC(Form1.hdc)
hDCGameOverBack = CreateCompatibleDC(Form1.hdc)
hDCGameOverGameOver = CreateCompatibleDC(Form1.hdc)
hDCCapture = CreateCompatibleDC(Form1.hdc)
hGameOverAgain = LoadImage(App.hInstance, ResFolder & "GameOverAgain.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_DEFAULTSIZE Or LR_CREATEDIBSECTION)
hGameOverBack = LoadImage(App.hInstance, ResFolder & "GameOverBack.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_DEFAULTSIZE Or LR_CREATEDIBSECTION)
hGameOverGameOver = LoadImage(App.hInstance, ResFolder & "GameOverGameover.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_DEFAULTSIZE Or LR_CREATEDIBSECTION)
hCapture = CreateCompatibleBitmap(Me.hdc, 800, 600)
SelectObject hDCGameOverAgain, hGameOverAgain
SelectObject hDCGameOverBack, hGameOverBack
SelectObject hDCGameOverGameOver, hGameOverGameOver
SelectObject hDCCapture, hCapture
'Yunika ---------------------------------------------
For n = 1 To 8
For m = 1 To 8
YunikaDC(State.Running, n, m) = CreateCompatibleDC(Form1.hdc)
LoadBitmap YunikaDC(State.Running, n, m), n, m, "Run", State.Running
Next
Next
For n = 1 To 8
For m = 1 To 11
YunikaDC(State.Jumping, n, m) = CreateCompatibleDC(Form1.hdc)
LoadBitmap YunikaDC(State.Jumping, n, m), n, m, "Jump", State.Jumping
Next
Next
For n = 1 To 8
For m = 1 To 8
YunikaDC(State.Standing, n, m) = CreateCompatibleDC(Form1.hdc)
LoadBitmap YunikaDC(State.Standing, n, m), n, m, "Stand", State.Standing
Next
Next
DoEvents
Call ShowStage2
End Sub
Private Function ShowStage2() 'Title
cAS.PlaySong "start"
Form1.Caption = "伊苏·起源·小游戏"
Choice = 1
Dim n As Long, a As Long
For n = 0 To 255
Form1.Line (0, 0)-(800, 600), vbBlack, BF
AlphaBlend Me.hdc, 0, 0, 800, 600, hDCTitle, 0, 0, 800, 600, MakeBlendFunction(AC_SRC_OVER, 0, n, AC_SRC_ALPHA)
AlphaBlend Me.hdc, 310, 430, 210, 100, hDCTitleChoice(1), 0, 0, 210, 100, MakeBlendFunction(AC_SRC_OVER, 0, n, AC_SRC_ALPHA)
Form1.Refresh
DoEvents
Next
Stage = 2
Do
If bExit = True Then Exit Do
If bEnterStage5 = True Then
For n = 255 To 0 Step -1
Form1.Line (0, 0)-(800, 600), vbBlack, BF
AlphaBlend Me.hdc, 0, 0, 800, 600, hDCTitle, 0, 0, 800, 600, MakeBlendFunction(AC_SRC_OVER, 0, n, AC_SRC_ALPHA)
AlphaBlend Me.hdc, 310, 430, 210, 100, hDCTitleChoice(1), 0, 0, 210, 100, MakeBlendFunction(AC_SRC_OVER, 0, n, AC_SRC_ALPHA)
Form1.Refresh
DoEvents
Next
Call ShowStage5
End If
DoEvents
Sleep (30)
Loop
End Function
Private Function ShowStage5() 'Gaming
Stage = 5
bExitStage5 = False
blsAlreadyStart = False
cAS.PlaySong "fight"
DoEvents
Dim k As Long
For k = 0 To 255
Form1.Line (0, 0)-(800, 600), vbBlack, BF
AlphaBlend Form1.hdc, 0, 0, 800, 600, hDCStage, 0, 0, 800, 600, MakeBlendFunction(AC_SRC_OVER, 0, k, AC_SRC_ALPHA)
Form1.Refresh
DoEvents
Next
bJumping = False
bAlreadyJumping = False
bRunning = False
Direction = Directions.eRight
ActionNum = 1
ActionState = State.Standing
bLeft = False
bUp = False
bRight = False
bDown = False
LeftRight = Key.None
UpDown = Key.None
KeyCount4 = 0
dY = 0
H = 100
T = 0.28
g = 2 * H / T / T
v0 = g * T
XO = 400
YO = 400
Call mmsSetPointNow
Dim tDelay As Single
Dim RunDelay As Single
Dim tJump As Single
tmrFPS.Enabled = True
tDelay = Timer 'AnimationDelay
RunDelay = Timer
'Line
tmrLine.Enabled = True
LinePassCount = 0
SleepDelay = 5
Do
If bExit = True Then Exit Function
'Move---------------------------------------------------------------
BitBlt Form1.hdc, 0, 0, 800, 600, hDCStage, 0, 0, SRCCOPY
If bRunning = True Then
Call mmsYunikaMove(Timer - RunDelay)
End If
RunDelay = Timer
'Jump---------------------------------------------------------------
If bJumping = True Then
If bAlreadyJumping = False Then
bAlreadyJumping = True
tJump = Timer
Else
Call jsNextJump(Timer - tJump)
End If
End If
'Line----------------------------------------------------------------
'-------1 Draw Line Behind Yunika
Dim tx As Single, ty As Single
If blsAlreadyStart = True Then
For k = 1 To LineCount(1)
'Ax + By + C = 0
Call SetLineXYo(1, k)
'Matrix
tx = LineX1o(1, k)
ty = LineY1o(1, k)
mmsSetPointNowByRef tx, ty
LineX1n(1, k) = Int(tx) + 1
LineY1n(1, k) = Int(ty) + 1
tx = LineX2o(1, k)
ty = LineY2o(1, k)
mmsSetPointNowByRef tx, ty
LineX2n(1, k) = Int(tx) + 1
LineY2n(1, k) = Int(ty) + 1
Line (LineX1n(1, k), LineY1n(1, k))-(LineX2n(1, k), LineY2n(1, k)), vbWhite
Line (LineX1n(1, k) + 1, LineY1n(1, k) + 1)-(LineX2n(1, k) + 1, LineY2n(1, k) + 1), vbWhite
Line (LineX1n(1, k), LineY1n(1, k) + 1)-(LineX2n(1, k), LineY2n(1, k) + 1), vbWhite
Call MoveLine(1, k, Timer - tLine1)
Next
If LineCount(2) <> 0 Then
For k = 1 To LineCount(2)
'Ax + By + C = 0
Call SetLineXYo(2, k)
'Matrix
tx = LineX1o(2, k)
ty = LineY1o(2, k)
mmsSetPointNowByRef tx, ty
LineX1n(2, k) = Int(tx) + 1
LineY1n(2, k) = Int(ty) + 1
tx = LineX2o(2, k)
ty = LineY2o(2, k)
mmsSetPointNowByRef tx, ty
LineX2n(2, k) = Int(tx) + 1
LineY2n(2, k) = Int(ty) + 1
Line (LineX1n(2, k), LineY1n(2, k))-(LineX2n(2, k), LineY2n(2, k)), vbWhite
Line (LineX1n(2, k), LineY1n(2, k) + 1)-(LineX2n(2, k), LineY2n(2, k) + 1), vbWhite
Line (LineX1n(2, k) + 1, LineY1n(2, k) + 1)-(LineX2n(2, k) + 1, LineY2n(2, k) + 1), vbWhite
Call MoveLine(2, k, Timer - tLine2)
Next
End If
End If
'---------- 2 Pass
If blsAlreadyStart = True Then
For k = 1 To LPS
If bLinePass(1, k) = False Then
If Timer > tLinePass(1, k) Then
bLinePass(1, k) = True
LinePassCount = LinePassCount + 1
End If
End If
Next
If LineCount(2) <> 0 Then
For k = 1 To LPS - 1
If bLinePass(2, k) = False Then
If Timer > tLinePass(2, k) Then
bLinePass(2, k) = True
LinePassCount = LinePassCount + 1
End If
End If
Next
End If
End If
'Shadow
AlphaBlend Form1.hdc, XL - 20, YL - 15, 40, 40, hDCShadow, 0, 0, 40, 40, MakeBlendFunction(AC_SRC_OVER, 0, 255, AC_SRC_ALPHA)
'Draw Yunika--------------------------------------------------------
AlphaBlend Form1.hdc, XN, YN - dY, 96, 128, YunikaDC(ActionState, Direction, ActionNum), 0, 0, 96, 128, MakeBlendFunction(AC_SRC_OVER, 0, 255, AC_SRC_ALPHA)
CounterThisSecond = CounterThisSecond + 1
'Die---------------------------------------------------------------
If blsAlreadyStart = True Then
For k = 1 To LPS
If bJumping = False Then
If GetDistance(XO, YO, 1, k) < 5 Then Call ShowStage6
End If
Next
If LineCount(2) <> 0 Then
For k = 1 To LineCount(2)
If bJumping = False Then
If GetDistance(XO, YO, 2, k) < 5 Then Call ShowStage6
End If
Next
End If
End If
'FPS----------------------------------------------------------------
If FPS <> 0 Then
Sleep (SleepDelay)
End If
'Change Picture-----------------------------------------------------
If bJumping = False Then
If Timer - tDelay >= 0.08 Then
ActionNum = ActionNum + 1
If ActionNum > ActionNumCount(ActionState) Then ActionNum = 1
tDelay = Timer
End If
Else
If Timer - tDelay >= 0.065 Then
ActionNum = ActionNum + 1
If ActionNum > ActionNumCount(ActionState) Then ActionNum = 1
tDelay = Timer
End If
End If
Form1.Refresh
DoEvents
Loop
End Function
Private Sub ShowStage6() 'GameOver
cAS.PlaySong ("fail")
tmrLine.Enabled = False
tmrFPS.Enabled = False
bExitStage6 = False
blsAlreadyStart = False
BitBlt hDCCapture, 0, 0, 800, 600, Me.hdc, 0, 0, SRCCOPY
Dim n As Long
For n = 0 To 255
BitBlt Me.hdc, 0, 0, 800, 600, hDCCapture, 0, 0, SRCCOPY
AlphaBlend Me.hdc, 250, 400, 300, 170, hDCGameOverAgain, 0, 0, 300, 170, MakeBlendFunction(AC_SRC_OVER, 0, n, AC_SRC_ALPHA)
AlphaBlend Me.hdc, 80, 80, 640, 180, hDCGameOverGameOver, 0, 0, 640, 180, MakeBlendFunction(AC_SRC_OVER, 0, n, AC_SRC_ALPHA)
Form1.Refresh
DoEvents
Sleep (10)
Next
Stage = 6
Choice = 1
Do
If bExit = True Then Exit Do
DoEvents
Sleep (30)
If bExitStage6 = True Then
If bEnterStage5 = True Then
Call ShowStage5
Else
Call ShowStage1
End If
End If
Loop
End Sub
Private Sub tmrFPS_Timer()
FPS = CounterThisSecond
Form1.Caption = "FPS:" & FPS & "     " & LinePassCount & " Line"
CounterThisSecond = 0
If FPS > 200 Then
SleepDelay = SleepDelay + 10
ElseIf FPS > 100 Then
SleepDelay = SleepDelay + 5
ElseIf FPS > 80 Then
SleepDelay = SleepDelay + 1
ElseIf FPS > 60 Then
ElseIf FPS > 50 Then
If SleepDelay > 0 Then SleepDelay = SleepDelay - 1
ElseIf FPS > 40 Then
If SleepDelay > 3 Then SleepDelay = SleepDelay - 4
Else
If SleepDelay > 5 Then SleepDelay = SleepDelay - 6
End If
End Sub

类模块AudioSystem代码：

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private sWin As String
Private sFail As String
Private sStart As String
Private sFight As String
Public sCurrent As String
Private Function GetShortName(ByVal sLongFileName As String) As String
Dim lRetVal As Long, sShortPathName As String, iLen As Integer
Dim ChineseCharacter As Long
sShortPathName = Space(255)
iLen = LenB(sShortPathName)
lRetVal = GetShortPathName(sLongFileName, sShortPathName, iLen)
ChineseCharacter = LenB(StrConv(sShortPathName, vbFromUnicode)) - Len(sShortPathName)
GetShortName = Left(sShortPathName, lRetVal - ChineseCharacter)
End Function
Private Sub Play(S As String)
mciSendString "close MEDIA", vbNullString, 0, 0
mciSendString "open " & GetShortName(S) & " alias MEDIA", vbNullString, 0, 0
mciSendString "play MEDIA", vbNullString, 0, 0
End Sub
Public Sub PlaySong(Name As String)
Form1.tmrAudio.Enabled = True
Select Case Name
Case "fail"
Play sFail
sCurrent = "fail"
Case "fight"
Play sFight
sCurrent = "fight"
Case "start"
Play sStart
sCurrent = "start"
Case "win"
Play sWin
sCurrent = "win"
End Select
End Sub
Public Sub BuildString(ResFolder As String)
sFail = ResFolder & "failv6.mp3"
sWin = ResFolder & "winv6.mp3"
sStart = ResFolder & "startv6.mp3"
sFight = ResFolder & "fightv6.mp3"
End Sub
Private Sub Class_Terminate()
mciSendString "close MEDIA", vbNullString, 0, 0
End Sub
Public Sub StopIt()
mciSendString "close MEDIA", vbNullString, 0, 0
End Sub

YSO小游戏·VB6版代码相关推荐

简易贪吃蛇小游戏java版_用GUI实现java版贪吃蛇小游戏
本文实例为大家分享了java版贪吃蛇小游戏的具体代码,供大家参考,具体内容如下项目结构新建一个JFrame窗口,作为程序入口 public class GameStart{ public stat ...
python小游戏-16行代码实现3D撞球小游戏！-源码下载
python小游戏-16行代码实现3D撞球小游戏!-源码下载所属网站分类: 资源下载 > python小游戏作者:搞笑链接: http://www.pythonheidong.com/bl ...
java代码实现打气球游戏_关于javascript和css3开发打气球小游戏的完整代码
这篇文章主要介绍了关于javascript和css3开发打气球小游戏的完整代码,有着一定的参考价值,现在分享给大家,有需要的朋友可以参考一下这是一个简单但是印象深刻的小游戏,打气球小游戏的实现代码, ...
贪吃蛇小游戏java实现代码分析
贪吃蛇小游戏java实现代码分析贪吃蛇的小游戏,网上的代码比较多,今天周五,在教研室没啥事做,在电脑中发现了一个贪吃蛇的小游戏,于是就看了下实现的源码,发现别人写的代码确实挺好的,自己也是边加注释边 ...
Arduino中编写打砖块小游戏（完整代码）
标题 Arduino中编写打砖块小游戏(完整代码) 程序中有大量的注释,希望真的能帮助到你! (一)环境硬件:OLED 屏幕(128*64).摇杆模块(程序中使用的是摇杆模块的模拟量,如果你身边没有 ...
电话手表算术游戏不是计算机,算术小游戏红包版
算术小游戏红包版是一款十分有意思的答题闯关游戏,通过挑战各种各样算术题的方式闯关,随时随地上手即玩,凭借你的智慧答对题目即可通关,每一关还可以借助一些道具的帮助,每一次顺利通关都能积攒红包的奖励,绝对 ...
Appgamekit制作消消乐小游戏（附代码）# 1
Appgamekit制作消消乐小游戏(附代码)# 1 其实作者我也是刚刚才接触的Appgamekit,而且以前我是学C/C++的,所以我学的东西拿来这里就只有代码的结构思路会清晰一点了.(但是思路其实 ...
js小游戏动物连连看代码
下载地址 js小游戏动物连连看代码,有多种语言切换,默认是中文.不用部署本地解压即可预览. dd:
Cocos creator实现《滑雪趣挑战》滑雪小游戏资源及代码
Cocos creator实现<滑雪趣挑战>滑雪小游戏资源及代码最近在学习Cocos Creator,作为新手,刚刚开始学习Cocos Creator,上线了两个微信小游戏,刚刚入门,这 ...

YSO小游戏·VB6版代码

YSO小游戏·VB6版代码相关推荐

最新文章

热门文章