elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Trabajando con las ramas de git (tercera parte)


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [Source] Fireworks - Lanza petardos y cohetes en VB6
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Source] Fireworks - Lanza petardos y cohetes en VB6  (Leído 4,403 veces)
Mad Antrax
Colaborador
***
Desconectado Desconectado

Mensajes: 2.166


Cheats y Trainers para todos!


Ver Perfil WWW
[Source] Fireworks - Lanza petardos y cohetes en VB6
« en: 15 Julio 2007, 18:30 pm »

Precioso efecto para añadir en nuestro "About Dialog Box" de cualquier aplicación. Lanza petardos y cohetes de forma aleatória y con colores. Utiliza AlphaBending para simular efecto de "petardo"



Ojo, el source no es mio, lo encontré en www.pscode.com como un screensaver, he tenido que modificar bastante el código para dejarlo limpio y listo para usarlo. Sencillamente precioso, no utiliza librerías de DX7 ni DLL''s ni OCX''s

Código
  1. Private Type Particle
  2.    X As Single
  3.    Y As Single
  4.    Xv As Single
  5.    Yv As Single
  6.    Life As Integer
  7.    Dead As Boolean
  8.    Color As Long
  9. End Type
  10.  
  11. Private Type FireWork
  12.    X As Single
  13.    Y As Single
  14.    Height As Integer
  15.    Color As Long
  16.    Exploded As Boolean
  17.    P() As Particle
  18. End Type
  19.  
  20. Private Type BLENDFUNCTION
  21.  BlendOp As Byte
  22.  BlendFlags As Byte
  23.  SourceConstantAlpha As Byte
  24.  AlphaFormat As Byte
  25. End Type
  26.  
  27. Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hDC As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hDC As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT As Long) As Long
  28. Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long)
  29. Private Declare Function SetPixelV Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
  30.  
  31. Dim BF As BLENDFUNCTION
  32. Dim lBF As Long
  33.  
  34. Dim FW() As FireWork
  35. Dim FWCount As Integer
  36. Dim RocketSpeed As Integer
  37.  
  38. Private Sub StartFireWork()
  39.    For i = 0 To FWCount
  40.        If FW(i).Y = -1 Then
  41.            GoTo MAKEFIREWORK
  42.        End If
  43.    Next i
  44.  
  45.    FWCount = FWCount + 1
  46.  
  47.    ReDim Preserve FW(FWCount)
  48.    i = FWCount
  49.  
  50. MAKEFIREWORK:
  51.  
  52.    FW(i).X = Int(Rnd * Me.ScaleWidth)
  53.    FW(i).Y = Me.ScaleHeight
  54.    FW(i).Height = Rnd * Me.ScaleHeight
  55.    FW(i).Color = Int(Rnd * vbWhite)
  56.    FW(i).Exploded = False
  57.    ReDim FW(i).P(10)
  58. End Sub
  59.  
  60. Private Sub DrawFireWork(tFW As FireWork)
  61.    Dim DeadCount As Integer
  62.    Dim RndSpeed As Single
  63.    Dim RndDeg As Single
  64.  
  65.    With tFW
  66.        If .Exploded Then
  67.            For i = 0 To UBound(.P)
  68.                If .P(i).Life > 0 Then
  69.                    .P(i).Life = .P(i).Life - 1
  70.                    .P(i).X = .P(i).X + .P(i).Xv
  71.                    .P(i).Y = .P(i).Y + .P(i).Yv
  72.                    .P(i).Xv = .P(i).Xv / 1.05
  73.                    .P(i).Yv = .P(i).Yv / 1.05 + 0.05
  74.                    PSet (.P(i).X, .P(i).Y), .P(i).Color
  75.                ElseIf .P(i).Life > -40 Then
  76.                    .P(i).Life = .P(i).Life - 1
  77.                    .P(i).X = .P(i).X + .P(i).Xv + (0.5 - Rnd)
  78.                    .P(i).Y = .P(i).Y + .P(i).Yv + 0.1
  79.                    .P(i).Xv = .P(i).Xv / 1.05
  80.                    .P(i).Yv = .P(i).Yv
  81.                    SetPixelV Me.hDC, .P(i).X, .P(i).Y, .P(i).Color
  82.                Else
  83.                    .P(i).Dead = True
  84.                    DeadCount = DeadCount + 1
  85.                End If
  86.            Next i
  87.  
  88.            If DeadCount >= UBound(.P) Then
  89.                .Y = -1
  90.            End If
  91.        Else
  92.            .Y = .Y - RocketSpeed
  93.            If .Y < .Height Then
  94.                Dim ExplosionShape As Integer
  95.  
  96.                ExplosionShape = Int(Rnd * 6)
  97.  
  98.                Select Case ExplosionShape
  99.                    Case 0 ''Regular
  100.                        ReDim .P(Int(Rnd * 100) + 100)
  101.  
  102.                        For i = 0 To UBound(.P)
  103.                            .P(i).X = .X
  104.                            .P(i).Y = .Y
  105.                            .P(i).Life = Int(Rnd * 20) + 20
  106.  
  107.                            RndSpeed = (Rnd * 5)
  108.                            RndDeg = (Rnd * 360) / 57.3
  109.  
  110.                            .P(i).Xv = RndSpeed * Cos(RndDeg)
  111.                            .P(i).Yv = RndSpeed * Sin(RndDeg)
  112.                            .P(i).Color = .Color
  113.                        Next i
  114.  
  115.                        .Exploded = True
  116.                    Case 1 ''Smilely
  117.                        ReDim .P(35)
  118.                        ReDim .P(50)
  119.                        ReDim .P(52)
  120.  
  121.                        For i = 0 To 35
  122.                            .P(i).X = .X
  123.                            .P(i).Y = .Y
  124.                            .P(i).Life = 50
  125.  
  126.                            .P(i).Xv = 3 * Cos(((360 / 35) * (i + 1)) / 57.3)
  127.                            .P(i).Yv = 3 * Sin(((360 / 35) * (i + 1)) / 57.3)
  128.                            .P(i).Color = .Color
  129.                        Next i
  130.  
  131.                        For i = 36 To 50
  132.                            .P(i).X = .X
  133.                            .P(i).Y = .Y
  134.                            .P(i).Life = 50
  135.  
  136.                            .P(i).Xv = 2 * Cos(((360 / 35) * i + 15) / 57.3)
  137.                            .P(i).Yv = 2 * Sin(((360 / 35) * i + 15) / 57.3)
  138.                            .P(i).Color = .Color
  139.                        Next i
  140.  
  141.                        With .P(51)
  142.                            .X = tFW.X
  143.                            .Y = tFW.Y
  144.                            .Life = 50
  145.                            .Xv = 2 * Cos(-55 / 57.3)
  146.                            .Yv = 2 * Sin(-55 / 57.3)
  147.                            .Color = tFW.Color
  148.                        End With
  149.  
  150.                        With .P(52)
  151.                            .X = tFW.X
  152.                            .Y = tFW.Y
  153.                            .Life = 50
  154.                            .Xv = 2 * Cos(-125 / 57.3)
  155.                            .Yv = 2 * Sin(-125 / 57.3)
  156.                            .Color = tFW.Color
  157.                        End With
  158.  
  159.                        .Exploded = True
  160.                    Case 2 ''Star
  161.                        ReDim .P(50)
  162.  
  163.                        RndDeg = Int(360 * Rnd)
  164.  
  165.                        For i = 0 To UBound(.P)
  166.                            .P(i).X = .X
  167.                            .P(i).Y = .Y
  168.                            .P(i).Life = 50
  169.  
  170.                            .P(i).Xv = (i * 0.1) * Cos(((360 / 5) * (i + 1) + RndDeg) / 57.3)
  171.                            .P(i).Yv = (i * 0.1) * Sin(((360 / 5) * (i + 1) + RndDeg) / 57.3)
  172.                            .P(i).Color = .Color
  173.                        Next i
  174.  
  175.                        .Exploded = True
  176.                    Case 3 ''Spiral
  177.                        ReDim .P(50)
  178.  
  179.                        RndDeg = (360 * Rnd)
  180.  
  181.                        For i = 0 To UBound(.P)
  182.                            .P(i).X = .X
  183.                            .P(i).Y = .Y
  184.                            .P(i).Life = 50
  185.  
  186.                            .P(i).Xv = (i * 0.1) * Cos(((360 / 25) * (i + 1) + RndDeg) / 57.3)
  187.                            .P(i).Yv = (i * 0.1) * Sin(((360 / 25) * (i + 1) + RndDeg) / 57.3)
  188.                            .P(i).Color = .Color
  189.                        Next i
  190.  
  191.                        .Exploded = True
  192.                    Case 4 ''Regular Random
  193.  
  194.                        ReDim .P(Int(Rnd * 100) + 100)
  195.  
  196.                        For i = 0 To UBound(.P)
  197.                            .P(i).X = .X
  198.                            .P(i).Y = .Y
  199.                            .P(i).Life = Int(Rnd * 20) + 20
  200.  
  201.                            RndSpeed = (Rnd * 5)
  202.                            RndDeg = (Rnd * 360) / 57.3
  203.  
  204.                            .P(i).Xv = RndSpeed * Cos(RndDeg)
  205.                            .P(i).Yv = RndSpeed * Sin(RndDeg)
  206.                            .P(i).Color = Int(Rnd * vbWhite)
  207.                        Next i
  208.  
  209.                        .Exploded = True
  210.                End Select
  211.            Else
  212.                SetPixelV Me.hDC, .X, .Y, vbWhite
  213.            End If
  214.        End If
  215.    End With
  216. End Sub
  217.  
  218. Private Sub Form_KeyPress(KeyAscii As Integer)
  219.    End
  220. End Sub
  221.  
  222. Private Sub Form_Load()
  223.    Randomize
  224.  
  225.    RocketSpeed = Int(Rnd * 4) + 2
  226.    FWCount = -1
  227.  
  228.    BF.BlendOp = &H0
  229.    BF.BlendFlags = 0
  230.    BF.AlphaFormat = 0
  231. End Sub
  232.  
  233. Private Sub Timer1_Timer()
  234.    For i = 0 To FWCount
  235.        DrawFireWork FW(i)
  236.    Next i
  237.  
  238.    RtlMoveMemory lBF, BF, 4
  239.    AlphaBlend Me.hDC, 0, 0, Me.ScaleWidth, Me.ScaleHeight, Picture1.hDC, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, lBF
  240.    Me.Refresh
  241. End Sub
  242.  
  243. Private Sub Timer2_Timer()
  244.    StartFireWork
  245.    BF.SourceConstantAlpha = Int(Rnd * 25)
  246.    Timer2.Interval = Int(Rnd * 500)
  247.    Label1.ForeColor = FW(i).Color
  248. End Sub
  249.  
  250.  

Download only for registered users!


En línea

No hago hacks/cheats para juegos Online.
Tampoco ayudo a nadie a realizar hacks/cheats para juegos Online.
d(-_-)b


Desconectado Desconectado

Mensajes: 1.331



Ver Perfil WWW
Re: [Source] Fireworks - Lanza petardos y cohetes en VB6
« Respuesta #1 en: 15 Julio 2007, 19:22 pm »

Gracias ||MadAntrax|| Buen code,...Precioso..

Saludos...


En línea

Max 400; caracteres restantes: 366
Red Mx
Rojito
Colaborador
***
Desconectado Desconectado

Mensajes: 3.649


Viva México Cabrones...


Ver Perfil WWW
Re: [Source] Fireworks - Lanza petardos y cohetes en VB6
« Respuesta #2 en: 15 Julio 2007, 19:26 pm »

Interesante , yo tengo algo parecido pero simula una lluvia de estrellas
En línea

Desarrollar Malware Es Causa De Cancer...
Karcrack


Desconectado Desconectado

Mensajes: 2.416


Se siente observado ¬¬'


Ver Perfil
Re: [Source] Fireworks - Lanza petardos y cohetes en VB6
« Respuesta #3 en: 15 Julio 2007, 19:56 pm »

Joder Mad, no paras :P.
Red Mx podrias postearlo? Gracias  ;D

Karcrack
En línea

3k1n0x


Desconectado Desconectado

Mensajes: 324



Ver Perfil
Re: [Source] Fireworks - Lanza petardos y cohetes en VB6
« Respuesta #4 en: 15 Julio 2007, 21:20 pm »

jejeje esta muy bonito gracias x el code  ;D
En línea

T3fL0n -> 3k1n0x
Red Mx
Rojito
Colaborador
***
Desconectado Desconectado

Mensajes: 3.649


Viva México Cabrones...


Ver Perfil WWW
Re: [Source] Fireworks - Lanza petardos y cohetes en VB6
« Respuesta #5 en: 16 Julio 2007, 01:20 am »

Joder Mad, no paras :P.
Red Mx podrias postearlo? Gracias  ;D

Karcrack

Claro aqui esta cabe señalar que el code no es mio pero no esta dificil

http://mx.geocities.com/winrar_center/lluviaestrellas.zip
En línea

Desarrollar Malware Es Causa De Cancer...
Nork

Desconectado Desconectado

Mensajes: 196



Ver Perfil
Re: [Source] Fireworks - Lanza petardos y cohetes en VB6
« Respuesta #6 en: 16 Julio 2007, 13:50 pm »

Me gusto mucho el efecto, gracias!!
En línea

C' Est La Vie
Freeze.


Desconectado Desconectado

Mensajes: 2.732



Ver Perfil WWW
Re: [Source] Fireworks - Lanza petardos y cohetes en VB6
« Respuesta #7 en: 16 Julio 2007, 19:09 pm »

Mad buen code pero muy lento jejejeje eso hay q modificarlo...

RedMx Buen Code ese gusta bastante ajajajaja
En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Una aplicación israelí rastrea y advierte de ataques con cohetes desde la ...
Noticias
wolfbcn 1 1,474 Último mensaje 15 Julio 2014, 23:01 pm
por crazykenny
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines