Pirámide 3D sin usar apis

[ssccaann43 ©]

Pues miren este plano:

Solo agreguen un Timer al Form: Timer1

Y peguen este code.

Código (vb) [Seleccionar] Expandir


Option Explicit

Dim X As Integer, s As Integer
Dim max As Boolean
Dim A As Integer

Private Type Punto
    X       As Single
    Y       As Single
    IncX    As Double
    IncY    As Double
End Type

Private Matriz(1 To 2, 1 To 2) As Punto

Private Declare Function SetWindowPos Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal hWndInsertAfter As Long, _
    ByVal X As Long, _
    ByVal Y As Long, _
    ByVal cx As Long, _
    ByVal cy As Long, _
    ByVal wFlags As Long) As Long

Private Const SW_SHOWNOACTIVATE = 4
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_NOACTIVATE = &H10
Private Sub DibujaPlanos()
    Dim auxX    As Integer
    Dim auxY    As Integer
    Dim auxI    As Integer
    Dim auxJ    As Integer
    Dim P1      As Punto
    Dim P2      As Punto
    Dim P3      As Punto
    Dim P4      As Punto

    For auxX = 1 To UBound(Matriz, 1) - 1
        For auxY = 1 To UBound(Matriz, 2) - 1
            P1 = Matriz(auxX, auxY)
            P2 = Matriz(auxX + 1, auxY)
            P3 = Matriz(auxX + 1, auxY + 1)
            P4 = Matriz(auxX, auxY + 1)
            Line (P1.X, P1.Y)-(P2.X, P2.Y), vbGreen
            Line (P2.X, P2.Y)-(P3.X, P3.Y), vbGreen
            Line (P3.X, P3.Y)-(P4.X, P4.Y), vbGreen
            Line (P4.X, P4.Y)-(P1.X, P1.Y), vbGreen
            auxJ = 10
            For auxI = 1 To auxJ
                Line (P1.X + (P2.X - P1.X) * (auxI / auxJ), _
                      P1.Y + (P2.Y - P1.Y) * (auxI / auxJ))- _
                      (P4.X + (P3.X - P4.X) * (auxI / auxJ), _
                      P4.Y + (P3.Y - P4.Y) * (auxI / auxJ)), vbGreen
               
                Line (P2.X + (P3.X - P2.X) * (auxI / auxJ), _
                      P2.Y + (P3.Y - P2.Y) * (auxI / auxJ))- _
                      (P1.X + (P4.X - P1.X) * (auxI / auxJ), _
                      P1.Y + (P4.Y - P1.Y) * (auxI / auxJ)), vbGreen
           
            Next auxI
        Next auxY
    Next auxX
End Sub

Private Sub Form_Activate()
   
    Call Form_DblClick
   
End Sub

Private Sub Form_Click()
    End
End Sub


Private Sub Form_DblClick()
    Dim auxX    As Integer
    Dim auxY    As Integer

    'Me.Cls

    For auxX = 1 To UBound(Matriz, 1)
        For auxY = 1 To UBound(Matriz, 2)
            Matriz(auxX, auxY).X = Int(Rnd * (Me.Width - 120))
            Matriz(auxX, auxY).Y = Int(Rnd * (Me.Height - 405))
            'Matriz(auxX, auxY).X = ((Me.Width - 120) \ (UBound(Matriz, 1) - 1)) * (auxX - 1)
            'Matriz(auxX, auxY).Y = ((Me.Height - 405) \ (UBound(Matriz, 2) - 1)) * (auxY - 1)
            Matriz(auxX, auxY).IncX = Int(Rnd * 6) * 15 * IIf(Int(Rnd * 2) = 1, 1, -1)
            Matriz(auxX, auxY).IncY = Int(Rnd * 6) * 15 * IIf(Int(Rnd * 2) = 1, 1, -1)
        Next auxY
    Next auxX

    Call DibujaPlanos

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    End
End Sub

Private Sub Form_Load()
    Me.BackColor = 0
    Me.WindowState = 2
    Timer1.Interval = 1
    Randomize
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'End
End Sub

Private Sub Timer1_Timer()
    Dim auxX    As Integer
    Dim auxY    As Integer
    Dim auxI    As Integer
    Dim auxJ    As Integer
    Dim P1      As Punto
    Dim P2      As Punto
    Dim P3      As Punto
    Dim P4      As Punto

'''    Me.Cls

    For auxX = 1 To UBound(Matriz, 1) - 1
        For auxY = 1 To UBound(Matriz, 2) - 1
            P1 = Matriz(auxX, auxY)
            P2 = Matriz(auxX + 1, auxY)
            P3 = Matriz(auxX + 1, auxY + 1)
            P4 = Matriz(auxX, auxY + 1)
            Line (P1.X, P1.Y)-(P2.X, P2.Y), Me.BackColor
            Line (P2.X, P2.Y)-(P3.X, P3.Y), Me.BackColor
            Line (P3.X, P3.Y)-(P4.X, P4.Y), Me.BackColor
            Line (P4.X, P4.Y)-(P1.X, P1.Y), Me.BackColor
            auxJ = 10
            For auxI = 1 To auxJ
                Line (P1.X + (P2.X - P1.X) * (auxI / auxJ), _
                      P1.Y + (P2.Y - P1.Y) * (auxI / auxJ))- _
                      (P4.X + (P3.X - P4.X) * (auxI / auxJ), _
                      P4.Y + (P3.Y - P4.Y) * (auxI / auxJ)), Me.BackColor
                Line (P2.X + (P3.X - P2.X) * (auxI / auxJ), _
                      P2.Y + (P3.Y - P2.Y) * (auxI / auxJ))- _
                      (P1.X + (P4.X - P1.X) * (auxI / auxJ), _
                       P1.Y + (P4.Y - P1.Y) * (auxI / auxJ)), Me.BackColor
            Next auxI
        Next auxY
    Next auxX

    For auxX = 1 To UBound(Matriz, 1)
        For auxY = 1 To UBound(Matriz, 2)
            If (Matriz(auxX, auxY).X + Matriz(auxX, auxY).IncX) > Me.Width - 120 Then
                Matriz(auxX, auxY).IncX = Matriz(auxX, auxY).IncX * -1
            ElseIf (Matriz(auxX, auxY).X + Matriz(auxX, auxY).IncX) < 0 Then
                Matriz(auxX, auxY).IncX = Matriz(auxX, auxY).IncX * -1
            End If
            Matriz(auxX, auxY).X = Matriz(auxX, auxY).X + Matriz(auxX, auxY).IncX

            If (Matriz(auxX, auxY).Y + Matriz(auxX, auxY).IncY) > Me.Height - 405 Then
                Matriz(auxX, auxY).IncY = Matriz(auxX, auxY).IncY * -1
            ElseIf (Matriz(auxX, auxY).Y + Matriz(auxX, auxY).IncY) < 0 Then
                Matriz(auxX, auxY).IncY = Matriz(auxX, auxY).IncY * -1
            End If
            Matriz(auxX, auxY).Y = Matriz(auxX, auxY).Y + Matriz(auxX, auxY).IncY
        Next auxY
    Next auxX

    Call DibujaPlanos
End Sub




[<[(x)]>]

mm...

Spider-Net:

Como que lo pienso así, se me hace más difícil entenderlo como lo escriben ustedes. y no se me resulta mas fácil escribirlo (menos code=funcionamiento). Los boy haciendo estructurados si son muy complejos.

Tratare de seguir tu consejo, aunque me sea un poko difícil.

vivachapas:

trato...^^^^^^(modifiqueelcodearriba)

ssccaann43

Esta bueno el protector de pantallas.

[‭‭‭‭jackl007]

ssccaann43:
no puedooo creeeer lo que veoooooo, empiezo a soñar con todas las formulas que voy aprendiendooo..
estooo es geniaaaaaaaaaalll!!!!

donde sacaste esoo? tu lo hiciste? cual es el razonamiento del punto de partida?
estoy ansioso por aprender estas cosas, porque toda la matematica se aplica aquii!

[WestOn]

Muy bueno el code !!

PD:ambos codes estan curiosos

[‭‭‭‭jackl007]

Esto da la apariencia de ser una piramide que esta girando.... pruebenlo... en realidad es un cuadrado que gira solo que los vertices los uni conforme se traza cada lado del "cuadrado", asi que da una apariencia de una piramide...

Código (vb) [Seleccionar] Expandir

Const PI = 3.141592654
Public Inter As Integer 'Intervalo del Angulo

Function AngRad(ByVal a As Double) As Double
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

Line (0, 40)-(0, 15), vbRed: Line (0, 15)-(0, -15), vbGreen: Line (0, -15)-(0, -40), vbRed
Triangulo 25, 10, 0, -20, Inter
Inter = Inter + 10 'Incremento del Angulo

End Sub

Sub Triangulo(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
        Line (0, 20)-(R1 * Cos(AngRad(i)) + eX, R2 * Sin(AngRad(i)) + eY), &HE0E0E0
    End If
Next i

End Sub

[SONIC88]

  mu mu weno, mis felicitaciones, lamentable mi cerebro no deja entrar números, jaja, soy nulo en las maths..... 


SALUDOS 

[<[(x)]>]

ES la idea crear una imagen que tenga apariencia de algo tridimencional
porque nunca vas a lograr algo verdaderamente tridimencional.

i en caso que lo hagas explicamecomo...

chaus