thevolumecalcbak.bas

VB小游戏,三为动画效果,请大家留意 赌东道

    ShapeB.TurnTU = 0
    ReDim ShapeB.MyPoints(15)
    ReDim ShapeB.My3DPoints(15)
    ReDim ShapeB.My3DCoordinates(15)
    ReDim ShapeB.DrawOrder(4)
    
    ShapeB.My3DPoints(0).X = 100
    ShapeB.My3DPoints(0).Y = -100
    ShapeB.My3DPoints(0).Z = -100
    ShapeB.My3DPoints(1).X = 100
    ShapeB.My3DPoints(1).Y = -100
    ShapeB.My3DPoints(1).Z = 100
    ShapeB.My3DPoints(2).X = 0
    ShapeB.My3DPoints(2).Y = 200
    ShapeB.My3DPoints(2).Z = 0
    
    ShapeB.My3DPoints(3).X = -100
    ShapeB.My3DPoints(3).Y = -100
    ShapeB.My3DPoints(3).Z = -100
    ShapeB.My3DPoints(4).X = -100
    ShapeB.My3DPoints(4).Y = -100
    ShapeB.My3DPoints(4).Z = 100
    ShapeB.My3DPoints(5).X = 0
    ShapeB.My3DPoints(5).Y = 200
    ShapeB.My3DPoints(5).Z = 0
    
    ShapeB.My3DPoints(6).X = 100
    ShapeB.My3DPoints(6).Y = -100
    ShapeB.My3DPoints(6).Z = 100
    ShapeB.My3DPoints(7).X = -100
    ShapeB.My3DPoints(7).Y = -100
    ShapeB.My3DPoints(7).Z = 100
    ShapeB.My3DPoints(8).X = 0
    ShapeB.My3DPoints(8).Y = 200
    ShapeB.My3DPoints(8).Z = 0
    
    ShapeB.My3DPoints(9).X = -100
    ShapeB.My3DPoints(9).Y = -100
    ShapeB.My3DPoints(9).Z = -100
    ShapeB.My3DPoints(10).X = 100
    ShapeB.My3DPoints(10).Y = -100
    ShapeB.My3DPoints(10).Z = -100
    ShapeB.My3DPoints(11).X = 0
    ShapeB.My3DPoints(11).Y = 200
    ShapeB.My3DPoints(11).Z = 0
    
    ShapeB.My3DPoints(12).X = -100
    ShapeB.My3DPoints(12).Y = -100
    ShapeB.My3DPoints(12).Z = -100
    ShapeB.My3DPoints(13).X = 100
    ShapeB.My3DPoints(13).Y = -100
    ShapeB.My3DPoints(13).Z = -100
    ShapeB.My3DPoints(14).X = 100
    ShapeB.My3DPoints(14).Y = -100
    ShapeB.My3DPoints(14).Z = 100
    ShapeB.My3DPoints(15).X = -100
    ShapeB.My3DPoints(15).Y = -100
    ShapeB.My3DPoints(15).Z = 100
    
'----ShapeC - Cylinder
    ShapeC.PosX = 100
    ShapeC.PosY = 100
    ShapeC.PosZ = 100
    ShapeC.TurnLR = 0
    ShapeC.TurnUD = 0
    ShapeC.TurnTU = 0
    ReDim ShapeC.MyPoints(107)
    ReDim ShapeC.My3DPoints(107)
    ReDim ShapeC.My3DCoordinates(107)
    ReDim ShapeC.DrawOrder(19)
    For Aa = 0 To 17
        ShapeC.My3DPoints((Aa * 4)).X = Sin(Aa / 18 * 360 * Pi) * 100
        ShapeC.My3DPoints((Aa * 4)).Y = -150
        ShapeC.My3DPoints((Aa * 4)).Z = Cos(Aa / 18 * 360 * Pi) * 100
        ShapeC.My3DPoints((Aa * 4) + 1).X = Sin(Aa / 18 * 360 * Pi) * 100
        ShapeC.My3DPoints((Aa * 4) + 1).Y = 150
        ShapeC.My3DPoints((Aa * 4) + 1).Z = Cos(Aa / 18 * 360 * Pi) * 100
        ShapeC.My3DPoints((Aa * 4) + 2).X = Sin(((Aa + 1) Mod 18) / 18 * 360 * Pi) * 100
        ShapeC.My3DPoints((Aa * 4) + 2).Y = 150
        ShapeC.My3DPoints((Aa * 4) + 2).Z = Cos(((Aa + 1) Mod 18) / 18 * 360 * Pi) * 100
        ShapeC.My3DPoints((Aa * 4) + 3).X = Sin(((Aa + 1) Mod 18) / 18 * 360 * Pi) * 100
        ShapeC.My3DPoints((Aa * 4) + 3).Y = -150
        ShapeC.My3DPoints((Aa * 4) + 3).Z = Cos(((Aa + 1) Mod 18) / 18 * 360 * Pi) * 100
    Next Aa
    For Aa = 0 To 17
        ShapeC.My3DPoints(Aa + 72).X = Sin(Aa / 18 * 360 * Pi) * 100
        ShapeC.My3DPoints(Aa + 72).Y = 150
        ShapeC.My3DPoints(Aa + 72).Z = Cos(Aa / 18 * 360 * Pi) * 100
    Next Aa
    For Aa = 0 To 17
        ShapeC.My3DPoints(Aa + 90).X = Sin(Aa / 18 * 360 * Pi) * 100
        ShapeC.My3DPoints(Aa + 90).Y = -150
        ShapeC.My3DPoints(Aa + 90).Z = Cos(Aa / 18 * 360 * Pi) * 100
    Next Aa

'----ShapeD - Cone
    ShapeD.PosX = 100
    ShapeD.PosY = 100
    ShapeD.PosZ = 100
    ShapeD.TurnLR = 0
    ShapeD.TurnUD = 0
    ShapeD.TurnTU = 0
    ReDim ShapeD.MyPoints(107)
    ReDim ShapeD.My3DPoints(107)
    ReDim ShapeD.My3DCoordinates(107)
    ReDim ShapeD.DrawOrder(18)
    For Aa = 0 To 17
        ShapeD.My3DPoints((Aa * 3)).X = Sin(Aa / 18 * 360 * Pi) * 100
        ShapeD.My3DPoints((Aa * 3)).Y = 150
        ShapeD.My3DPoints((Aa * 3)).Z = Cos(Aa / 18 * 360 * Pi) * 100
        ShapeD.My3DPoints((Aa * 3) + 1).X = Sin(((Aa + 1) Mod 18) / 18 * 360 * Pi) * 100
        ShapeD.My3DPoints((Aa * 3) + 1).Y = 150
        ShapeD.My3DPoints((Aa * 3) + 1).Z = Cos(((Aa + 1) Mod 18) / 18 * 360 * Pi) * 100
        ShapeD.My3DPoints((Aa * 3) + 2).X = 0
        ShapeD.My3DPoints((Aa * 3) + 2).Y = -150
        ShapeD.My3DPoints((Aa * 3) + 2).Z = 0
    Next Aa
    For Aa = 0 To 17
        ShapeD.My3DPoints(Aa + 54).X = Sin(Aa / 18 * 360 * Pi) * 100
        ShapeD.My3DPoints(Aa + 54).Y = 150
        ShapeD.My3DPoints(Aa + 54).Z = Cos(Aa / 18 * 360 * Pi) * 100
    Next Aa

'----ShapeE - Sphere
    ShapeD.PosX = 100
    ShapeD.PosY = 100
    ShapeD.PosZ = 100

End Sub

'-- Call this Sub to Draw the ShapeA - Cube
Sub DrawShapeA()
    On Error Resume Next
       
        '--Adjusting the rotation variables
        ShapeA.TurnUD = ShapeA.TurnUD Mod 360
        ShapeA.TurnLR = ShapeA.TurnLR Mod 360
        ShapeA.TurnTU = ShapeA.TurnTU Mod 360
        
        '-- Calculation Of 3D Coordinates
        For Aa = 0 To 23
            '-- Set values to temporary variables for adjustment before drawing
            ShapeA.My3DCoordinates(Aa).X = ShapeA.My3DPoints(Aa).X
            ShapeA.My3DCoordinates(Aa).Y = ShapeA.My3DPoints(Aa).Y
            ShapeA.My3DCoordinates(Aa).Z = ShapeA.My3DPoints(Aa).Z

            '--Rotation
            TempPoints.X = (Cos(ShapeA.TurnTU * Pi) * ShapeA.My3DCoordinates(Aa).X) + (-Sin(ShapeA.TurnTU * Pi) * ShapeA.My3DCoordinates(Aa).Y)
            ShapeA.My3DCoordinates(Aa).Y = (Sin(ShapeA.TurnTU * Pi) * ShapeA.My3DCoordinates(Aa).X) + (Cos(ShapeA.TurnTU * Pi) * ShapeA.My3DCoordinates(Aa).Y)
            ShapeA.My3DCoordinates(Aa).X = TempPoints.X
        
            TempPoints.X = (Cos(ShapeA.TurnUD * Pi) * ShapeA.My3DCoordinates(Aa).X) + (-Sin(ShapeA.TurnUD * Pi) * ShapeA.My3DCoordinates(Aa).Z)
            ShapeA.My3DCoordinates(Aa).Z = (Sin(ShapeA.TurnUD * Pi) * ShapeA.My3DCoordinates(Aa).X) + (Cos(ShapeA.TurnUD * Pi) * ShapeA.My3DCoordinates(Aa).Z)
            ShapeA.My3DCoordinates(Aa).X = TempPoints.X
        
            TempPoints.Y = (Cos(ShapeA.TurnLR * Pi) * ShapeA.My3DCoordinates(Aa).Y) + (-Sin(ShapeA.TurnLR * Pi) * ShapeA.My3DCoordinates(Aa).Z)
            ShapeA.My3DCoordinates(Aa).Z = (Sin(ShapeA.TurnLR * Pi) * ShapeA.My3DCoordinates(Aa).Y) + (Cos(ShapeA.TurnLR * Pi) * ShapeA.My3DCoordinates(Aa).Z)
            ShapeA.My3DCoordinates(Aa).Y = TempPoints.Y
        
            '--Z Vertices - Calculate depth
            ShapeA.MyPoints(Aa).X = ((ShapeA.My3DCoordinates(Aa).X - ShapeA.PosX) / (ShapeA.My3DCoordinates(Aa).Z - ShapeA.PosZ) * 600) + 160
            ShapeA.MyPoints(Aa).Y = ((ShapeA.My3DCoordinates(Aa).Y - ShapeA.PosY) / (ShapeA.My3DCoordinates(Aa).Z - ShapeA.PosZ) * 600) + 120
        Next Aa
        
        '-- Calculation Drawing Order
        ReDim TempDrawOrder(5)
        For Aa = 0 To 5
            TempDrawOrder(Aa) = (ShapeA.My3DCoordinates((Aa * 4)).Z + ShapeA.My3DCoordinates((Aa * 4) + 1).Z + ShapeA.My3DCoordinates((Aa * 4) + 2).Z + ShapeA.My3DCoordinates((Aa * 4) + 3).Z) / 4
            ShapeA.DrawOrder(Aa) = Aa '-- Reset this variable
        Next Aa
        For Aa = 0 To 4
            If TempDrawOrder(Aa) > TempDrawOrder(Aa + 1) Then
                '--Swaping Variables manually since there is no such function that I know of in VB
                Ab = ShapeA.DrawOrder(Aa)
                ShapeA.DrawOrder(Aa) = ShapeA.DrawOrder(Aa + 1)
                ShapeA.DrawOrder(Aa + 1) = Ab
                
                Ab = TempDrawOrder(Aa)
                TempDrawOrder(Aa) = TempDrawOrder(Aa + 1)
                TempDrawOrder(Aa + 1) = Ab
                Aa = Aa - 2
                If Aa < -1 Then Aa = -1
                'If Aa < -10 Then Debug.Print Error
            End If
        Next Aa
        'Debug.Print "<<<<-------->>>>"
        'For Aa = 0 To 5
        '    Debug.Print ShapeA.DrawOrder(Aa), TempDrawOrder(Aa)
        'Next Aa
        
        '-- Drawing
        'SelectObject BackBuffer, MyPens(0)
        'SelectObject BackBuffer, MyBrushes(0)
        For Aa = 0 To 5
            SelectObject BackBuffer, MyPens(ShapeA.DrawOrder(Aa) + 1)
            SelectObject BackBuffer, MyBrushes(ShapeA.DrawOrder(Aa) + 1)
            Polygon BackBuffer, ShapeA.MyPoints(ShapeA.DrawOrder(Aa) * 4), 4
        Next Aa
        
End Sub

'-- Call this Sub to Draw the ShapeB - Pyramid
Sub DrawShapeB()
    On Error Resume Next
       
        '--Adjusting the rotation variables
        ShapeB.TurnUD = ShapeB.TurnUD Mod 360
        ShapeB.TurnLR = ShapeB.TurnLR Mod 360
        ShapeB.TurnTU = ShapeB.TurnTU Mod 360
        
        '-- Calculation Of 3D Coordinates
        For Aa = 0 To 15
            '-- Set values to temporary variables for adjustment before drawing
            ShapeB.My3DCoordinates(Aa).X = ShapeB.My3DPoints(Aa).X
            ShapeB.My3DCoordinates(Aa).Y = ShapeB.My3DPoints(Aa).Y
            ShapeB.My3DCoordinates(Aa).Z = ShapeB.My3DPoints(Aa).Z

            '--Rotation
            TempPoints.X = (Cos(ShapeB.TurnTU * Pi) * ShapeB.My3DCoordinates(Aa).X) + (-Sin(ShapeB.TurnTU * Pi) * ShapeB.My3DCoordinates(Aa).Y)
            ShapeB.My3DCoordinates(Aa).Y = (Sin(ShapeB.TurnTU * Pi) * ShapeB.My3DCoordinates(Aa).X) + (Cos(ShapeB.TurnTU * Pi) * ShapeB.My3DCoordinates(Aa).Y)
            ShapeB.My3DCoordinates(Aa).X = TempPoints.X
        
            TempPoints.X = (Cos(ShapeB.TurnUD * Pi) * ShapeB.My3DCoordinates(Aa).X) + (-Sin(ShapeB.TurnUD * Pi) * ShapeB.My3DCoordinates(Aa).Z)
            ShapeB.My3DCoordinates(Aa).Z = (Sin(ShapeB.TurnUD * Pi) * ShapeB.My3DCoordinates(Aa).X) + (Cos(ShapeB.TurnUD * Pi) * ShapeB.My3DCoordinates(Aa).Z)
            ShapeB.My3DCoordinates(Aa).X = TempPoints.X
        
            TempPoints.Y = (Cos(ShapeB.TurnLR * Pi) * ShapeB.My3DCoordinates(Aa).Y) + (-Sin(ShapeB.TurnLR * Pi) * ShapeB.My3DCoordinates(Aa).Z)
            ShapeB.My3DCoordinates(Aa).Z = (Sin(ShapeB.TurnLR * Pi) * ShapeB.My3DCoordinates(Aa).Y) + (Cos(ShapeB.TurnLR * Pi) * ShapeB.My3DCoordinates(Aa).Z)
            ShapeB.My3DCoordinates(Aa).Y = TempPoints.Y
        
            '--Z Vertices - Calculate depth
            ShapeB.MyPoints(Aa).X = ((ShapeB.My3DCoordinates(Aa).X - ShapeB.PosX) / (ShapeB.My3DCoordinates(Aa).Z - ShapeB.PosZ) * 600) + 160
            ShapeB.MyPoints(Aa).Y = ((ShapeB.My3DCoordinates(Aa).Y - ShapeB.PosY) / (ShapeB.My3DCoordinates(Aa).Z - ShapeB.PosZ) * 600) + 120
        Next Aa
        
        '-- Calculation Drawing Order
        ReDim TempDrawOrder(4)
        For Aa = 0 To 3
            TempDrawOrder(Aa) = (ShapeB.My3DCoordinates((Aa * 3)).Z + ShapeB.My3DCoordinates((Aa * 3) + 1).Z + ShapeB.My3DCoordinates((Aa * 3) + 2).Z) / 3
            ShapeB.DrawOrder(Aa) = Aa '-- Reset this variable
        Next Aa
        Aa = 4
        TempDrawOrder(Aa) = (ShapeB.My3DCoordinates((Aa * 3)).Z + ShapeB.My3DCoordinates((Aa * 3) + 1).Z + ShapeB.My3DCoordinates((Aa * 3) + 2).Z + ShapeB.My3DCoordinates((Aa * 3) + 3).Z) / 4
        ShapeB.DrawOrder(Aa) = Aa '-- Reset this variable
        For Aa = 0 To 3
            If TempDrawOrder(Aa) > TempDrawOrder(Aa + 1) Then
                '--Swaping Variables manually since there is no such function that I know of in VB
                Ab = ShapeB.DrawOrder(Aa)
                ShapeB.DrawOrder(Aa) = ShapeB.DrawOrder(Aa + 1)
                ShapeB.DrawOrder(Aa + 1) = Ab
                
                Ab = TempDrawOrder(Aa)
                TempDrawOrder(Aa) = TempDrawOrder(Aa + 1)
                TempDrawOrder(Aa + 1) = Ab
                Aa = Aa - 2
                If Aa < -1 Then Aa = -1
                'If Aa < -10 Then Debug.Print Error
            End If
        Next Aa
        'Debug.Print "<<<<-------->>>>"
        'For Aa = 0 To 4
        '    Debug.Print ShapeB.DrawOrder(Aa), TempDrawOrder(Aa)
        'Next Aa
        
        '-- Drawing
        'SelectObject BackBuffer, MyPens(0)
        'SelectObject BackBuffer, MyBrushes(0)
        For Aa = 0 To 4
            'SelectObject BackBuffer, MyPens(ShapeB.DrawOrder(Aa) + 1)
            SelectObject BackBuffer, MyPens(0)
            SelectObject BackBuffer, MyBrushes(ShapeB.DrawOrder(Aa) + 1)
            If ShapeB.DrawOrder(Aa) < 4 Then Polygon BackBuffer, ShapeB.MyPoints(ShapeB.DrawOrder(Aa) * 3), 3
            If ShapeB.DrawOrder(Aa) = 4 Then Polygon BackBuffer, ShapeB.MyPoints(ShapeB.DrawOrder(Aa) * 3), 4
        Next Aa
        
End Sub

'-- Call this Sub to Draw the ShapeC - Cylinder
Sub DrawShapeC()
    On Error Resume Next
       
        '--Adjusting the rotation variables
        ShapeC.TurnUD = ShapeC.TurnUD Mod 360
        ShapeC.TurnLR = ShapeC.TurnLR Mod 360