[RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread

[EntityX]

This code was posted in Chit Chat and everyone is saying how great it is. I just have Visual Studio 2010 and no familiarity with VB6 so I thought it would be good to convert the code to Visual Basic 2010.

Here's the VB6 code from that thread.

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

Here's the Chit Chat thread it's in, in case you want to see what has been posted about it. The most amazing VB6 Code ever

[Grimfort]

So what is the question .

[stanav]

So what is the question .

I guess the OP is asking if someone could convert that VB6 code into VB.Net.

[Grimfort]

I thought that would be the question, but hoped it was not. The part where the OP says

...so I thought it would be good to convert the code to Visual Basic 2010.

would hope that it had already been started .

[FunkyDexter]

Guys, you're kinda missing the point. This isn't EntityX just out to get some cheap help for a school project or something. He's not posting here because of what he can get out of you. He's posting here because he thinks you'll enjoy being involved in translating it.

It comes from a thread in the chit chat section where a new member posted this code saying it was cool. And, frankly, it is. We were all pretty wowed by it and the discussion turned to whether it would be cool to translate it to .Net. It's just a bit of fun and it made sense for EntityX to post it here because this is where he'd most likely find folks who'd want to join in.

EntityX, You should be fine converting the types to Structures. They're basically the same. Here's the syntax for one of them:-

Private Structure BITMAPINFOHEADER
        Private biSize As Long
        Private biWidth As Long
        Private biHeight As Long
        Private biPlanes As Integer
        Private biBitCount As Integer
        Private biCompression As Long
        Private biSizeImage As Long
        Private biXPelsPerMeter As Long
        Private biYPelsPerMeter As Long
        Private biClrUsed As Long
        Private biClrImportant As Long
    End Structure

[EntityX]

Ok. I spent some time on it. Lots of CInt() , CSng(), etc used from VS2010 suggestions. Changed Private Type to Private Structure because that's what VS2010 suggested. Put in some comments to tell where there are still wavy lines under code fragments.

Thanks Funky I just made use of some of your input.

This is just for fun. If we have a succesful completion then great.

Imports System.Math
Public Class Form1
    Private Structure BITMAPINFOHEADER
        Private biSize As Long
        Private biWidth As Long
        Private biHeight As Long
        Private biPlanes As Integer
        Private biBitCount As Integer
        Private biCompression As Long
        Private biSizeImage As Long
        Private biXPelsPerMeter As Long
        Private biYPelsPerMeter As Long
        Private biClrUsed As Long
        Private biClrImportant As Long
    End Structure
    Private Structure RGBQUAD
        Private rgbBlue As Byte
        Private rgbGreen As Byte
        Private rgbRed As Byte
        Private rgbReserved As Byte
    End Structure
    Private Structure BITMAPINFO
        Private bmiHeader As BITMAPINFOHEADER
        Private bmiColors As RGBQUAD
    End Structure
    Private BUFFER_SCREEN() As Long
    Private BUFFER_SCREEN_BITMAP_INFO As Bitmap ' Was 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, ByVal lpBits As Any, ByVal lpBI As BITMAPINFO, ByVal wUsage As Long) As Long

    Dim NZ() As Single
    Dim WB(1024, 0 To 768) As Single ' WAS (1024, 384 TO 768)
    Dim WX(1023, 0 To 767) As Single
    Dim WY(1023, 0 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(ByVal KeyCode As Integer, ByVal Shift As Integer)
        If KeyCode = 27 Then Unload(Me) ' wavy line Unload. says Unload is not declared
        If KeyCode = 32 Then
            Gen()
            Sky()
            fCC()
            Water()
            Air()
            SetDIBits(frm.hdc, frm.Image, 0, EngineHeight, BUFFER_SCREEN(0), BUFFER_SCREEN_BITMAP_INFO, 0&) ' wavy lines under frm. Says it is not declared
        End If
    End Sub

    Private Sub Form_Load()
        With BUFFER_SCREEN_BITMAP_INFO.bmiHeader ' wavy line under everything after With. Says bmiHeader is not a member of System.Drawing.Bitmap
            .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) ' wavy lines under Screen.TwipsPerPixelX and ...Y
        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 = CSng((1 - Abs(383.5 - y) / 384) ^ 5)
            For x = 0 To 1023
                If y = SY Then
                    k2 = 0.25
                Else
                    k2 = CSng(Atan((x - SX) / (y - SY)) / 6.283186 + 0.25)
                End If
                If (y - SY) < 0 Then k2 = CSng(k2 + 0.5)
                k2 = CSng(BN(k2 * 512, 0) * 0.03)
                k2 = CSng(0.2 - k2 * k2) : If k2 < 0 Then k2 = 0
                s = CSng(50 / Sqrt((x - SX) * (x - SX) + (y - SY) * (y - SY)))
                If s > 1 Then s = 1
                c = Lerp(&HFFFFFF, FC, k2 * (1 - s))
                BUFFER_SCREEN(CInt(yReal + x)) = Lerp(c, Col(CInt(x), CInt(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 = CSng((y - 383) * 0.5)
            kx = CSng((900 - y) / 580)
            For x = 1024 To 0 Step -1
                sy1 = CSng(64000 / (y - 380))
                sx1 = CSng((x - 511.5) * sy1 * 0.002)
                sy2 = CSng(sy1 * 0.34 - sx1 * 0.71)
                sx2 = CSng(sx1 * 0.34 + sy1 * 0.71)
                sy1 = CSng(sy2 * 0.34 - sx2 * 0.21)
                sx1 = CSng(sx2 * 0.34 + sy2 * 0.21)
                WB(CInt(x), CInt(y)) = BN(sx1, sy1) - BN(sx2, sy2)
                If x < 1024 And y < 768 Then
                    WX(CInt(x), CInt(y)) = (WB(CInt(x + 1), CInt(y)) - WB(CInt(x), CInt(y))) * k * kx
                    WY(CInt(x), CInt(y)) = (WB(CInt(x), CInt(y + 1)) - WB(CInt(x), CInt(y))) * k
                    x1 = CLng(x + WX(CInt(x), CInt(y)))
                    If x1 < 0 Then x1 = -x1 Else If x1 > 1023 Then x1 = 2047 - x1
                    y1 = CLng(768 - y + WY(CInt(x), CInt(y)))
                    If y1 < 0 Then y1 = 0 Else If y1 > 383 Then y1 = 383
                    c = Lerp(BC(CSng(x1 / 8), CSng(y1 / 48)), &H352520, kx)
                    Col(CInt(x), CInt(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 = CSng(100000 / (390 - y))
            For x = 0 To 1023
                sx1 = CSng((x - 511.5) * sy1 * 0.0005)
                k = BN(sx1, sy1) - BN(CSng(sx1 * 0.14 + sy1 * 0.21), CSng(sy1 * 0.14 - sx1 * 0.21))
                If k < -8 Then k = 0 Else k = CSng((k + 8) * 0.02) : If k > 1 Then k = 1
                FC = CLng(&H908000 + (SY + 500) * 0.2)
                c1 = Lerp(FC + 25, &H906050, CSng(y / 384))
                c2 = Lerp(&H807080, &HD0D0D0, CSng(y / 384))
                s = CSng(50 / Sqrt((x - SX) * (x - SX) + (y - SY) * (y - SY)))
                If s > 1 Then s = 1
                c1 = Lerp(&HFFFFFF, c1, s)
                Col(CInt(x), CInt(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(CInt(xx + x * 8), CInt(yy + y * 48)) And 255)
                        g = g + (Col(CInt(xx + x * 8), CInt(yy + y * 48)) And &HFF00&)
                        b = b + ((Col(CInt(xx + x * 8), CInt(yy + y * 48)) And &HFF0000) \ 256)
                    Next xx
                Next yy
                CC(CInt(x), CInt(y)) = r / 384 + ((g / 384) And &HFF00&) + ((b / 384) And &HFF00) * 256
            Next y
            CC(CInt(x), 8) = CC(CInt(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 = CLng(Int(x))
        SX = x - ix
        iy = CLng(Int(y))
        SY = y - iy
        c0 = CC(CInt(ix And 127), CInt(iy Mod 9))
        c1 = CC(CInt((ix + 1) And 127), CInt(iy Mod 9))
        c2 = CC(CInt(ix And 127), CInt((iy + 1) Mod 9))
        c3 = CC(CInt((ix + 1) And 127), CInt((iy + 1) Mod 9)) ' wavy line under most of the 2 lines below the line that starts BC = 
        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 = CLng(Int(x))
        SX = x - ix
        iy = CLng(Int(y))
        SY = y - iy
        BN = NZ(CInt(ix And 511), CInt(iy And 511)) * (1 - SX) * (1 - SY) + NZ(CInt((ix + 1) And 511), CInt(iy And 511)) * SX * (1 - SY) + NZ(CInt(ix And 511), CInt((iy + 1) And 511)) * (1 - SX) * SY + NZ(CInt((ix + 1) And 511), CInt((iy + 1) And 511)) * SX * SY
    End Function

    Private Sub Gen()
        Dim x As Long, y As Long, d As Long
        Randomize(Timer)
        Dim NZ(511, 511) As Single ' was ReDim NZ(511, 511)
        d = 64
        Do
            For y = 0 To 511 Step d + d
                For x = 0 To 511 Step d + d
                    NZ(CInt((x + d) And 511), CInt(y)) = CSng((NZ(CInt(x), CInt(y)) + NZ(CInt((x + d + d) And 511), CInt(y))) * 0.5 + d * (Rnd() - 0.5))
                    NZ(CInt(x), CInt((y + d) And 511)) = CSng((NZ(CInt(x), CInt(y)) + NZ(CInt(x), CInt((y + d + d) And 511))) * 0.5 + d * (Rnd() - 0.5))
                    NZ(CInt((x + d) And 511), CInt((y + d) And 511)) = CSng((NZ(CInt(x), CInt(y)) + NZ(CInt((x + d + d) And 511), CInt((y + d + d) And 511)) + NZ(CInt(x), CInt((y + d + d) And 511)) + NZ(CInt((x + d + d) And 511), CInt(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
End Class

[Grimfort]

Guys, you're kinda missing the point.

No no, I didn't miss that. I didn't just want to walk in and solve it in case it was to be used as a learning tool.

[FunkyDexter]

Cool. I wasn't sure and I just thought the thread might die if people had the wrong idea.

Private BUFFER_SCREEN_BITMAP_INFO As Bitmap ' Was BITMAPINFO

I think it should still be a BITMAPINFO shouldn't it? That's why this lines going wrong:-

With BUFFER_SCREEN_BITMAP_INFO.bmiHeader ' wavy line under everything after With. Says bmiHeader is not a member of System.Drawing.Bitmap

What's the reason you changed it? (I'm probably missing something)

Something I did notice, you want to make the individual members of the Structures Freind or Public, otherwise they're private within the structure itself.

[kareninstructor]

Here is the BITMAPINFOHEADER for VB.NET

http://www.pinvoke.net/default.aspx/...NFOHEADER.html

   <Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Explicit)> _
Public Structure BITMAPINFOHEADER
      <Runtime.InteropServices.FieldOffset(0)> Public biSize As Int32
      <Runtime.InteropServices.FieldOffset(4)> Public biWidth As Int32
      <Runtime.InteropServices.FieldOffset(8)> Public biHeight As Int32
      <Runtime.InteropServices.FieldOffset(12)> Public biPlanes As Int16
      <Runtime.InteropServices.FieldOffset(14)> Public biBitCount As Int16
      <Runtime.InteropServices.FieldOffset(16)> Public biCompression As Int32
      <Runtime.InteropServices.FieldOffset(20)> Public biSizeImage As Int32
      <Runtime.InteropServices.FieldOffset(24)> Public biXPelsperMeter As Int32
      <Runtime.InteropServices.FieldOffset(28)> Public biYPelsPerMeter As Int32
      <Runtime.InteropServices.FieldOffset(32)> Public biClrUsed As Int32
      <Runtime.InteropServices.FieldOffset(36)> Public biClrImportant As Int32
   End Structure

[Milk]

For all the code you need to adjust the types (as per Kev's BITMAPINFOHEADER)
Long --> Int32 or Integer
Integer --> Int16 or Short

You could avoid all the structures and the GDI API call altogether by using Bitmap.Lockbits() with an appropriate Bitmap (Format32bppRgb) and Marshal.Copy(). It looks like it is specifying a top down bitmap which I've not tried declaring yet in .Net, I would try passing a negative height parameter first.

Edit: had a play with top down bitmaps using C# and it is not so straight forward. I could only get it working by using the overload that accepts a pointer (so had to allocate or pin some memory for it).

[timfrombriz]

For all the code you need to adjust the types (as per Kev's BITMAPINFOHEADER)
Long --> Int32 or Integer
Integer --> Int16 or Short

You could avoid all the structures and the GDI API call altogether by using Bitmap.Lockbits() with an appropriate Bitmap (Format32bppRgb) and Marshal.Copy(). It looks like it is specifying a top down bitmap which I've not tried declaring yet in .Net, I would try passing a negative height parameter first.

Edit: had a play with top down bitmaps using C# and it is not so straight forward. I could only get it working by using the overload that accepts a pointer (so had to allocate or pin some memory for it).

As the original poster of this code, I recommend that for quick conversion that you strip the WinApi I used, that is the BITMAP structure and the SetDibBits API call and just plot the pixel instead with the forms setpixel (x,y) function instead.

Crazy to think such simple maths algorithms can create such an organic looking scene, the waves are so natural and random, and the lighting is so perfect. Maybe the world we live in does has operate purely on basic fundamental algorithmic laws that orchestrate the cause and effect randomness in the world.

[Jenner]

I've been poking at this all day and for the life of me, I just can't get those ancient GDI functions to output anything what-so-ever. Tried SetDIBits and SetDIBitsToDevice; both with Marshal.UnsafeAddrOfPinnedArrayElement(BUFFER_SCREEN, 0) for the data pointer and can't get any results.

Hey Milk, did you try Bitmap.Lockbits with the Marshal.Copy method? I was wondering if you got anywhere before I tried something similar. I've personally never worked with bitmap manipulations like this.

[Jenner]

Nevermind. Converted it successfully.
Code is below.

Imports System.Runtime.InteropServices

'Single Form with a PictureBox docked to "Fill".  Nothing else.
'Do NOT turn Strict On, there's a zillion double->integer, integer->single, etc conversions that need converting and I'm too lazy right now. :)

Public Class Form1
    Private BUFFER_SCREEN() As Integer

    Private Const EngineWidth As Long = 1024
    Private Const EngineHeight As Long = 768
    
    Dim NZ(,) As Single
    Dim WB(1024, 768) As Single
    Dim WX(1023, 767) As Single
    Dim WY(1023, 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 rnd As New Random()

    Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
        If e.KeyCode = Keys.Escape Then Me.Close()
        If e.KeyCode = Keys.Space Then
            Gen()
            Sky()
            fCC()
            Water()
            Air()

            Dim bl As New List(Of Byte)
            Dim bmp As New Bitmap(EngineWidth, EngineHeight, Imaging.PixelFormat.Format32bppRgb)
            Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
            Dim bmpData As Imaging.BitmapData = bmp.LockBits(rect, Imaging.ImageLockMode.ReadWrite, bmp.PixelFormat)

            Dim ptr As IntPtr = bmpData.Scan0
            For Each x In BUFFER_SCREEN
                bl.AddRange(BitConverter.GetBytes(x))
            Next
            Dim ba() As Byte = bl.ToArray

            Marshal.Copy(ba, 0, ptr, ba.Length - 4)
            bmp.UnlockBits(bmpData)

            PictureBox1.Image = bmp
        End If
    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        ReDim BUFFER_SCREEN(EngineWidth * EngineHeight)
    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 - Math.Abs(383.5 - y) / 384) ^ 5
            For x = 0 To 1023
                If y = SY Then
                    k2 = 0.25
                Else
                    k2 = Math.Atan((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 / Math.Sqrt((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.NextDouble * 824
        SY = 192 + rnd.NextDouble * 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 / Math.Sqrt((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
        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.NextDouble - 0.5)
                    NZ(x, (y + d) And 511) = (NZ(x, y) + NZ(x, (y + d + d) And 511)) * 0.5 + d * (rnd.NextDouble - 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.NextDouble - 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
End Class

[ForumAccount]

Code bank it!

[ForumAccount]

Also, am I the only one that when looking at the water it appears like it's moving? Like an optical illusion of some sort?

[Grimfort]

Nevermind. Converted it successfully.
Code is below.

GJ! I managed to do something close using LockBits but it only ever came out when applied to an existing image, kinda like an overylay mottled effect. I did turn option strict on and fixed all the converstions, good advice not to turn that on methinks!

[Jenner]

I'll CodeBank it when I go through it tomorrow and fix all the conversion issues. I want to optimize it a bit too. I see some spots for parallelism and more efficient use of typing. Also, oddly, there's a spare pixel being generated. I don't know if it's an index conversion issue or what. At the end, I just Marshal.Copy'd (Length - 4) bytes to remove it.

[Grimfort]

Just playing with that code, there are 3 main color bases for each of the air, water, sky, passed to the Lerp method. I switched the values out with a color selection and couple of labels and you can get some great effects. If you have the time to add something like this, maybe on a slider for each area, gives you something to play with. Make orange sunsets on deep blue sea, or a white foggy night with green water.

[EntityX]

Thanks for doing the work Jenner. I see others have got a result. I started a new project added PictureBox1 to Form1 and set Option Strict Off. Set dock for PictureBox1 to Fill but for some reason I don't see anything happening. Some little detail that I need to adjust probably. What are all the compile options that you used?

Grimfort if you did all the conversions then maybe you could repost the code with those conversions you did to save us the work.

[ForumAccount]

Thanks for doing the work Jenner. I see others have got a result. I started a new project added PictureBox1 to Form1 and set Option Strict Off. Set dock for PictureBox1 to Fill but for some reason I don't see anything happening. Some little detail that I need to adjust probably. What are all the compile options that you used?

Grimfort if you did all the conversions then maybe you could repost the code with those conversions you did to save us the work.

Did you press the space bar key, i.e. the value 32 (look at the KeyDown event).

[EntityX]

Thanks ForumAccount. I would have probably started to examine the code and figure that out but you saved me the trouble. Now I see it.

[Grimfort]

Grimfort if you did all the conversions then maybe you could repost the code with those conversions you did to save us the work.

I think that was one of the reasons mine failed. I just converted all to correct types based upon the error, but don't think it was correct, I think some need to be doubles, even tho ints are suggested. I did not spend much time on that part as the actual lockbits drawing part was only half working even with the conversion.

[EntityX]

I did the conversions and it works for me. I was just going with the Visual Studio 2010 Pro suggestions all the way. It's nice I like it but the "most amazing VB6 code ever". I don't know. I thought maybe it was going to be a moving simulation not just a still picture or a series of still pictures.

Grimfort maybe you could show us the code you used to get those color effects.

Option Strict On
Imports System.Runtime.InteropServices

'Single Form with a PictureBox1 docked to "Fill".  Nothing else.

Public Class Form1
    Private BUFFER_SCREEN() As Integer

    Private Const EngineWidth As Long = 1024
    Private Const EngineHeight As Long = 768

    Dim NZ(,) As Single
    Dim WB(1024, 768) As Single
    Dim WX(1023, 767) As Single
    Dim WY(1023, 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 rnd As New Random()

    Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
        If e.KeyCode = Keys.Escape Then Me.Close()
        If e.KeyCode = Keys.Space Then
            Gen()
            Sky()
            fCC()
            Water()
            Air()

            Dim bl As New List(Of Byte)
            Dim bmp As New Bitmap(EngineWidth, EngineHeight, Imaging.PixelFormat.Format32bppRgb)
            Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
            Dim bmpData As Imaging.BitmapData = bmp.LockBits(rect, Imaging.ImageLockMode.ReadWrite, bmp.PixelFormat)

            Dim ptr As IntPtr = bmpData.Scan0
            For Each x In BUFFER_SCREEN
                bl.AddRange(BitConverter.GetBytes(x))
            Next
            Dim ba() As Byte = bl.ToArray

            Marshal.Copy(ba, 0, ptr, ba.Length - 4)
            bmp.UnlockBits(bmpData)

            PictureBox1.Image = bmp
        End If
    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        ReDim BUFFER_SCREEN(EngineWidth * EngineHeight)
    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 = CSng((1 - Math.Abs(383.5 - y) / 384) ^ 5)
            For x = 0 To 1023
                If y = SY Then
                    k2 = 0.25
                Else
                    k2 = CSng(Math.Atan((x - SX) / (y - SY)) / 6.283186 + 0.25)
                End If
                If (y - SY) < 0 Then k2 = CSng(k2 + 0.5)
                k2 = CSng(BN(k2 * 512, 0) * 0.03)
                k2 = CSng(0.2 - k2 * k2) : If k2 < 0 Then k2 = 0
                s = CSng(50 / Math.Sqrt((x - SX) * (x - SX) + (y - SY) * (y - SY)))
                If s > 1 Then s = 1
                c = Lerp(&HFFFFFF, FC, k2 * (1 - s))
                BUFFER_SCREEN(CInt(yReal + x)) = CInt(Lerp(c, Col(CInt(x), CInt(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 = CSng((y - 383) * 0.5)
            kx = CSng((900 - y) / 580)
            For x = 1024 To 0 Step -1
                sy1 = CSng(64000 / (y - 380))
                sx1 = CSng((x - 511.5) * sy1 * 0.002)
                sy2 = CSng(sy1 * 0.34 - sx1 * 0.71)
                sx2 = CSng(sx1 * 0.34 + sy1 * 0.71)
                sy1 = CSng(sy2 * 0.34 - sx2 * 0.21)
                sx1 = CSng(sx2 * 0.34 + sy2 * 0.21)
                WB(CInt(x), CInt(y)) = BN(sx1, sy1) - BN(sx2, sy2)
                If x < 1024 And y < 768 Then
                    WX(CInt(x), CInt(y)) = (WB(CInt(x + 1), CInt(y)) - WB(CInt(x), CInt(y))) * k * kx
                    WY(CInt(x), CInt(y)) = (WB(CInt(x), CInt(y + 1)) - WB(CInt(x), CInt(y))) * k
                    x1 = CLng(x + WX(CInt(x), CInt(y)))
                    If x1 < 0 Then x1 = -x1 Else If x1 > 1023 Then x1 = 2047 - x1
                    y1 = CLng(768 - y + WY(CInt(x), CInt(y)))
                    If y1 < 0 Then y1 = 0 Else If y1 > 383 Then y1 = 383
                    c = Lerp(BC(CSng(x1 / 8), CSng(y1 / 48)), &H352520, kx)
                    Col(CInt(x), CInt(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 = CSng(100 + rnd.NextDouble * 824)
        SY = CSng(192 + rnd.NextDouble * 157)
        For y = 0 To 383
            sy1 = CSng(100000 / (390 - y))
            For x = 0 To 1023
                sx1 = CSng((x - 511.5) * sy1 * 0.0005)
                k = BN(sx1, sy1) - BN(CSng(sx1 * 0.14 + sy1 * 0.21), CSng(sy1 * 0.14 - sx1 * 0.21))
                If k < -8 Then k = 0 Else k = CSng((k + 8) * 0.02) : If k > 1 Then k = 1
                FC = CLng(&H908000 + (SY + 500) * 0.2)
                c1 = Lerp(FC + 25, &H906050, CSng(y / 384))
                c2 = Lerp(&H807080, &HD0D0D0, CSng(y / 384))
                s = CSng(50 / Math.Sqrt((x - SX) * (x - SX) + (y - SY) * (y - SY)))
                If s > 1 Then s = 1
                c1 = Lerp(&HFFFFFF, c1, s)
                Col(CInt(x), CInt(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(CInt(xx + x * 8), CInt(yy + y * 48)) And 255)
                        g = g + (Col(CInt(xx + x * 8), CInt(yy + y * 48)) And &HFF00&)
                        b = b + ((Col(CInt(xx + x * 8), CInt(yy + y * 48)) And &HFF0000) \ 256)
                    Next xx
                Next yy
                CC(CInt(x), CInt(y)) = CLng(r / 384 + (CLng(g / 384) And &HFF00&) + (CLng(b / 384) And &HFF00) * 256)
            Next y
            CC(CInt(x), 8) = CC(CInt(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 = CLng(Int(x))
        SX = x - ix
        iy = CLng(Int(y))
        SY = y - iy
        c0 = CC(CInt(ix And 127), CInt(iy Mod 9))
        c1 = CC(CInt((ix + 1) And 127), CInt(iy Mod 9))
        c2 = CC(CInt(ix And 127), CInt((iy + 1) Mod 9))
        c3 = CC(CInt((ix + 1) And 127), CInt((iy + 1) Mod 9))
        BC = CLng((c0 And 255) * (1 - SX) * (1 - SY) + (c1 And 255) * SX * (1 - SY) + (c2 And 255) * (1 - SX) * SY + (c3 And 255) * SX * SY + _
            (CLng((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&) + _
            (CLng((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 = CLng(Int(x))
        SX = x - ix
        iy = CLng(Int(y))
        SY = y - iy
        BN = NZ(CInt(ix And 511), CInt(iy And 511)) * (1 - SX) * (1 - SY) + NZ(CInt((ix + 1) And 511), CInt(iy And 511)) * SX * (1 - SY) + NZ(CInt(ix And 511), CInt((iy + 1) And 511)) * (1 - SX) * SY + NZ(CInt((ix + 1) And 511), CInt((iy + 1) And 511)) * SX * SY
    End Function

    Private Sub Gen()
        Dim x As Long, y As Long, d As Long
        ReDim NZ(511, 511)
        d = 64
        Do
            For y = 0 To 511 Step d + d
                For x = 0 To 511 Step d + d
                    NZ(CInt((x + d) And 511), CInt(y)) = CSng((NZ(CInt(x), CInt(y)) + NZ(CInt((x + d + d) And 511), CInt(y))) * 0.5 + d * (rnd.NextDouble - 0.5))
                    NZ(CInt(x), CInt((y + d) And 511)) = CSng((NZ(CInt(x), CInt(y)) + NZ(CInt(x), CInt((y + d + d) And 511))) * 0.5 + d * (rnd.NextDouble - 0.5))
                    NZ(CInt((x + d) And 511), CInt((y + d) And 511)) = CSng((NZ(CInt(x), CInt(y)) + NZ(CInt((x + d + d) And 511), CInt((y + d + d) And 511)) + NZ(CInt(x), CInt((y + d + d) And 511)) + NZ(CInt((x + d + d) And 511), CInt(y))) * 0.25 + d * (rnd.NextDouble - 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 = CLng((c1 And 255) * k + (c2 And 255) * (1 - k)) Or (CLng((c1 And &HFF00&) * k + (c2 And &HFF00&) * (1 - k)) And &HFF00&) Or (CLng((c1 And &HFF0000) * k + (c2 And &HFF0000) * (1 - k)) And &HFF0000)
    End Function
End Class

[nbrege]

Here's one that I came up with...

[Grimfort]

I'll just point it out:

c = Lerp(BC(CSng(x1 / 8), CSng(y1 / 48)), &H352520, kx)

The hardcoded color offsets, just make them user definable.

[Jenner]

I've been trying to separate the picture sizing from the generation routines but it's pretty embedded how all that happens.

So far, I've REALLY cleaned up the conversions, got rid of all the Long's, and got rid of that intermediate array to hold the values; it now does the byte conversion in the last generation loop directly to the list. Also did a lot of modernization to the syntax and layout. Refined code below.

Imports System.Runtime.InteropServices
'Single Form with a PictureBox1 docked to "Fill".  Nothing else.

Public Class Form1
    Private imageWidth As Integer = 1024
    Private imageHeight As Integer = 768
    Private imageConstant1 As Integer = 511

    Private nZ(,) As Single
    Private wB(,) As Single
    Private wX(,) As Single
    Private wY(,) As Single
    Private col(,) As Integer
    Private cc(128, 8) As Integer
    Private fC As Integer
    Private sX As Single
    Private sY As Single
    Private rnd As New Random()
    Private byteList As New List(Of Byte)

    Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
        If e.KeyCode = Keys.Escape Then Me.Close()
        If e.KeyCode = Keys.Space Then
            Gen()
            Sky()
            FCC()
            Water()
            Air()

            Dim bmp As New Bitmap(imageWidth, imageHeight, Imaging.PixelFormat.Format32bppRgb)
            Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
            Dim bmpData As Imaging.BitmapData = bmp.LockBits(rect, Imaging.ImageLockMode.ReadWrite, bmp.PixelFormat)

            Dim ptr As IntPtr = bmpData.Scan0

            Dim ba() As Byte = byteList.ToArray
            Marshal.Copy(ba, 0, ptr, ba.Length - 4)
            bmp.UnlockBits(bmpData)

            PictureBox1.Image = bmp

            byteList.Clear()
        End If
    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        ReAdjustSizes()
    End Sub

    Private Sub ReAdjustSizes()
        ReDim wB(imageWidth, imageHeight)
        ReDim wX(imageWidth - 1, imageHeight - 1)
        ReDim wY(imageWidth - 1, imageHeight - 1)
        ReDim col(imageWidth - 1, imageHeight - 1)
        ReDim nZ(imageConstant1, imageConstant1)
    End Sub

    Private Sub Gen()
        Dim d As Integer = 128

        Do Until d = 1
            d \= 2
            For y As Integer = 0 To imageConstant1 Step d + d
                For x As Integer = 0 To imageConstant1 Step d + d
                    nZ((x + d) And imageConstant1, y) = (nZ(x, y) + nZ((x + d + d) And imageConstant1, y)) * 0.5F + CSng(d * (rnd.NextDouble - 0.5))
                    nZ(x, (y + d) And imageConstant1) = (nZ(x, y) + nZ(x, (y + d + d) And imageConstant1)) * 0.5F + CSng(d * (rnd.NextDouble - 0.5))
                    nZ((x + d) And imageConstant1, (y + d) And imageConstant1) = (nZ(x, y) + nZ((x + d + d) And imageConstant1, (y + d + d) And imageConstant1) + nZ(x, (y + d + d) And imageConstant1) + nZ((x + d + d) And imageConstant1, y)) * 0.25F + CSng(d * (rnd.NextDouble - 0.5))
                Next x
            Next y
        Loop
    End Sub

    Private Sub Sky()
        Dim c1 As Integer
        Dim c2 As Integer
        Dim k As Single
        Dim s As Single
        Dim sx1 As Single
        Dim sy1 As Single

        sX = 100.0F + CSng(rnd.NextDouble) * 824.0F
        sY = 192.0F + CSng(rnd.NextDouble) * 157.0F

        For y As Integer = 0 To 383
            sy1 = 100000.0F / CSng(390 - y)
            For x As Integer = 0 To imageWidth - 1
                sx1 = (CSng(x) - (imageConstant1 + 0.5F)) * sy1 * 0.0005F
                k = BN(sx1, sy1) - BN(sx1 * 0.14F + sy1 * 0.21F, sy1 * 0.14F - sx1 * 0.21F)
                If k < -8.0F Then
                    k = 0.0F
                Else
                    k = (k + 8.0F) * 0.02F
                    If k > 1.0F Then k = 1.0F
                End If
                fC = &H908000 + CInt((sY + 500.0F) * 0.2F)
                c1 = Lerp(fC + 25, &H906050, CSng(y / 384))
                c2 = Lerp(&H807080, &HD0D0D0, CSng(y / 384))
                s = 50.0F / CSng(Math.Sqrt((x - sX) * (x - sX) + (y - sY) * (y - sY)))
                If s > 1.0F Then s = 1.0F
                c1 = Lerp(&HFFFFFF, c1, s)
                col(x, y) = Lerp(c2, c1, k)
            Next x
        Next y
    End Sub

    Private Sub FCC()
        Dim r As Integer
        Dim g As Integer
        Dim b As Integer

        For x As Integer = 0 To 127
            For y As Integer = 0 To 7
                r = 0
                g = 0
                b = 0
                For yy As Integer = 0 To 47
                    For xx As Integer = 0 To 7
                        r += col(xx + x * 8, yy + y * 48) And 255
                        g += (col(xx + x * 8, yy + y * 48) And &HFF00)
                        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 Sub Water()
        Dim x1 As Integer
        Dim y1 As Integer
        Dim k As Single
        Dim c As Integer
        Dim kx As Single
        Dim sx1 As Single
        Dim sy1 As Single
        Dim sx2 As Single
        Dim sy2 As Single

        For y As Integer = imageHeight To (imageHeight \ 2) Step -1
            k = CSng((y - ((imageHeight \ 2) - 1))) * 0.5F
            kx = CSng((900 - y) / 580)
            For x As Integer = imageWidth To 0 Step -1
                sy1 = CSng(64000 / (y - 380))
                sx1 = (CSng(x) - (imageConstant1 + 0.5F)) * sy1 * 0.002F
                sy2 = sy1 * 0.34F - sx1 * 0.71F
                sx2 = sx1 * 0.34F + sy1 * 0.71F
                sy1 = sy2 * 0.34F - sx2 * 0.21F
                sx1 = sx2 * 0.34F + sy2 * 0.21F
                wB(x, y) = BN(sx1, sy1) - BN(sx2, sy2)
                If x < imageWidth And y < imageHeight 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 = CInt(x + wX(x, y))
                    If x1 < 0 Then
                        x1 = -x1
                    ElseIf x1 > imageWidth - 1 Then
                        x1 = ((imageWidth * 2) - 1) - x1
                    End If
                    y1 = CInt(imageHeight - y + wY(x, y))
                    If y1 < 0 Then
                        y1 = 0
                    ElseIf y1 > 383 Then
                        y1 = 383
                    End If
                    c = Lerp(BC(CSng(x1 / 8), CSng(y1 / 48)), &H352520, kx)
                    col(x, y) = c
                End If
            Next x
        Next y
    End Sub

    Private Sub Air()
        Dim c As Integer
        Dim k1 As Single
        Dim k2 As Single
        Dim s As Single

        For y As Integer = 0 To imageHeight - 1
            k1 = CSng((1 - Math.Abs(383.5 - y) / 384) ^ 5)
            For x As Integer = 0 To imageWidth - 1
                If y = sY Then
                    k2 = 0.25F
                Else
                    k2 = CSng(Math.Atan((x - sX) / (y - sY)) / 6.283186 + 0.25)
                End If
                If (y - sY) < 0 Then k2 = k2 + 0.5F
                k2 = BN(k2 * 512.0F, 0.0F) * 0.03F
                k2 = 0.2F - k2 * k2
                If k2 < 0.0F Then k2 = 0.0F
                s = 50.0F / CSng(Math.Sqrt((x - sX) * (x - sX) + (y - sY) * (y - sY)))
                If s > 1.0F Then s = 1.0F
                c = Lerp(&HFFFFFF, fC, k2 * (1 - s))
                byteList.AddRange(BitConverter.GetBytes(Lerp(c, col(x, y), k1)))
            Next x
        Next y
    End Sub

    Private Function BC(ByVal x As Single, ByVal y As Single) As Integer
        Dim ix As Integer = CInt(Int(x))
        Dim iy As Integer = CInt(Int(y))
        Dim sX1 As Single = x - ix
        Dim sY1 As Single = y - iy
        Dim c0 As Integer = cc(ix And 127, iy Mod 9)
        Dim c1 As Integer = cc((ix + 1) And 127, iy Mod 9)
        Dim c2 As Integer = cc(ix And 127, (iy + 1) Mod 9)
        Dim c3 As Integer = cc((ix + 1) And 127, (iy + 1) Mod 9)

        Return CInt((c0 And 255) * (1.0F - sX1) * (1.0F - sY1) + (c1 And 255) * sX1 * (1.0F - sY1) + (c2 And 255) * (1.0F - sX1) * sY1 + (c3 And 255) * sX1 * sY1) + _
            (CInt((c0 And &HFF00) * (1.0F - sX1) * (1.0F - sY1) + (c1 And &HFF00) * sX1 * (1.0F - sY1) + (c2 And &HFF00) * (1.0F - sX1) * sY1 + (c3 And &HFF00) * sX1 * sY1) And &HFF00) + _
            (CInt((c0 And &HFF0000) * (1.0F - sX1) * (1.0F - sY1) + (c1 And &HFF0000) * sX1 * (1.0F - sY1) + (c2 And &HFF0000) * (1.0F - sX1) * sY1 + (c3 And &HFF0000) * sX1 * sY1) And &HFF0000)
    End Function

    Private Function BN(ByVal x As Single, ByVal y As Single) As Single
        Dim ix As Integer = CInt(Int(x))
        Dim iy As Integer = CInt(Int(y))
        Dim sX1 As Single = x - ix
        Dim sY1 As Single = y - iy

        Return nZ(ix And imageConstant1, iy And imageConstant1) * (1.0F - sX1) * (1.0F - sY1) + nZ((ix + 1) And imageConstant1, iy And imageConstant1) * sX1 * (1.0F - sY1) + nZ(ix And imageConstant1, (iy + 1) And imageConstant1) * (1.0F - sX1) * sY1 + nZ((ix + 1) And imageConstant1, (iy + 1) And imageConstant1) * sX1 * sY1
    End Function

    Private Function Lerp(ByVal c1 As Integer, ByVal c2 As Integer, ByVal k As Single) As Integer
        Return CInt((c1 And 255) * k + (c2 And 255) * (1.0F - k)) Or (CInt((c1 And &HFF00) * k + (c2 And &HFF00) * (1.0F - k)) And &HFF00) Or (CInt((c1 And &HFF0000) * k + (c2 And &HFF0000) * (1.0F - k)) And &HFF0000)
    End Function
End Class

[kareninstructor]

Not sure why but your original conversion in post 13 looks better than the code in post 26. Both look great but 13 is indeed better looking.

Nicely done!

[EntityX]

I've been playing around with it. I added a separate form just for adjustments. The adjustments form opens when you start it and then you click a button to create the image. If you close the display form then the adjustment form opens so you can try new adjustments. I added a module for variables that can be used with both forms. I have 7 values I'm adjusting so far but will no doubt add more. There's probably going to be many different versions of this now which is ok. I've also been converting a lot of the hex values that I'm playing with to decimal. I created a little application so I can do that easily. Below are the Subs I modified so the adjustments can take place along with the module with the Public declared variables and the code for FormAdjustments.

Public Class FormAdjustments

    Private Sub ButtonCreatePicture_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonCreatePicture.Click
        If IsNumeric(TextBoxkxL.Text) = True Then
            kxL = CSng(TextBoxkxL.Text)
        End If
        If IsNumeric(TextBoxkxR.Text) = True Then
            kxR = CSng(TextBoxkxR.Text)
        End If
        If IsNumeric(ComboBoxAdjustWaterColor.Text) = True Then
            AdjustWaterColor = CLng(ComboBoxAdjustWaterColor.Text)
        End If
        If IsNumeric(ComboBoxAdjustSkyColor1.Text) = True Then
            AdjustSkyColor1 = CLng(ComboBoxAdjustSkyColor1.Text)
        End If
        If IsNumeric(ComboBoxAdjustSkyColor2.Text) = True Then
            AdjustSkyColor2 = CLng(ComboBoxAdjustSkyColor2.Text)
        End If
        If IsNumeric(ComboBoxFC1.Text) = True Then
            FC1 = CLng(ComboBoxFC1.Text)
        End If
        If IsNumeric(ComboBoxAdjustAirColor.Text) = True Then
            AdjustAirColor = CLng(ComboBoxAdjustAirColor.Text)
        End If
        Form1.Show()
        Me.Hide()
    End Sub
End Class

Module SharedVariables
    Public kxL As Single = 900
    Public kxR As Single = 580
    Public AdjustWaterColor As Long = 3482912
    Public AdjustAirColor As Long = 16777215
    Public AdjustSkyColor1 As Long = 16777215
    Public AdjustSkyColor2 As Long = 9461840
    Public FC1 As Long = 9469952
End Module

  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 = CSng(100 + rnd.NextDouble * 824)
        SY = CSng(192 + rnd.NextDouble * 157)
        For y = 0 To 383
            sy1 = CSng(100000 / (390 - y))
            For x = 0 To 1023
                sx1 = CSng((x - 511.5) * sy1 * 0.0005)
                k = BN(sx1, sy1) - BN(CSng(sx1 * 0.14 + sy1 * 0.21), CSng(sy1 * 0.14 - sx1 * 0.21))
                If k < -8 Then k = 0 Else k = CSng((k + 8) * 0.02) : If k > 1 Then k = 1
                FC = CLng(FC1 + (SY + 500) * 0.2) 'FC1 was 9469952 in hex
                c1 = Lerp(FC + 25, AdjustSkyColor2, CSng(y / 384)) ' &H906050  9461840
                c2 = Lerp(&H807080, &HD0D0D0, CSng(y / 384))
                s = CSng(50 / Math.Sqrt((x - SX) * (x - SX) + (y - SY) * (y - SY)))
                If s > 1 Then s = 1
                c1 = Lerp(AdjustSkyColor1, c1, s)
                Col(CInt(x), CInt(y)) = Lerp(c2, c1, k)
            Next x
        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 = CSng((y - 383) * 0.5)
            kx = CSng((kxL - y) / kxR)
            For x = 1024 To 0 Step -1
                sy1 = CSng(64000 / (y - 380))
                sx1 = CSng((x - 511.5) * sy1 * 0.002)
                sy2 = CSng(sy1 * 0.34 - sx1 * 0.71)
                sx2 = CSng(sx1 * 0.34 + sy1 * 0.71)
                sy1 = CSng(sy2 * 0.34 - sx2 * 0.21)
                sx1 = CSng(sx2 * 0.34 + sy2 * 0.21)
                WB(CInt(x), CInt(y)) = BN(sx1, sy1) - BN(sx2, sy2)
                If x < 1024 And y < 768 Then
                    WX(CInt(x), CInt(y)) = (WB(CInt(x + 1), CInt(y)) - WB(CInt(x), CInt(y))) * k * kx
                    WY(CInt(x), CInt(y)) = (WB(CInt(x), CInt(y + 1)) - WB(CInt(x), CInt(y))) * k
                    x1 = CLng(x + WX(CInt(x), CInt(y)))
                    If x1 < 0 Then x1 = -x1 Else If x1 > 1023 Then x1 = 2047 - x1
                    y1 = CLng(768 - y + WY(CInt(x), CInt(y)))
                    If y1 < 0 Then y1 = 0 Else If y1 > 383 Then y1 = 383
                    c = Lerp(BC(CSng(x1 / 8), CSng(y1 / 48)), AdjustWaterColor, kx)
                    Col(CInt(x), CInt(y)) = c
                End If
            Next x
        Next y
    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 = CSng((1 - Math.Abs(383.5 - y) / 384) ^ 5)
            For x = 0 To 1023
                If y = SY Then
                    k2 = 0.25
                Else
                    k2 = CSng(Math.Atan((x - SX) / (y - SY)) / 6.283186 + 0.25)
                End If
                If (y - SY) < 0 Then k2 = CSng(k2 + 0.5)
                k2 = CSng(BN(k2 * 512, 0) * 0.03)
                k2 = CSng(0.2 - k2 * k2) : If k2 < 0 Then k2 = 0
                s = CSng(50 / Math.Sqrt((x - SX) * (x - SX) + (y - SY) * (y - SY)))
                If s > 1 Then s = 1
                c = Lerp(AdjustAirColor, FC, k2 * (1 - s))
                BUFFER_SCREEN(CInt(yReal + x)) = CInt(Lerp(c, Col(CInt(x), CInt(y)), k1))
            Next x
            yReal = yReal + EngineWidth
        Next y
    End Sub

[EntityX]

Here's some more.

[Jenner]

You should use ColorPickers for those color offset numbers. The format of those hex strings are:

&HRRGGBB = First 2 are the R value (0-255), then green, then blue.

You can do the conversion with:

    Private Function ColorToHex(ByVal color As Color) As Integer
        Return color.R * &HFF00 + color.G * &HFF + color.B
    End Function

Then:

   Private colorWater As Color = Color.FromArgb(0, &H35, &H25, &H20)

And change your color line to:

                    c = Lerp(BC(CSng(x1 / 8), CSng(y1 / 48)), ColorToHex(colorWater), kx)

And finally, on a button-click:

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Me.ColorDialog1.Color = colorWater
        If Me.ColorDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
            colorWater = ColorDialog1.Color
        End If
    End Sub

[Grimfort]

Now all we need to add is the ability to auto-export the image as your background once every 15 mins .

[Zeelia]

How about gradientally changing the image as your background, so that it smoothly goes from one "color" to another? That would be awesome, not that this code isn't awesome already :P

*EDIT* Or like, depending on time of day, the image will have different colors and the sun will be at different locations?

[Jenner]

Scratch my last post. My math is off. Still trying to figure out what I did wrong but when converting the default "water" color to a color, it's coming out way too blue.

I don't have much more time I can play with this unfortunately. Very cool though.

[EntityX]

Scratch your last post completely or just parts of it? There's plenty I don't understand about the program. I just know that I was adjusting those values and getting some cool results. Let me ask what's going on here with the Lerp function.

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

I don't understand what's going on with those And's and Or's. Seems like Lerp would equal

       CLng((c1 And 255) * k + (c2 And 255) * (1 - k))

Or

(CLng((c1 And &HFF00&) * k + (c2 And &HFF00&) * (1 - k)) And &HFF00&)

Or

(CLng((c1 And &HFF0000) * k + (c2 And &HFF0000) * (1 - k)) And &HFF0000)

Is that so and if it is how does it choose which one. Whatever is the greatest? And what does for instance the 2nd code snippet mean? Just to take part of it, I don't get what, (c1 And 255) * k, means.

Another question is &HFF00&. If I try to convert that to decimal it doesn't work. The & on the right end keeps it from converting. What's it doing there?

[Milk]

<snip>Another question is &HFF00&. If I try to convert that to decimal it doesn't work. The & on the right end keeps it from converting. What's it doing there?

Can't comment on VB.Net behaviour but you would add the & in classic to ensure a positive Long of 65280 (Integer in Net) rather than the default which would be a negative Integer of -256 (Short).

[EntityX]

I've been thinking about Jenner's explanation of the hexadecimal and the use of colors and see that it would make more sense to just leave it in hex. Two hex digits will never exceed 255 so it makes sense to use hex. I'll just change my code so I'm using hex for the colors again.

[Evil_Giraffe]

There's plenty I don't understand about the program.
...
Let me ask what's going on here with the Lerp function.

Ah, now this is one of the few parts of the program that I *do* understand

Lerp is a common shortening for Linear Interpolation. It is taking two integers that represent colours - c1 and c2 - and finding the colour that is at point k on the interpolated line between them.

Because the colours are represented as integers, that's where all the Ands and Ors come in. The trick to notice is that they're operating on numbers, not booleans, so they aren't logical Ands and Ors, they're bitwise.

if c1 was &H123456, for example, we'd be looking at the following:

c1 And &HFF
 =     &H123456  =     00010010 00110100 01010110
   And &H0000FF    And 00000000 00000000 11111111
 =     &H000056  =     00000000 00000000 01010110

As you can see, that pulls out the bottom two hex digits from c1. Likewise c1 And &HFF00 pulls out hex digits 3 and 4, c1 And &HFF0000 pulls out digits 5 and 6

Just to take part of it, I don't get what, (c1 And 255) * k, means.

These are the three components of the colour (Red, Green, Blue) which are then interpolated separately against c2's components. This is the (c1 And <mask>)*k + (c2 And <mask>)*(1-k) part. It is simply taking the weighted average of the two numbers.

The blue and green components, however, need another And to pull out the hex digits again, because the interpolation between &H120000 and &HFE0000 could lie anywhere between those two numbers, which means the possibility of non-zero hex digits in digits 1,2,3 and 4, which would affect the red and green components if they weren't stripped out.

Once you have the individual components of the interpolated colour, you use a bitwise Or to combine them into a single integer:

   &H000021 =    00000000 00000000 00100001
Or &H004300   Or 00000000 01000011 00000000
Or &H650000   Or 01100101 00000000 00000000
 = &H654321    = 01100101 01000011 00100001

Another question is &HFF00&. If I try to convert that to decimal it doesn't work. The & on the right end keeps it from converting. What's it doing there?

I think that's a typo? drop the ampersand at the end

[EntityX]

Evil Giraffe thanks for that explanation.

On my adjustment form I went back to hex values which makes much more sense than using decimal. I'm up to adjusting 11 different variables now. I experimented playing around with others but haven't found any yet that are really worth adjusting but I'll keep looking. I'll soon post my code so everyone sees what values I'm playing around with and if someone finds one I'm not adjusting that is good to adjust you can let me and everyone else know.

Next question is whether I should update my version with Jenner's code posted in post # 26. I've been working with his code from post # 13. Probably isn't too much work. Perhaps I'll copy the project and update one with his latest code and then compare how the two work.

[Evil_Giraffe]

I took the code in post #26 and converted it to C#. Incorrectly. (Doesn't generate water for some reason).

However, I have found that trying to tease apart the functionality to understand it is problematic due to what it sounds like are "optimisations" put in on purpose (going by the comments). I haven't really looked at the code in post #13 but might try converting that to C# to see if that is any clearer.

(Not being deliberately perverse - I deal with C# code more fluently (my day job is C#) plus my Resharper licence only covers C#!)

Err, the point being that you might want to stick with the code in #13 for understanding what's going on.

[Jenner]

Yea, you have to be careful with the code in general. If you have strict on, one bad datatype conversion and you're stripping the decimals off a needed number causing it to always return 0.

As I said, the code in 13 looks cleaner, but is ugly to a compiler.

EntityX's code in #23 is better as it lets you turn Strict On, but all the conversions at the final stages of the computations, not on the needed points within. The compiler is still having to do a certain amount of implicit conversions, it still does this to some degree with numbers even if Strict is On.

By default, VB.NET handles decimals as Doubles, but the code is written to use Singles, so tagging all your hard-coded decimals with "F" on the end to specify they're Singles saves you those conversions.

Here's a little code example I whipped up talking about it at least the way it was explained to me.

Option Strict On

Public Class Form1

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim s0 As Single = 4.5F + 7 + 3.2 + 10L 'No error, even with Strict On, VB converts the number types before processing them.  
        'It does 3 implicit conversions here turning integer 7 into a single, double 3.2 into a single an long 10 into a single before doing the math on them.

        Dim s1 As Single = 4.5F + 7 + 3.2 + 10L + Math.Sqrt(4)  'Gives error because the signature of Math.Sqrt() returns double, so 
        'it processes the equation as a double, then tries to assign it to a variable defined as a single

        Dim s2 As Single = CSng(4.5F + 7 + 3.2 + 10L + Math.Sqrt(4)) 'No error. All terms of the equation are first converted to a double, then
        'processed as a double, then the result is converted to a single before assigned to the variable.  It does 5 implicit conversions and one explicit one. 
        'Where's the 5th? The "4" in the square root.  Math.Sqrt() expects a double, not an integer.

        Dim s3 As Single = 4.5F + CSng(7) + CSng(3.2) + CSng(10L) + CSng(Math.Sqrt(CDbl(4))) 'All terms explicitly converted and equation processed as a single.
        '5 explicit conversions.

        Dim s4 As Single = 4.5F + 7.0F + 3.2F + 10.0F + CSng(Math.Sqrt(4.0)) 'One conversion since all datatypes are defined properly up front.  Equation is
        'processed as a single.  
    End Sub
End Class