Sección de códigos , trucos y ejemplos para visual basic

429 - Efecto mapa tridimensional

Contenido

Plano animado 3D
Efecto de estelas
Relacionados

Plano animado 3D

Recurso enviado por Luis Nuñez de un mapa o plano animado tridimensional

El ejemplo es una animación realizada mediante los métodos gráficos de visual basic, ( con el método Line), que dibuja el efecto en el formulario con la pantalla maximizada

Captura de pantalla

vista pervia del formulario con el efecto del mapa tridimensional

Colocar en un form un control timer llamado Timer1 , y al formulario establecerle el BorderStyle en 0

Código fuente

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 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

Efecto de estelas

Este otro ejemplo también enviado por Luis Nuñez, hace un efecto de movimiento de estelas con colores aleatorios en el form

Captura de pantalla

Al igual que en otro ejemplo, se debe colocar un timer

Código fuente

Option Explicit Private Type Linea X1 As Single Y1 As Single X2 As Single Y2 As Single End Type Private Type Estela incX1 As Integer incY1 As Integer incX2 As Integer incY2 As Integer Red As Single Green As Single Blue As Single Lineas(1 To 100) As Linea End Type Private Estelas() As Estela Private Sub CreaEstela(Est As Estela) Dim auxI As Integer With Est .Red = 2.55 * Int(Rnd * 100 + 1) .Green = 2.55 * Int(Rnd * 100 + 1) .Blue = 2.55 * Int(Rnd * 100 + 1) .incX1 = 15 * Int(Rnd * 3 + 1) .incY1 = 15 * Int(Rnd * 3 + 1) .incX2 = 15 * Int(Rnd * 3 + 1) .incY2 = 15 * Int(Rnd * 3 + 1) .Lineas(1).X1 = Me.Width * Rnd .Lineas(1).Y1 = Me.Height * Rnd .Lineas(1).X2 = Me.Width * Rnd .Lineas(1).Y2 = Me.Height * Rnd For auxI = 2 To 100 .Lineas(auxI).X1 = .Lineas(1).X1 .Lineas(auxI).Y1 = .Lineas(1).Y1 .Lineas(auxI).X2 = .Lineas(1).X2 .Lineas(auxI).Y2 = .Lineas(1).Y2 Next auxI End With End Sub Private Sub DibujaEstela(Est As Estela) Dim auxI As Integer With Est Me.Line (.Lineas(100).X1, .Lineas(100).Y1)- _ (.Lineas(100).X2, .Lineas(100).Y2), Me.BackColor .Lineas(100).X1 = .Lineas(99).X1 .Lineas(100).Y1 = .Lineas(99).Y1 .Lineas(100).X2 = .Lineas(99).X2 .Lineas(100).Y2 = .Lineas(99).Y2 For auxI = 99 To 2 Step -1 Me.Line (.Lineas(auxI).X1, .Lineas(auxI).Y1)- _ (.Lineas(auxI).X2, .Lineas(auxI).Y2), _ RGB(.Red - .Red / 100 * auxI, .Green - .Green / 100 * auxI, _ .Blue - .Blue / 100 * auxI) .Lineas(auxI).X1 = .Lineas(auxI - 1).X1 .Lineas(auxI).Y1 = .Lineas(auxI - 1).Y1 .Lineas(auxI).X2 = .Lineas(auxI - 1).X2 .Lineas(auxI).Y2 = .Lineas(auxI - 1).Y2 Next auxI If .Lineas(1).X1 + .incX1 > Me.Width Or .Lineas(1).X1 + .incX1 < 0 Then _ .incX1 = IIf(.incX1 < 0, 1, -1) * 15 * Int(Rnd * 3 + 1) If .Lineas(1).Y1 + .incY1 > Me.Height Or .Lineas(1).Y1 + .incY1 < 0 Then _ .incY1 = IIf(.incY1 < 0, 1, -1) * 15 * Int(Rnd * 3 + 1) If .Lineas(1).X2 + .incX2 > Me.Width Or .Lineas(1).X2 + .incX2 < 0 Then _ .incX2 = IIf(.incX2 < 0, 1, -1) * 15 * Int(Rnd * 3 + 1) If .Lineas(1).Y2 + .incY2 > Me.Height Or .Lineas(1).Y2 + .incY2 < 0 Then _ .incY2 = IIf(.incY2 < 0, 1, -1) * 15 * Int(Rnd * 3 + 1) Me.Line (.Lineas(1).X1, .Lineas(1).Y1)-(.Lineas(1).X2, .Lineas(1).Y2), _ RGB(.Red, .Green, .Blue) .Lineas(1).X1 = .Lineas(1).X1 + .incX1 .Lineas(1).Y1 = .Lineas(1).Y1 + .incY1 .Lineas(1).X2 = .Lineas(1).X2 + .incX2 .Lineas(1).Y2 = .Lineas(1).Y2 + .incY2 End With End Sub Private Sub Form_DblClick() Call Form_Load End Sub Private Sub Form_Load() Dim auxI As Integer Me.BackColor = 0 Timer1.Interval = 10 Randomize Me.Cls ReDim Estelas(1 To Int(Rnd * 5 + 1)) For auxI = 1 To UBound(Estelas) Call CreaEstela(Estelas(auxI)) Next auxI End Sub Private Sub Timer1_Timer() Dim auxI As Integer On Error Resume Next For auxI = 1 To UBound(Estelas) Call DibujaEstela(Estelas(auxI)) DoEvents Next auxI On Error GoTo 0 End Sub

Recursos vb.net - Relacionados

Dibujar líneas y figuras mediante el GDI con la clase Graphics

Recursos vb 6.0

Buscar en Recursos vb