YSO小游戏·VB6版代码

最新推荐文章于 2022-12-16 22:40:56 发布

feng32tc

最新推荐文章于 2022-12-16 22:40:56 发布

阅读量793

点赞数

文章标签：游戏 vb timer function integer string

本文链接：https://blog.csdn.net/feng32tc/article/details/2572878

版权

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