thevolumecalcbak.bas

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

        ShapeC.TurnTU = ShapeC.TurnTU Mod 360
        
        '-- Calculation Of 3D Coordinates
        For Aa = 0 To 107
            '-- Set values to temporary variables for adjustment before drawing
            ShapeC.My3DCoordinates(Aa).X = ShapeC.My3DPoints(Aa).X
            ShapeC.My3DCoordinates(Aa).Y = ShapeC.My3DPoints(Aa).Y
            ShapeC.My3DCoordinates(Aa).Z = ShapeC.My3DPoints(Aa).Z

            '--Rotation
            TempPoints.X = (Cos(ShapeC.TurnTU * Pi) * ShapeC.My3DCoordinates(Aa).X) + (-Sin(ShapeC.TurnTU * Pi) * ShapeC.My3DCoordinates(Aa).Y)
            ShapeC.My3DCoordinates(Aa).Y = (Sin(ShapeC.TurnTU * Pi) * ShapeC.My3DCoordinates(Aa).X) + (Cos(ShapeC.TurnTU * Pi) * ShapeC.My3DCoordinates(Aa).Y)
            ShapeC.My3DCoordinates(Aa).X = TempPoints.X
        
            TempPoints.X = (Cos(ShapeC.TurnUD * Pi) * ShapeC.My3DCoordinates(Aa).X) + (-Sin(ShapeC.TurnUD * Pi) * ShapeC.My3DCoordinates(Aa).Z)
            ShapeC.My3DCoordinates(Aa).Z = (Sin(ShapeC.TurnUD * Pi) * ShapeC.My3DCoordinates(Aa).X) + (Cos(ShapeC.TurnUD * Pi) * ShapeC.My3DCoordinates(Aa).Z)
            ShapeC.My3DCoordinates(Aa).X = TempPoints.X
        
            TempPoints.Y = (Cos(ShapeC.TurnLR * Pi) * ShapeC.My3DCoordinates(Aa).Y) + (-Sin(ShapeC.TurnLR * Pi) * ShapeC.My3DCoordinates(Aa).Z)
            ShapeC.My3DCoordinates(Aa).Z = (Sin(ShapeC.TurnLR * Pi) * ShapeC.My3DCoordinates(Aa).Y) + (Cos(ShapeC.TurnLR * Pi) * ShapeC.My3DCoordinates(Aa).Z)
            ShapeC.My3DCoordinates(Aa).Y = TempPoints.Y
        
            '--Z Vertices - Calculate depth
            ShapeC.MyPoints(Aa).X = ((ShapeC.My3DCoordinates(Aa).X - ShapeC.PosX) / (ShapeC.My3DCoordinates(Aa).Z - ShapeC.PosZ) * 600) + 160
            ShapeC.MyPoints(Aa).Y = ((ShapeC.My3DCoordinates(Aa).Y - ShapeC.PosY) / (ShapeC.My3DCoordinates(Aa).Z - ShapeC.PosZ) * 600) + 120
        Next Aa
        
        '-- Calculation Drawing Order
        ReDim TempDrawOrder(19)
        For Aa = 0 To 17
            TempDrawOrder(Aa) = (ShapeC.My3DCoordinates((Aa * 4)).Z + ShapeC.My3DCoordinates((Aa * 4) + 1).Z + ShapeC.My3DCoordinates((Aa * 4) + 2).Z + ShapeC.My3DCoordinates((Aa * 4) + 3).Z) / 4
            ShapeC.DrawOrder(Aa) = Aa '-- Reset this variable
        Next Aa
        TempDrawOrder(18) = 0
        For Aa = 0 To 17
            TempDrawOrder(18) = TempDrawOrder(18) + ShapeC.My3DCoordinates(Aa + 72).Z
        Next Aa
        TempDrawOrder(18) = TempDrawOrder(18) / 18
        TempDrawOrder(19) = 0
        For Aa = 0 To 17
            TempDrawOrder(19) = TempDrawOrder(19) + ShapeC.My3DCoordinates(Aa + 90).Z
        Next Aa
        TempDrawOrder(19) = TempDrawOrder(19) / 18
        ShapeC.DrawOrder(18) = 18 '-- Reset this variable
        ShapeC.DrawOrder(19) = 19 '-- Reset this variable
        
        For Aa = 0 To 18
            If TempDrawOrder(Aa) > TempDrawOrder(Aa + 1) Then
                '--Swaping Variables manually since there is no such function that I know of in VB
                Ab = ShapeC.DrawOrder(Aa)
                ShapeC.DrawOrder(Aa) = ShapeC.DrawOrder(Aa + 1)
                ShapeC.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 SHAPEc.DrawOrder(Aa), TempDrawOrder(Aa)
        'Next Aa
        
        '-- Drawing
        'SelectObject BackBuffer, MyPens(0)
        'SelectObject BackBuffer, MyBrushes(0)
        For Aa = 0 To 19
            'SelectObject BackBuffer, MyPens(ShapeC.DrawOrder(Aa) + 1)
            'SelectObject BackBuffer, MyBrushes(ShapeC.DrawOrder(Aa) + 1)
            If ShapeC.DrawOrder(Aa) <= 17 Then
                SelectObject BackBuffer, MyPens(0)
                SelectObject BackBuffer, MyBrushes(ShapeC.DrawOrder(Aa) Mod 2 + 3)
                Polygon BackBuffer, ShapeC.MyPoints(ShapeC.DrawOrder(Aa) * 4), 4
            ElseIf ShapeC.DrawOrder(Aa) = 18 Then
                SelectObject BackBuffer, MyPens(0)
                SelectObject BackBuffer, MyBrushes(3)
                Polygon BackBuffer, ShapeC.MyPoints(72), 18
            ElseIf ShapeC.DrawOrder(Aa) = 19 Then
                SelectObject BackBuffer, MyPens(0)
                SelectObject BackBuffer, MyBrushes(4)
                Polygon BackBuffer, ShapeC.MyPoints(90), 18
            End If
        Next Aa
        
End Sub

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

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

'-- Call this Sub to Draw the ShapeE - Sphere
Sub DrawShapeE()
    '----Draw the Sphere
    SelectObject BackBuffer, MyPens(0)
    SelectObject BackBuffer, MyBrushes(3)
    Aa = (1000 / ShapeE.PosZ * 80) '--Sphere size
            
    'Ellipse BackBuffer, ShapeE.PosX + 160 - Aa, ShapeE.PosY + 120 - Aa, ShapeE.PosX + 160 + Aa, ShapeE.PosY + 120 + Aa
    Ellipse BackBuffer, (ShapeE.PosX / ShapeE.PosZ * 600) + 160 - Aa, (ShapeE.PosY / ShapeE.PosZ * 600) + 120 - Aa, (ShapeE.PosX / ShapeE.PosZ * 600) + 160 + Aa, (ShapeE.PosY / ShapeE.PosZ * 600) + 120 + Aa
    
End Sub

'-- Call this sub to create Pens and Brushes to draw with
Sub CreatePensBrushes()
    '----Creating Pens
    ReDim MyPens(6)
    MyPens(0) = CreatePen(PS_SOLID, 1, RGB(0, 0, 0))
    MyPens(1) = CreatePen(PS_SOLID, 1, RGB(255, 0, 0))
    MyPens(2) = CreatePen(PS_SOLID, 1, RGB(0, 255, 0))
    MyPens(3) = CreatePen(PS_SOLID, 1, RGB(0, 0, 255))
    MyPens(4) = CreatePen(PS_SOLID, 1, RGB(255, 255, 0))
    MyPens(5) = CreatePen(PS_SOLID, 1, RGB(0, 255, 255))
    MyPens(6) = CreatePen(PS_SOLID, 1, RGB(255, 0, 255))
    
    '----Creating Brushes
    ReDim MyBrushes(6)
    MyBrushes(0) = CreateSolidBrush(RGB(0, 0, 0))
    MyBrushes(1) = CreateSolidBrush(RGB(255, 0, 0))
    MyBrushes(2) = CreateSolidBrush(RGB(0, 255, 0))
    MyBrushes(3) = CreateSolidBrush(RGB(0, 0, 255))
    MyBrushes(4) = CreateSolidBrush(RGB(255, 255, 0))
    MyBrushes(5) = CreateSolidBrush(RGB(0, 255, 255))
    MyBrushes(6) = CreateSolidBrush(RGB(255, 0, 255))

End Sub

'-- Call this sub to remove the Pens and Brushes that was created by 'CreatePensBrushes'
Sub DeletePensBrushes()
    '----Deleting Pens
    For Aa = 0 To 6
        DeleteObject MyPens(Aa)
    Next Aa

    '----Deleting Brushes
    For Aa = 0 To 6
        DeleteObject MyBrushes(Aa)
    Next Aa

End Sub

'-- Call this sub to arrange the order in which to draw the Shapes and draw them automatically in that order
Sub DrawAllShapes()
    
        '-- Calculation Drawing Order
        ReDim TempDrawOrder(4)
        ReDim TempArray(4)
        TempDrawOrder(0) = ShapeA.PosZ
        TempDrawOrder(1) = ShapeB.PosZ
        TempDrawOrder(2) = ShapeC.PosZ
        TempDrawOrder(3) = ShapeD.PosZ
        TempDrawOrder(4) = ShapeE.PosZ
        For Aa = 0 To 4
            TempArray(Aa) = Aa '-- reset this variable with incrementing numbers
        Next Aa
        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 = TempArray(Aa)
                TempArray(Aa) = TempArray(Aa + 1)
                TempArray(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
        
        '---- Calling the Shapes drawing Subs to draw in the appropriate order
        For Ac = 0 To 4 '-- ref. don't use the variable 'Ac' in the Shapes drawing Subs
            Select Case TempArray(4 - Ac)
                Case 0 '--Draw Cube
                    DrawShapeA
                    
                Case 1 '--Draw Pyramid
                    DrawShapeB
                    
                Case 2 '--Draw Cylinder
                    DrawShapeC
                    
                Case 3 '--Draw Cone
                    DrawShapeD
                    
                Case 4 '--Draw Sphere
                    DrawShapeE
                
            End Select
            
        Next Ac
        
        
End Sub