Option Explicit

Dim CPal(255, 2) As Single

Dim CBuffer() As Single
Dim running As Boolean
Dim Dichte As Integer

Private Sub Form_Load()
  ReDim CBuffer(pic_Fire.ScaleWidth, _
                pic_Fire.ScaleHeight) As Single
  Randomize Timer
End Sub

Private Sub cmd_Start_Click()
  Dim i As Integer
  Dim col As Integer

  If chk_FirePal.value = 1 Then
    CreateFirePal
  Else
    CreateSmokePal
  End If

  For i = 0 To pic_Fire.ScaleWidth
    col = Int((Rnd * 20) + 1)
    CBuffer(i, pic_Fire.ScaleHeight) = 255 - col
  Next i

  PaintBuffer
  Dichte = 10
  running = True
  Do
    If Len(txt_Dichte.Text) > 0 Then
      If IsNumeric(txt_Dichte.Text) Then
        Dichte = CInt(txt_Dichte.Text)
        If Dichte < 0 Then Dichte = 0
        If Dichte > 10 Then Dichte = 10
      End If
    End If

    FireFrame

    If chk_Blur.value = 1 Then
      BlurFX
    Else
      PaintBuffer
    End If

    DoEvents
  Loop While running
End Sub

Private Sub FireFrame()
  Dim i As Integer
  Dim j As Integer
  Dim col As Integer
  Dim Step As Integer

  For i = 1 To pic_Fire.ScaleHeight
    For j = 0 To pic_Fire.ScaleWidth
      Step = 10
      If Int((Rnd * 10) + 1) > 9 Then Step = 20
      CBuffer(j, i - 1) = CBuffer(j, i) - Int((Rnd * Step) + 1)
      If CBuffer(j, i - 1) < 0 Then CBuffer(j, i - 1) = 0
    Next j
  Next i

  For i = 1 To pic_Fire.ScaleWidth - 1
    col = 255
    If Int((Rnd * 10) + 1) > Dichte Then col = 125
    CBuffer(i, pic_Fire.ScaleHeight - 1) = col
  Next i
End Sub

Private Sub PaintBuffer()
  Dim i As Integer
  Dim j As Integer

  For i = 0 To pic_Fire.ScaleHeight
    For j = 0 To pic_Fire.ScaleWidth
      pic_Fire.PSet (j, i), RGB(CPal(CBuffer(j, i), 0), _
            CPal(CBuffer(j, i), 1), CPal(CBuffer(j, i), 2))
    Next j
  Next i
End Sub

Private Sub BlurFX()
  Dim xs As Integer
  Dim xd As Integer
  Dim ys As Integer
  Dim yd As Integer
  Dim mx As Integer
  Dim my As Integer
  Dim value As Integer

  For ys = 1 To pic_Fire.ScaleHeight - 1
    For xs = 1 To pic_Fire.ScaleWidth - 1
      value = 0
      For my = -1 To 1
        value = value + CBuffer(xs - 1, ys + my)
        value = value + CBuffer(xs, ys + my)
        value = value + CBuffer(xs + 1, ys + my)
      Next my
      If value > 0 Then
        value = value / 9
        pic_Fire.PSet (xs, ys), RGB(CPal(value, 0), _
              CPal(value, 1), CPal(value, 2))
      End If
    Next xs
  Next ys
End Sub

Private Sub CreateFirePal()
  Dim i As Single

  For i = 0 To 85
    CPal(i, 0) = i * 3
    CPal(i, 1) = 0
    CPal(i, 2) = 0
  Next i
  For i = 1 To 85
    CPal(i + 85, 0) = 255
    CPal(i + 85, 1) = i * 3
    CPal(i + 85, 2) = 0
  Next i
  For i = 1 To 85
    CPal(i + 170, 0) = 255
    CPal(i + 170, 1) = 255
    CPal(i + 170, 2) = i * 3
  Next i
End Sub

Private Sub CreateSmokePal()
  Dim i As Single

  For i = 0 To 255
    CPal(i, 0) = i
    CPal(i, 1) = i
    CPal(i, 2) = i
  Next i
End Sub

Private Sub cmd_End_Click()
  running = False
End Sub