VBcoders Guest



Don't have an account yet? Register
 


Forgot Password?



A wonderful rotating 3D Cube at run time. Rotating according to your mouse movment..enjoy and e-mai

by SYED ZUBAIR ALI (7 Submissions)
Category: Graphics
Compatability: VB.NET
Difficulty: Unknown Difficulty
Originally Published: Fri 4th September 2009
Date Added: Mon 8th February 2021
Rating: (1 Votes)

A wonderful rotating 3D Cube at run time. Rotating according to your mouse movment..enjoy and e-mail me at [email protected]

Rate A wonderful rotating 3D Cube at run time. Rotating according to your mouse movment..enjoy and e-mai



 'And paste all below code as given same.
'At Run-Time, Move the mouse to change the rotation speed and direction..

Private X(8) As Integer
Private y(8) As Integer
Private Const Pi = 3.14159265358979
Private CenterX As Integer
Private CenterY As Integer
Private Const SIZE = 250
Private Radius As Integer
Private Angle As Integer
Private CurX As Integer
Private CurY As Integer
Private CubeCorners(1 To 8, 1 To 3) As Integer

Private Sub Form_Load()
    Me.ScaleMode = 3
    Picture1.ScaleMode = 3
    Timer1.Interval = 1
    Me.ForeColor = vbBlue
    Me.DrawWidth = 3
    Picture1.AutoRedraw = True
    Show
    Picture1.Height = Picture1.Width
    Picture1.Move ScaleWidth / 2 - Picture1.ScaleWidth / 2, Picture1.Height
    CenterX = ScaleWidth / 2
    CenterY = ScaleHeight / 2
    Angle = 0
    Radius = Sqr(2 * (SIZE / 2) ^ 2)
    CubeCorners(1, 2) = SIZE / 2
    CubeCorners(2, 2) = SIZE / 2
    CubeCorners(3, 2) = -SIZE / 2
    CubeCorners(4, 2) = -SIZE / 2
    CubeCorners(5, 2) = SIZE / 2
    CubeCorners(6, 2) = SIZE / 2
    CubeCorners(7, 2) = -SIZE / 2
    CubeCorners(8, 2) = -SIZE / 2
End Sub

Private Sub DrawCube()
    Cls
    For I = 1 To 8
        X(I) = CenterX + CubeCorners(I, 1) + CubeCorners(I, 3) / 8
        y(I) = CenterY + CubeCorners(I, 2) + Sgn(CubeCorners(I, 2)) * CubeCorners(I, 3) / 8
    Next I
    Line (X(3), y(3))-(X(4), y(4))
    Line (X(4), y(4))-(X(8), y(8))
    Line (X(3), y(3))-(X(7), y(7))
    Line (X(7), y(7))-(X(8), y(8))
    Line (X(1), y(1))-(X(3), y(3))
    Line (X(1), y(1))-(X(2), y(2))
    Line (X(5), y(5))-(X(6), y(6))
    Line (X(5), y(5))-(X(1), y(1))
    Line (X(5), y(5))-(X(7), y(7))
    Line (X(6), y(6))-(X(8), y(8))
    Line (X(2), y(2))-(X(4), y(4))
    Line (X(2), y(2))-(X(6), y(6))
    Line (X(1), y(1))-(X(4), y(4))
    Line (X(2), y(2))-(X(3), y(3))
    Line (X(4), y(4))-(X(8), y(8))
    Line (X(3), y(3))-(X(7), y(7))
    DoEvents
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
    CurX = X
    CurY = y
End Sub

Private Sub Timer1_Timer()
    Select Case CurX
    Case Is > ScaleWidth / 2
        Angle = Angle + Abs(CurX - ScaleWidth / 2) / 20
        If Angle = 360 Then Angle = 0
    Case Else
        Angle = Angle - Abs(CurX - ScaleWidth / 2) / 20
        If Angle = 0 Then Angle = 360
    End Select
    For I = 1 To 3 Step 2
        CubeCorners(I, 3) = Radius * Cos((Angle) * Pi / 180)
        CubeCorners(I, 1) = Radius * Sin((Angle) * Pi / 180)
    Next
    For I = 2 To 4 Step 2
        CubeCorners(I, 3) = Radius * Cos((Angle + 2 * 45) * Pi / 180)
        CubeCorners(I, 1) = Radius * Sin((Angle + 2 * 45) * Pi / 180)
    Next
    For I = 5 To 7 Step 2
        CubeCorners(I, 3) = Radius * Cos((Angle + 6 * 45) * Pi / 180)
        CubeCorners(I, 1) = Radius * Sin((Angle + 6 * 45) * Pi / 180)
    Next
    For I = 6 To 8 Step 2
        CubeCorners(I, 3) = Radius * Cos((Angle + 4 * 45) * Pi / 180)
        CubeCorners(I, 1) = Radius * Sin((Angle + 4 * 45) * Pi / 180)
    Next
    Call DrawCube
End Sub

Download this snippet    Add to My Saved Code

A wonderful rotating 3D Cube at run time. Rotating according to your mouse movment..enjoy and e-mai Comments

No comments have been posted about A wonderful rotating 3D Cube at run time. Rotating according to your mouse movment..enjoy and e-mai. Why not be the first to post a comment about A wonderful rotating 3D Cube at run time. Rotating according to your mouse movment..enjoy and e-mai.

Post your comment

Subject:
Message:
0/1000 characters