Hola:
Aka les dejo mi ultimo proyecto estaba al p2 como siempre en la escuela y se me ocurrió.
Y aka les dejo todo el código.
'------------------------------->
'Agregar controles: |
'1 HScrollbar llamado HScroll1 |
'2 CheckBox: Check1,Check2 |
'2 Trimer: Trimer1,Trimer2 |
'y pegar este code en el formx |
'------------------------------->
Private Const PIE = 3.14159265 / 100 'el nº 100 es el que multiplicado por dos da las dicviciones que tiene una buelta
Private Th As Single 'variable que almasena el angulo
Private R2 As Single 'radio de la sircunferencia
'algirar la pirame, los puntos de la base siguen una circunferencia
'las siguientes variables son el centro de dicha circunferencia
Private Lx2 As Single
Private Ly2 As Single
'esta pequeña funcion es la encargada de pasar _
del sistyema tridimencional z;x;y a el que nos brionda vb x;y.
Private Sub PL(z As Long, x As Long, y As Long, z1 As Long, x1 As Long, y1 As Long, Optional a As Integer = 45)
'si somos un poco observadores el eje z es una line inclinada a un angulo w que forma un *triangulo* con x y y
'
' | +y | +y
' | /+z | /+z
' | / | /
' | / | /|
' | / | / |
' |/___________ |/__|_______
' +x +x
'
'esta funcion se basa en eso.
Dim zz As Long, zz1 As Long, x2 As Long, y2 As Long, y11 As Long, x11 As Long, a1 As Integer
If a > 89 Then MsgBox "ERROR: variable exedida de valor", vbCritical, "FATAL-ERROR!!|"
'calcula el angulo
' __ __ o
'a= angulo de go;gl /|
a1 = 90 - a ' __ __ / |
'a1= angulo de gl,ol / |
' g /___| l
'estas dos lineas son para que se vea real.
'en este ejemplo labase es un cuadrado y se ve bien
'prueven sacando los multiplicadores "*0.5"
zz = z * 0.5
zz1 = z1 * 0.5
'calcula x e y, con la funcion trigonometrica seno aplicando el teorema del seno
x2 = (Sin(a) * zz) + x
x11 = (Sin(a) * zz1) + x1
y2 = (Sin(a1) * zz) + y
y11 = (Sin(a1) * zz1) + y1
'dibuja la linea invertiendo el eje y
Me.Line (x2, Me.Height / 15 - y2)-(x11, Me.Height / 15 - y11)
End Sub
Private Sub Check2_Click() 'no se explica.
If Timer2.Enabled = False Then
Timer2.Enabled = True
Else
Timer2.Enabled = False
End If
End Sub
Private Sub Form_Load() 'prepara todo.
R2 = 100
Lx2 = 150
Ly2 = 150
configurarControles
Me.BackColor = vbBlack
Me.AutoRedraw = True
Me.ScaleMode = 3
Me.Caption = "Piramide 3D"
End Sub
Private Sub configurarControles()
Check2.BackColor = vbBlack
Check1.BackColor = vbBlack
Check2.ForeColor = vbWhite
Check1.ForeColor = vbWhite
Check2.Caption = "Timer2.Enabled=False"
Check1.Caption = "Me.Cls"
HScroll1.Max = 1000
HScroll1.Value = 1
HScroll1.Min = 1
End Sub
Private Sub HScroll1_Change() 'cambia velocidad
Timer1.Interval = HScroll1.Value
End Sub
Private Sub HScroll1_Scroll() 'cambia velocidad
Timer1.Interval = HScroll1.Value
End Sub
Private Sub Timer1_Timer() 'calcula los puntos y los dibuja.
Dim x As Long, y As Long, x1 As Long, y1 As Long, x2 As Long, y2 As Long, x3 As Long, y3 As Long
Th = Th + PIE 'angulo++
'establesen a x,x1,y,y1 sus balores correspondientes en la circunferencia
x = Lx2 + Cos(Th) * R2
y = Ly2 + Sin(Th) * R2
x1 = Lx2 - Cos(Th) * R2
y1 = Ly2 - Sin(Th) * R2
x2 = Lx2 + Cos(Th - PIE * 250) * R2 'el nº 250 separa los dos pares de puntos de la base
y2 = Ly2 + Sin(Th - PIE * 250) * R2 'que comparten un eje en comun
x3 = Lx2 - Cos(Th - PIE * 250) * R2
y3 = Ly2 - Sin(Th - PIE * 250) * R2
DoEvents
If Check1.Value Then Me.Cls 'si esta activado borra el dibujo del form
'<piramide
'manda a pintar las lineas de la base
Me.ForeColor = &HFF0000 'cambia color a azul
PL x1, y1, 100, x2, y2, 100
PL x2, y2, 100, x, y, 100
PL x, y, 100, x3, y3, 100
PL x3, y3, 100, x1, y1, 100
'manda a pintar las lineas que unen la base de la piramide con la punta
PL x1, y1, 100, 175, 125, 200
PL x2, y2, 100, 175, 125, 200
PL x3, y3, 100, 175, 125, 200
PL x, y, 100, 175, 125, 200
'piramide>
Me.ForeColor = 16777215 'cambia color a blanco
Me.CurrentX = 100
Me.CurrentY = 10
Me.Print "made by <[(x)]>" 'firma
Me.CurrentX = 30
Me.CurrentY = Me.Height / 15 - 80
Me.Print "Intervalo: " & HScroll1.Value & " mili(s) segundo(s)." 'dato extra
'piramide>
Me.Refresh 'refresca el form
End Sub
Private Sub Timer2_Timer() 'no se explica.
If Check1.Value = 1 Then
Check1.Value = 0
Else
Check1.Value = 1
End If
End Sub
' se termino
Si alguien ve algo que este mal o pueda y tenga ganas de perfeccionarlo les agradecería que lo haga.
Y para el que no entiende la forma en que lo programe are el esfuerzo por explicarlo, aunque creo que esta bastante claro.
chauchass...!|<[(x)]>|!
<[(modificado)]>
yo no veo nada... :xD
mmm
a me falto decirles que pongan la propiedad autoredraw del fom en true.
(modifi)
JAJA tienen, coco tenes razon pasenlo a escala plixel.
esta bien pero es muy chiquito
saludos
muy muy bueno... nunca habia visto algo asi (excepto en el protector de pantalla claro xD)
xD 10 ja
aun que si uno en realidad desea manejar perfectamente graficos 3D esta OpenGl o DirectX (susderivados como 3D o Draw xp para 2D)
Está bien el ejemplo, a mí me ha gustado. Pero te recomendaría que siguieses algunas normas de estilo: que indentes un poco tu código, que dejes algunas líneas en blanco de separación para procesos diferentes y sigas más o menos un esquema de forma sistemática porque sino es un lío para la persona que lee el código.
Un saludo!
a mi tambien me ha gustado mucho, voy a guardar tu source, eso es lo bueno de estudiar las matematicas, porque se pueden aplicar en distintas cosas....
Saludos
Cita de: Spider-Net en 5 Noviembre 2008, 12:17 PM
Está bien el ejemplo, a mí me ha gustado. Pero te recomendaría que siguieses algunas normas de estilo: que indentes un poco tu código, que dejes algunas líneas en blanco de separación para procesos diferentes y sigas más o menos un esquema de forma sistemática porque sino es un lío para la persona que lee el código.
Un saludo!
totalmente de acuerdo...
si a mi tb me cuesta mucho entenderlo xD... me gustaria q lo expliques :P:P
Pues miren este plano:
Solo agreguen un Timer al Form: Timer1
Y peguen este code.
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
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.
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!
;D ;D ;D ;D ;D ;D ;D ;D ;D ;D ;D ;D ;D ;D ;D ;D ;D
Muy bueno el code :o :o!!
PD:ambos codes estan curiosos :P
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...
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
:o mu mu weno, mis felicitaciones, lamentable mi cerebro no deja entrar números, jaja, soy nulo en las maths..... :P
:laugh: SALUDOS :laugh:
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