How to create 3D Rotating Cube
Posted on January 5, 2009
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 | 'Graphics - How to create 3D Rotating Cube 'Add a Picture Box and a Timer Control to your form. '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 |