CodeItBetter Programming Another VB Programming Blog

'Graphics - How to move 3D Cube on form

'Add a 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.

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()
    Dim I As Integer
    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 I
End Sub
 
Public Sub DrawBlock()
    Dim I As Integer
    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 I
    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 I
    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 I
    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 I
    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
    Call DrawBlock
End Sub