Keskustelu: Koodit: VB6: Ilotulitus

Option Explicit
Dim I As Integer, J As Integer, K(19) As Integer 'laskurit
Dim L As Integer, M As Integer, N(19) As Integer
Dim px(19, 29) As Integer, py(19, 29) As Integer 'paikat
Dim qx(19, 99) As Single, qy(19, 99) As Single
Dim si(99) As Single, co(99) As Single  'sin ja cos
Dim a As Single                         'kulma
Dim q As Integer, p As Integer          'laskureita
Dim s As Integer                        'skaalauskerroin
Dim X(29) As Single, Y(29) As Single    'koordinaatit
Dim t(19, 99) As Single, z As Single    'pallon säde
Dim F(19) As Byte                       'tilamuuttuja
Dim r(19, 29) As Byte, g(19, 29) As Byte
Dim b(19, 29) As Byte                   'värit
Dim r0(19) As Byte, g0(19) As Byte
Dim b0(19) As Byte, c(19) As Long
Dim e(19) As Byte, d As Byte            'väriparametrit
Dim vx(29) As Single, vy(29) As Single  'nopeus
Dim dv As Single, v As Single           'nopeuden muutos, nopeus

Private Sub Form_Load()
  ScaleTop = ScaleHeight
  ScaleHeight = -ScaleHeight 'y-aks. käännetään ylösalaisin
  Randomize 'satunnainen viive
  Timer1.Interval = 300 + 1000 * Rnd
  For p = 0 To 99 'lasketaan kulmat, sinit ja cosinit
    a = 0.08 * Atn(1) * p
    si(p) = Sin(a): co(p) = Cos(a)
  Next
End Sub


Private Sub Form_Resize()
  ScaleTop = -ScaleHeight
  s = ScaleTop 'pidetään 0-kohta formin alareunassa
  Cls
End Sub

Private Sub Timer2_Timer()
  For J = 0 To M - 1 'kelataan kaikki raketit
    Select Case F(J)
    Case 1 'nousuvaihe
      v = vy(J) * vy(J) + vx(J) * vx(J) 'nopeuden neliö
      dv = Sqr(Abs(100 - v)) * 0.1 * ScaleTop / 500 * Sgn(25 - v)
      v = Sqr(v) 'nopeus

      'alussa hieman kiihdytystä
      vy(J) = vy(J) + dv * vy(J) / v - 0.03
      'vaakanopeuden vaihtelulla pientä vipotusta
      vx(J) = vx(J) + dv * vx(J) / v + 0.4 * Rnd - 0.2
      px(J, K(J)) = X(J): py(J, K(J)) = Y(J) 'raketin paikka
      r(J, K(J)) = r0(J)
      g(J, K(J)) = g0(J) 'värit
      b(J, K(J)) = b0(J)
      X(J) = X(J) + vx(J): Y(J) = Y(J) + vy(J)
      If Y(J) + X(J) / 2 > s * (0.6 + 2 * Rnd) Then F(J) = 2
    Case 2 To 20
      'sammutellaan nousurakettia
      vy(J) = vy(J) * 0.99 - 0.02
      vx(J) = vx(J) * 0.99 'hidastellaan vauhtia
      v = (35 - F(J)) / 34 'himmennetään valoa
      px(J, K(J)) = X(J): py(J, K(J)) = Y(J)
      r(J, K(J)) = r0(J) * v
      g(J, K(J)) = g0(J) * v
      b(J, K(J)) = b0(J) * v
      X(J) = X(J) + vx(J): Y(J) = Y(J) + vy(J)
      F(J) = F(J) + 1
    Case 21
      'lasketaan pallon elementit
      z = s * (0.15 + 0.05 * Rnd)
      For p = 0 To 99
        t(J, p) = z * Cos(Rnd ^ 2) 'lasketaan pisteitten
        'jakauma pallon pinnalle, ilmeisesti aika oikein näin
        '(tuli mieleen viime yönä)
        qx(J, p) = X(J) + t(J, p) * si(p) / 6 'eka pallo
        qy(J, p) = Y(J) + t(J, p) * co(p) / 6
      Next
      F(J) = 22

    Case 22
      e(J) = 66 * Rnd 'arvotaan väri
      r0(J) = 255 * Abs(si(e(J))) 'lasketaan värikomponentit
      g0(J) = 255 * Abs(si(e(J) + 33))
      d = e(J) + 66 + 100 * (e(J) > 33)
      b0(J) = 255 * Abs(si(d))
      For p = 0 To 99 'posautetaan pallo
        PSet (qx(J, p), qy(J, p)), RGB(r0(J), g0(J), b0(J))
      Next
      F(J) = 23
    Case 23 To 80 'pallo laajenee hidastuen
      a = 1 - 1 / (F(J) - 22) 'laajenemiskerroin
      e(J) = e(J) + 1         'liutetaan väriä
      d = e(J) + 100 * (e(J) > 99)
      r0(J) = 255 * Abs(si(d))
      d = d + 33 + 100 * (d > 66)
      g0(J) = 255 * Abs(si(d))
      d = d + 33 + 100 * (d > 66)
      b0(J) = 255 * Abs(si(d))
      vx(J) = vx(J) * 0.8: vy(J) = vy(J) * 0.8 - 0.1
      X(J) = X(J) + vx(J): Y(J) = Y(J) + vy(J)
      For p = 0 To 99
        PSet (qx(J, p), qy(J, p)), 0 'sammutetaan edellinen
        qx(J, p) = X(J) + t(J, p) * si(p) * a + Rnd - 0.5 'uudet pisteet
        qy(J, p) = Y(J) + t(J, p) * co(p) * a + Rnd - 0.5
        PSet (qx(J, p), qy(J, p)), RGB(r0(J), g0(J), b0(J))
      Next
      F(J) = F(J) + 1

    Case 81 To 100
      r0(J) = r0(J) * 0.95 'loppuhimmennys
      g0(J) = g0(J) * 0.95
      b0(J) = b0(J) * 0.95
      For p = 0 To 99
        PSet (qx(J, p), qy(J, p)), 0
        qx(J, p) = qx(J, p) + 2 * Rnd - 1
        qy(J, p) = qy(J, p) + 2 * Rnd - 1 + vy(J)
        PSet (qx(J, p), qy(J, p)), RGB(r0(J), g0(J), b0(J))
      Next
      F(J) = F(J) + 1
    Case 101
      For p = 0 To 99 'sammutetaan lopuksi
        PSet (qx(J, p), qy(J, p)), 0
      Next
      F(J) = 0
    End Select
    If F(J) Then
      'piirretään nousuvana
      PSet (px(J, K(J)), py(J, K(J))), _
      RGB(r(J, K(J)), g(J, K(J)), b(J, K(J)))
      If K(J) = 29 Or N(J) > 0 Then
        N(J) = K(J): L = 28
      Else
        L = K(J) + (K(J) > 0)
      End If
      Do 'piirretään himmenevä häntä
        If r(J, L) > 9 Then r(J, L) = r(J, L) - 9 Else r(J, L) = 0
        If g(J, L) > 9 Then g(J, L) = g(J, L) - 9 Else g(J, L) = 0
        If b(J, L) > 9 Then b(J, L) = b(J, L) - 9 Else b(J, L) = 0
        PSet (px(J, L), py(J, L)), _
        RGB(r(J, L), g(J, L), b(J, L))
        If L = K(J) Then Exit Do 'viimeinen piste piirretty
        L = L - 1 - 30 * (L = 0) 'pyörivä silmukka
      Loop
      K(J) = -(K(J) + 1) * (K(J) < 29)
    End If
  Next
End Sub