The most amazing VB6 Code ever

[timfrombriz]

Yes, this little bit of code will blow your mind, try it

Option Explicit
Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type
Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type
Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type
Private BUFFER_SCREEN() As Long
Private BUFFER_SCREEN_BITMAP_INFO As BITMAPINFO
Private Const EngineWidth As Long = 1024
Private Const EngineHeight As Long = 768
Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long

Dim NZ() As Single
Dim WB(1024, 384 To 768) As Single
Dim WX(1023, 384 To 767) As Single
Dim WY(1023, 384 To 767) As Single
Dim Col(1023, 767) As Long
Dim CC(128, 8) As Long
Dim FC As Long
Dim SX As Single, SY As Single

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 27 Then Unload Me
If KeyCode = 32 Then
    Gen
    Sky
    fCC
    Water
    Air
    SetDIBits frm.hdc, frm.Image, 0, EngineHeight, BUFFER_SCREEN(0), BUFFER_SCREEN_BITMAP_INFO, 0&
End If
End Sub

Private Sub Form_Load()
With BUFFER_SCREEN_BITMAP_INFO.bmiHeader
    .biSize = 40
    .biWidth = EngineWidth
    .biHeight = -EngineHeight
    .biPlanes = 1
    .biBitCount = 32
    .biCompression = 0&
    .biSizeImage = ((((.biWidth * .biBitCount) + &H1F) And Not &H1F&) \ &H8) * Abs(.biHeight)
End With
ReDim BUFFER_SCREEN(EngineWidth * EngineHeight)
  Move 0, 0, 1024 * Screen.TwipsPerPixelX, 768 * Screen.TwipsPerPixelY
  Show
  Form_KeyDown 32, 0
End Sub

Private Sub Air()
  Dim x As Long, y As Long, c As Long, k1 As Single, k2 As Single, s As Single, yReal As Long
  For y = 0 To 767
    k1 = (1 - Abs(383.5 - y) / 384) ^ 5
    For x = 0 To 1023
      If y = SY Then
        k2 = 0.25
      Else
        k2 = Atn((x - SX) / (y - SY)) / 6.283186 + 0.25
      End If
      If (y - SY) < 0 Then k2 = k2 + 0.5
      k2 = BN(k2 * 512, 0) * 0.03
      k2 = 0.2 - k2 * k2: If k2 < 0 Then k2 = 0
      s = 50 / Sqr((x - SX) * (x - SX) + (y - SY) * (y - SY))
      If s > 1 Then s = 1
      c = Lerp(&HFFFFFF, FC, k2 * (1 - s))
      BUFFER_SCREEN(yReal + x) = Lerp(c, Col(x, y), k1)
    Next x
    yReal = yReal + EngineWidth
  Next y
End Sub

Private Sub Water()
  Dim x As Long, y As Long
  Dim x1 As Long, y1 As Long
  Dim k As Single, c As Long, kx As Single
  Dim sx1 As Single, sy1 As Single
  Dim sx2 As Single, sy2 As Single
  For y = 768 To 384 Step -1
    k = (y - 383) * 0.5
    kx = (900 - y) / 580
    For x = 1024 To 0 Step -1
      sy1 = 64000 / (y - 380)
      sx1 = (x - 511.5) * sy1 * 0.002
      sy2 = sy1 * 0.34 - sx1 * 0.71
      sx2 = sx1 * 0.34 + sy1 * 0.71
      sy1 = sy2 * 0.34 - sx2 * 0.21
      sx1 = sx2 * 0.34 + sy2 * 0.21
      WB(x, y) = BN(sx1, sy1) - BN(sx2, sy2)
      If x < 1024 And y < 768 Then
        WX(x, y) = (WB(x + 1, y) - WB(x, y)) * k * kx
        WY(x, y) = (WB(x, y + 1) - WB(x, y)) * k
        x1 = x + WX(x, y)
        If x1 < 0 Then x1 = -x1 Else If x1 > 1023 Then x1 = 2047 - x1
        y1 = 768 - y + WY(x, y)
        If y1 < 0 Then y1 = 0 Else If y1 > 383 Then y1 = 383
        c = Lerp(BC(x1 / 8, y1 / 48), &H352520, kx)
        Col(x, y) = c
      End If
    Next x
  Next y
End Sub

Private Sub Sky()
  Dim x As Long, y As Long, c1 As Long, c2 As Long, k As Single, s As Single
  Dim sx1 As Single, sy1 As Single
  SX = 100 + Rnd * 824
  SY = 192 + Rnd * 157
  For y = 0 To 383
    sy1 = 100000 / (390 - y)
    For x = 0 To 1023
      sx1 = (x - 511.5) * sy1 * 0.0005
      k = BN(sx1, sy1) - BN(sx1 * 0.14 + sy1 * 0.21, sy1 * 0.14 - sx1 * 0.21)
      If k < -8 Then k = 0 Else k = (k + 8) * 0.02: If k > 1 Then k = 1
      FC = &H908000 + (SY + 500) * 0.2
      c1 = Lerp(FC + 25, &H906050, y / 384)
      c2 = Lerp(&H807080, &HD0D0D0, y / 384)
      s = 50 / Sqr((x - SX) * (x - SX) + (y - SY) * (y - SY))
      If s > 1 Then s = 1
      c1 = Lerp(&HFFFFFF, c1, s)
      Col(x, y) = Lerp(c2, c1, k)
    Next x
  Next y
End Sub

Private Sub fCC()
  Dim x As Long, y As Long
  Dim xx As Long, yy As Long
  Dim r As Long, g As Long, b As Long
  For x = 0 To 127
    For y = 0 To 7
      r = 0: g = 0: b = 0
      For yy = 0 To 47
        For xx = 0 To 7
          r = r + (Col(xx + x * 8, yy + y * 48) And 255)
          g = g + (Col(xx + x * 8, yy + y * 48) And &HFF00&)
          b = b + ((Col(xx + x * 8, yy + y * 48) And &HFF0000) \ 256)
        Next xx
      Next yy
      CC(x, y) = r / 384 + ((g / 384) And &HFF00&) + ((b / 384) And &HFF00) * 256
    Next y
    CC(x, 8) = CC(x, 7)
  Next x
End Sub

Private Function BC(ByVal x As Single, ByVal y As Single) As Long
  Dim ix As Long, iy As Long, SX As Single, SY As Single
  Dim c0 As Long, c1 As Long, c2 As Long, c3 As Long
  ix = Int(x)
  SX = x - ix
  iy = Int(y)
  SY = y - iy
  c0 = CC(ix And 127, iy Mod 9)
  c1 = CC((ix + 1) And 127, iy Mod 9)
  c2 = CC(ix And 127, (iy + 1) Mod 9)
  c3 = CC((ix + 1) And 127, (iy + 1) Mod 9)
  BC = (c0 And 255) * (1 - SX) * (1 - SY) + (c1 And 255) * SX * (1 - SY) + (c2 And 255) * (1 - SX) * SY + (c3 And 255) * SX * SY + _
      ((c0 And &HFF00&) * (1 - SX) * (1 - SY) + (c1 And &HFF00&) * SX * (1 - SY) + (c2 And &HFF00&) * (1 - SX) * SY + (c3 And &HFF00&) * SX * SY And &HFF00&) + _
      ((c0 And &HFF0000) * (1 - SX) * (1 - SY) + (c1 And &HFF0000) * SX * (1 - SY) + (c2 And &HFF0000) * (1 - SX) * SY + (c3 And &HFF0000) * SX * SY And &HFF0000)
End Function

Private Function BN(ByVal x As Single, ByVal y As Single) As Single
  Dim ix As Long, iy As Long, SX As Single, SY As Single
  ix = Int(x)
  SX = x - ix
  iy = Int(y)
  SY = y - iy
  BN = NZ(ix And 511, iy And 511) * (1 - SX) * (1 - SY) + NZ((ix + 1) And 511, iy And 511) * SX * (1 - SY) + NZ(ix And 511, (iy + 1) And 511) * (1 - SX) * SY + NZ((ix + 1) And 511, (iy + 1) And 511) * SX * SY
End Function

Private Sub Gen()
  Dim x As Long, y As Long, d As Long
  Randomize Timer
  ReDim NZ(511, 511)
  d = 64
  Do
    For y = 0 To 511 Step d + d
      For x = 0 To 511 Step d + d
        NZ((x + d) And 511, y) = (NZ(x, y) + NZ((x + d + d) And 511, y)) * 0.5 + d * (Rnd - 0.5)
        NZ(x, (y + d) And 511) = (NZ(x, y) + NZ(x, (y + d + d) And 511)) * 0.5 + d * (Rnd - 0.5)
        NZ((x + d) And 511, (y + d) And 511) = (NZ(x, y) + NZ((x + d + d) And 511, (y + d + d) And 511) + NZ(x, (y + d + d) And 511) + NZ((x + d + d) And 511, y)) * 0.25 + d * (Rnd - 0.5)
      Next x
    Next y
    If d = 1 Then Exit Do
    d = d \ 2
  Loop
End Sub

Private Function Lerp(ByVal c1 As Long, ByVal c2 As Long, ByVal k As Single) As Long
  Lerp = ((c1 And 255) * k + (c2 And 255) * (1 - k)) Or ((c1 And &HFF00&) * k + (c2 And &HFF00&) * (1 - k) And &HFF00&) Or ((c1 And &HFF0000) * k + (c2 And &HFF0000) * (1 - k) And &HFF0000)
End Function