Move 3D Cube On Form

'Add 1 Label to your form. Move the cube over the XY axis with the cursor keys.
'Move the cube over the XZ axis with Shift+cursor keys.

'Insert the following code to your form:

Private CenterX As Integer
Private CenterY As Integer
Private Const Size = 40
Private CurX As Integer
Private CurY As Integer
Private CurZ As Integer
Private MoveTo As Integer
Private Const MOVE_LEFT = 0
Private Const MOVE_RIGHT = 1
Private Const MOVE_UP = 2
Private Const MOVE_DOWN = 3
Private Const MOVE_FORWARD = 4
Private Const MOVE_BACKWARD = 5

Public Sub EraseBlock()
X = CurX: y = CurY: Z = CurZ
xs = (CenterX + X * Size) - Z * (Size / 2)
Ys = (CenterY - y * Size) + Z * (Size / 2)
Line (xs, Ys)-(xs + Size, Ys - Size), BackColor, BF
Line (xs - Size / 2, Ys + Size / 2)-(xs + Size / 2, Ys - Size / 2), BackColor, BF
For i = 0 To Size / 2
Line (xs - i, Ys + i)-(xs - i, Ys + i - Size - 1), BackColor
Line (xs - i + Size, Ys + i)-(xs - i + Size, Ys + i - Size), BackColor
Next
End Sub
Public Sub DrawBlock()
Line (CenterX, CenterY)-(CenterX + Size * 6, CenterY - Size * 6), vbBlue, B
Line (CenterX, CenterY)-(CenterX - Size * 6 / 2, CenterY + Size * 6 / 2), vbBlue
Line (CenterX, CenterY - Size * 6)-(CenterX - Size * 6 / 2, CenterY + Size * 6 / 2 - Size * 6), vbBlue
Line (CenterX + 1, CenterY - 1)-(CenterX + Size * 6 - 1, CenterY - Size * 6 + 1), RGB(0, 60, 0), BF
For i = 1 To Size * 6 / 2 - 1
Line (CenterX - i + 1, CenterY + i)-(CenterX - i + Size * 6, CenterY + i), RGB(0, 60 + i * 2, 0)
Next
For i = 0 To Size * 6 / 2 - 1
Line (CenterX - i - 1, CenterY + i)-(CenterX - i - 1, CenterY + i - Size * 6 + 1), RGB(0, 60 + i * 2, 0)
Next
Label1.Caption = "X : " & CurX & vbCrLf & "Y : " & CurY & vbCrLf & "Z : " & CurZ & vbCrLf
X = CurX: y = CurY: Z = CurZ
col = 10 + Z * 20
xs = (CenterX + X * Size) - Z * (Size / 2)
Ys = CenterY + Z * (Size / 2)
For i = 0 To Size / 2
Line (xs - i, Ys + i)-(xs - i + Size, Ys + i), vbBlack
Next
Ys = (CenterY - y * Size) + Z * (Size / 2)
Line (xs - Size / 2 + 1, Ys + Size / 2 - 1)-(xs + Size / 2 - 1, Ys - Size / 2 + 1), RGB(col + 120, 0, 0), BF
Line (xs + 1, Ys - 1)-(xs + Size - 1, Ys - Size + 1), RGB(col, 0, 0), BF
For i = 0 To Size / 2
Line (xs - i, Ys + i)-(xs - i + Size, Ys + i), RGB(col + i * 8, 0, 0)
Line (xs - i, Ys + i)-(xs - i, Ys + i - Size), RGB(col + i * 8, 0, 0)
Line (xs - i + Size, Ys + i)-(xs - i + Size, Ys + i - Size), RGB(col + i * 8, 0, 0)
Next
Line (CenterX - Size * 6 / 2, CenterY + Size * 6 / 2)-(CenterX + Size * 6 / 2, CenterY - Size * 6 / 2), vbBlue, B
Line (CenterX + Size * 6, CenterY)-(CenterX + Size * 6 - Size * 6 / 2, CenterY + Size * 6 / 2), vbBlue
Line (CenterX + Size * 6, CenterY - Size * 6)-(CenterX + Size * 6 - Size * 6 / 2, CenterY + Size * 6 / 2 - Size * 6), vbBlue
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyLeft
If CurX > 0 Then
EraseBlock
CurX = CurX - 1
DrawBlock
End If
Case vbKeyRight
If CurX < 5 Then
EraseBlock
CurX = CurX + 1
DrawBlock
End If
Case vbKeyUp
If Shift = 0 Then
If CurY < 5 Then
EraseBlock
CurY = CurY + 1
DrawBlock
End If
ElseIf Shift = 1 Then
If CurZ > 0 Then
EraseBlock
CurZ = CurZ - 1
DrawBlock
End If
End If
Case vbKeyDown
If Shift = 0 Then
If CurY > 0 Then
EraseBlock
CurY = CurY - 1
DrawBlock
End If
ElseIf Shift = 1 Then
If CurZ < 5 Then
EraseBlock
CurZ = CurZ + 1
DrawBlock
End If
End If
End Select
End Sub

Private Sub Form_Load()
Me.ScaleMode = 3
Me.AutoRedraw = True
Move 0, 0, Screen.Width, Screen.Height
Show
CenterX = ScaleWidth / 4
CenterY = ScaleHeight / 1.5
DrawBlock
End Sub

Go Back