'#########################################
'                                               ## Teoria ##
'La idea se basa en hacer girar un cuadrado sobre su eje
'Si tenemos dos cuadrados girando a la vez, seria como tener las dos tapas (superior e inferior) del cubo
'para ello haremos uso de coordenadas Polares, para poder propiciar el giro
'Debemos saber que un punto se puede ubicar de varias formas:
'1: Conociendo la posicion en X, y en Y
'2: Conociendo el Angulo y el Radio (Coordenadas Polares), esto usaremos para ubicar cada punto
 
'Si un cuadrado gira sobre su eje, existe una distancia del punto al eje, esto sera nuestro RADIO;
'por lo cual cada punto en movimiento  describira una circunferencia (su trayectoria)
'o una elipse dependiendo de como se mire
 
'Controles: un Timer 
'by Jackl007!
'#########################################
Const PI = 3.141592654
 
Dim Inter As Integer 'Intervalo del Angulo
 
Function AngRad(ByVal a As Double) As Double
'Esta funcion convierte un Angulo Decimal a un angulo en radianes,
'recordar que necesitamos hacer dicho cambio para poder trabajar con los incrementos
'ya que la funcion seno, y coseno recibe en RADIANES
AngRad = (a * PI / 180)
End Function
 
Private Sub Form_Load()
Inter = 0
Me.AutoRedraw = True
Me.BackColor = vbBlack
Me.Height = 6180
Me.Width = 6180
Timer.Interval = 100
 
Scale (-50, 50)-(50, -50) 'Mi escala, en X y en Y normal
 
End Sub
 
Private Sub Timer_Timer()
Cls 'Colocarlo y quitarlo para probar distintos efectos
'recordamos que inter es el ANGULO
 
'##############################
Cubo 30, 15, 0, 0, Inter   'El 30 : radio 1, 15 = radio dos, 0 =eje x, 0 = eje y
Line (0, 40)-(0, 15), vbRed
Line (0, 15)-(0, -15), vbGreen
Line (0, -15)-(0, -40), vbRed
'##############################
 
'Algunos ejemplos Mas...
'#########################################
'Rotar cuadrados en su mismo eje; probar ambas sentencias de este bloque a la vez
'El cero, cero: POSICION
'Rectangulo 30, 30, 0, 0, Inter
'Rectangulo 30, 30, 0, 0, Inter + 20
'Rectangulo 30, 30, 0, 0, Inter + 40
'Rectangulo 30, 30, 0, 0, Inter + 60
'Rectangulo 30, 30, 0, 0, Inter + 80
'#########################################
'#########################################
'Conociendo a un Cuadrado
'Cuadrado 25, 0, 0, 0 'el ultimo parametro es el ANGULO DE INCLINACION
'Cuadrado 25, 0, 0, 45
'Cuadrado 25, 0, 0, 70
'#########################################
 
 
Inter = Inter + 10 'Incremento del Angulo
 
End Sub
Sub Cubo(ByVal R1 As Double, ByVal R2 As Double, ByVal eX As Double, ByVal eY As Double, ByVal Ang As Double)
'R1 = Radio 1 (el algoritmo calcula los giros del cubo en base al radio de una circunferencia circunscrita en el cuadrado
'R2 = radio 2
'eX = Posicion en eje X
'eY = Posicion en eje x
'Ang = angulo de inclinacion, respecto a la horizontal
Dim a, i As Integer
Dim xA, xB, yA, yB As Double 'variables para guardar las posiciones temporales
 
a = Ang + 45 'inclinacion entre cada radio
i = a
'Cambiamos a sistema de coordenadas polares
    For i = a To a + 360 Step 90
        If i = a Then
            xA = R1 * Cos(AngRad(i)) + eX
            yA = R2 * Sin(AngRad(i)) + R1 / 2 + eY
            xB = R1 * Cos(AngRad(i)) + eX
            yB = R2 * Sin(AngRad(i)) - R1 / 2 + eY
        Else
         Line (xA, yA)-(R1 * Cos(AngRad(i)) + eX, R2 * Sin(AngRad(i)) + R1 / 2 + eY), &HE0E0E0
         Line (xB, yB)-(R1 * Cos(AngRad(i)) + eX, R2 * Sin(AngRad(i)) - R1 / 2 + eY), &HE0E0E0
         xA = R1 * Cos(AngRad(i)) + eX
         yA = R2 * Sin(AngRad(i)) + R1 / 2 + eY
         xB = R1 * Cos(AngRad(i)) + eX
         yB = R2 * Sin(AngRad(i)) - R1 / 2 + eY
         Line (xA, yA)-(xB, yB), &HE0E0E0 'Esto dibuja las lineas entre las tapas laterales
         'quitarlo y probar los efectos
 
        End If
 
 
Next i
 
End Sub
Sub Rectangulo(ByVal R1 As Double, ByVal R2 As Double, ByVal eX As Double, ByVal eY As Double, ByVal Ang As Double)
 
Dim a, i As Integer
a = Ang + 45
i = a
    For i = a To a + 360 Step 90
        If i = a Then
            CurrentX = R1 * Cos(AngRad(i)) + eX
            CurrentY = R2 * Sin(AngRad(i)) + eY
    Else
        Line -(R1 * Cos(AngRad(i)) + eX, R2 * Sin(AngRad(i)) + eY), &HE0E0E0
    End If
Next i
 
End Sub
Sub Cuadrado(ByVal R As Double, ByVal eX As Double, ByVal eY As Double, ByVal Ang As Double)
 
Dim a, i As Integer
a = Ang + 45
i = a
    For i = a To a + 360 Step 90
        If i = a Then
            CurrentX = R * Cos(AngRad(i)) + eX
            CurrentY = R * Sin(AngRad(i)) + eY
    Else
        Line -(R * Cos(AngRad(i)) + eX, R * Sin(AngRad(i)) + eY), &HE0E0E0
    End If
Next i
 
End Sub