-
[RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
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.
Code:
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
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
So what is the question :).
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
Quote:
Originally Posted by
Grimfort
So what is the question :).
I guess the OP is asking if someone could convert that VB6 code into VB.Net.
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
I thought that would be the question, but hoped it was not. The part where the OP says
Quote:
Originally Posted by
EntityX
...so I thought it would be good to convert the code to Visual Basic 2010.
would hope that it had already been started :).
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
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:-
Code:
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
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
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.
Code:
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
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
Quote:
Originally Posted by
FunkyDexter
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.
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
Cool. I wasn't sure and I just thought the thread might die if people had the wrong idea.
Code:
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:-
Code:
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.
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
Here is the BITMAPINFOHEADER for VB.NET
http://www.pinvoke.net/default.aspx/...NFOHEADER.html
Code:
<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
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
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).
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
Quote:
Originally Posted by
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).
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.
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
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.
-
1 Attachment(s)
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
Nevermind. Converted it successfully. :)
Code is below.
Code:
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
Attachment 85174
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
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?
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
Quote:
Originally Posted by
Jenner
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!
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
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.
-
1 Attachment(s)
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
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.
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
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.
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
Quote:
Originally Posted by
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.
Did you press the space bar key, i.e. the value 32 (look at the KeyDown event).
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
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.
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
Quote:
Originally Posted by
EntityX
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.
-
Re: Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever" thread
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.
Code:
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
-
1 Attachment(s)
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
Here's one that I came up with...
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
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.
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
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.
Code:
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
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
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!
-
5 Attachment(s)
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
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.
Code:
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
-
5 Attachment(s)
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
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:
Code:
Private Function ColorToHex(ByVal color As Color) As Integer
Return color.R * &HFF00 + color.G * &HFF + color.B
End Function
Then:
Code:
Private colorWater As Color = Color.FromArgb(0, &H35, &H25, &H20)
And change your color line to:
Code:
c = Lerp(BC(CSng(x1 / 8), CSng(y1 / 48)), ColorToHex(colorWater), kx)
And finally, on a button-click:
Code:
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
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
Now all we need to add is the ability to auto-export the image as your background once every 15 mins :).
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
How about gradientally changing the image as your background, so that it smoothly goes from one "color" to another? :D 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?
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
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. :)
-
1 Attachment(s)
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
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.
Code:
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
Code:
CLng((c1 And 255) * k + (c2 And 255) * (1 - k))
Or
Code:
(CLng((c1 And &HFF00&) * k + (c2 And &HFF00&) * (1 - k)) And &HFF00&)
Or
Code:
(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?
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
Quote:
Originally Posted by
EntityX
<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).
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
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.
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
Quote:
Originally Posted by
EntityX
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:
Code:
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
Quote:
Originally Posted by
EntityX
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:
Code:
&H000021 = 00000000 00000000 00100001
Or &H004300 Or 00000000 01000011 00000000
Or &H650000 Or 01100101 00000000 00000000
= &H654321 = 01100101 01000011 00100001
Quote:
Originally Posted by
EntityX
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
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
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.
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
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.
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
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.
Code:
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
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
EntityX ... I think it would be cool if you added a randomize button to your adjustment form that fills in the fields with random values in the appropriate range for each parameter. A lot of Photoshop plugins have this feature to randomize the effect that it's designed to produce...
http://www.vbforums.com/attachment.p...1&d=1312413365
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
I've ventured into adjusting some variables that will sometimes cause arithmetic overflows. I was putting the Lerp function inside of a Try but after the error message comes up the screen keeps flashing and I have to use task manager to close. I tried putting Application.Exit after the MessageBox.Show like this
Code:
Private Function Lerp(ByVal c1 As Integer, ByVal c2 As Integer, ByVal k As Single) As Integer
Try ' Try being used because many adjustments combinations are possible and some may cause arithmetic overflow or other types of problems
Return CInt((c1 And 255) * (k * LerpkMultiplier1) + (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 * LerpkMultiplier2 + (c2 And &HFF0000) * (1.0F - k)) And &HFF0000)
Catch ex As Exception
MessageBox.Show("Lerp Function problem. " & ex.Message)
Application.Exit()
Lerp = 1 ' this is here so the function always returns a value otherwise you get a squiggly line under End Function
End Try
End Function
but it still doesn't close and I have to use task manager. I could just skip adjusting those problem variables or limit the adjusting range which is a simpler solution but there might arise some combination of settings that causes a problem so I'd like to know how to close the application if it catches an exception. I'm up to adjusting 15 variables now. You'll notice LerpMultiplier1 and 2 in the Lerp function above. I'm limiting those to 1.5 maximum.
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
I just posted in the Code Bank. I'll probably update the zip file with improvements. I already noticed something I missed. It's just that you can only enter integer values in the WaterRipple textbox. You mostly would only want to use integer values so I might just change WaterRipple from Single to Integer. Not seeing the arithmetic overflow problem because I limited the range of the problem variables but would still like to figure out how to get the application to close when an exception is thrown.
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
Quote:
Originally Posted by
EntityX
I've ventured into adjusting some variables that will sometimes cause arithmetic overflows.
...
You'll notice LerpMultiplier1 and 2 in the Lerp function above. I'm limiting those to 1.5 maximum.
Yeah... take those two out. You're breaking the meaning of the function. The function interpolates between two colours. If you want to produce weird effects, pass in weird colours. Don't make this function do weird stuff.
Without those two multipliers, the Lerp function will not error.
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
Quote:
Yeah... take those two out.
...Don't make this function do weird stuff.
No, I don't feel like it. :)
It's working ok now. I limited the values for LerpkMultiplier1 to 3 so they can't go above 1.5. You can get some cool results in my opinion by using those so I'm going to leave them in. If you use my code bank entry you can always just leave them at the default value if that's what you prefer. Some people like weird stuff.
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
Quote:
Originally Posted by
Evil_Giraffe
You're breaking the meaning of the function.
Care to respond to that point at all?
-
1 Attachment(s)
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
If you want the same picture every time then don't use any adjustments at all. Forget about my adjustments form and just use the basic code. No one has to pay any attention to what I did. Create your own unique application if you like. Like I said before just leave LerpkMultiplier1 to 3 at 1 and it's just like those adjustments aren't there. But using them you can do some stuff that you wouldn't otherwise be able to do. All I'm doing is expanding the possibilities of what you can do with the picture. I'm not aware of any Lerp function police that are going to sue me or arrest me. Yes I'm doing something that wasn't originally intended with the program. So if you don't like that then don't use my code. The program just creates a bunch of picture elements on a screen. I'm expanding the possibilities for creating a greater variety of different pictures that's all.
In the below picture I used LerpkMultiplier1 at 1.05 to get the yellow sun. You can do that another way most likely but using that adjustment worked pretty good. So what's so evil about that?
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
Quote:
Originally Posted by
EntityX
So what's so evil about that?
The source of this program came from a topic entitled "The most amazing VB6 Code ever". I strongly disagree with that assessment.
Yes, the program is pretty amazing, but the code is an impenetrable mess of calculations that does not clearly communicate its intent and is incredibly difficult to comprehend for anyone looking to maintain or extend it.
There are a few places that are simple enough to be understood by themselves. One of those was the Lerp function. The function returned the colour that was partway between two supplied colours (the distance along the line between the two colours being controlled by the k parameter). You've now destroyed that small oasis of clarity not just by making the semantics unclear, but by making the semantics wrong. The 3 multiplier variables are not scoped to the function itself so apply to every linear interpolation. And what does it mean for a LerpkMultiplier1 value of 1.05? It means that (for every linear interpolation performed, remember) that once you have taken the weighted average of the two colours, you will then turn around and add another .05 of the red component of the first colour to the final result.
If you can't see that there's a conceptual problem with that, that would be bad enough. However, you're posting it to the Codebank, thereby promoting it as some kind of good programming practice. That's what's so evil: spreading the idea that sloppy hacking that seems to get what you want is a good way of programming. You've not stopped to consider the fact that you're getting overflow exceptions might imply you've broken some of the fundamental assumptions on which this code hinges? No, you've got a yellow sun and that's what you wanted.
You want a yellow sun? Find the code that determines the base colour of the sun. Don't break the interpolation function to make every colour come out more yellow.
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
P.S. Because I'm nice, I'll suggest that you look at the end of the Sky method. In my C# port it looks like this:
csharp Code:
s = 50f/(float) (Math.Sqrt((x - m_sunPosition.X)*(x - m_sunPosition.X) + (y - m_sunPosition.Y)*(y - m_sunPosition.Y)));
if (s > 1f)
{
s = 1f;
}
c1 = Lerp(0xFFFFFF, c1, s);
(originally m_sunPosition.X and m_sunPosition.Y were sX and sY - making that realisation and updating my variable names allowed this piece of code to become clearer)
So what is this doing? s is initially 50 divided by the distance in pixels between the current x,y being considered (it is considering every pixel in the sky in a loop) and the position of the sun. Therefore, s is inversely proportional to the distance from the centre of the sun. We then clamp the value of s to not be higher than 1. Since the value of s is 1 at 50 pixels, uyou can see that whilst we are less than 50 pixels from the centre of the sun, s will be 1, and if we are further than 50 pixels from the centre of the sun, the value of s decreases asymptotically.
s is then used as the k argument to a call to Lerp that interpolates between 0xFFFFFF (white colour) and c1. This result is written back to c1. So what it is actually doing is saying that inside 50 pixels from the centre of the sun, we have white. Outside 50 pixels from the centre we fade from white back to the base c1 colour. Adjusting the 0xFFFFFF is probably a good starting point for figuring out how to get a different coloured sun, as that appears to be the base colour.
However, we then interpolate between that colour and the colour c2 by some factor k. c2 (like c1) is a vertical gradient across the sky, and the k comes from the BN method which is a tiled 2 dimensional "smooth" random plane. The index it uses into that set of values is opaque to me at this point, I haven't looked too closely at that part, but the figures by which it is multiplying the base values seem somewhat arbitrary at first glance - this could just be a stretching thing to make sure it doesn't line up with other accesses to the values and give an obvious tiled look to the resulting image.
I would recommend that you take the time to try and understand what the code is doing in the small. Work through and determine for yourself what the variables represent. That is a very good skill to practice. Then muck about with the code once you understand the structure.
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
(In fact, I've just made another refactoring to my code after explaining the above:
csharp Code:
float pixelsFromCentreOfSun = (float)Math.Sqrt((x - m_sunPosition.X)*(x - m_sunPosition.X) + (y - m_sunPosition.Y)*(y - m_sunPosition.Y));
s = 50f / pixelsFromCentreOfSun;
I'm slowly chipping away at the code and making it more clear and expressive. Each change is small and you might argue doesn't really get you anything, but they add up to a big improvement in the code as a whole)
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
Okay, so to test my theory that that 0xFFFFFF was the sun base colour, I adjusted the value to match the yellow from your program screenshot, and sure enough I got a yellow sun to match yours. But because I'd done it by adjusting the base colour rather than fritzing the interpolation function, I also got a yellow glow around the sun. If you note in your screenshot, you get a white glow around the sun.
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
ok I'll remove the post in CodeBank. You can put one up if you like or Jenner can.
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
And to demonstrate that reasoning about the code in its current state is fraught with peril, I in fact got the below completely wrong.
Quote:
Originally Posted by
Evil_Giraffe
And what does it mean for a LerpkMultiplier1 value of 1.05? It means that (for every linear interpolation performed, remember) that once you have taken the weighted average of the two colours, you will then turn around and add another .05 of the red component of the first colour to the final result.
Note that we have to explain why the sun comes out yellow, but the glow does not? First off, let's note that in fact the 0xFF mask pulls out the BLUE component of the colour, not the red. I discovered this when trying to create the yellow effect - I originally put in a value of 0x1AEDFA (having got R=0xFA, G=0xED, B=0x1A from a screen capture of your posted image). This turned out to be a very blue sun, not yellow. Putting the value of 0xFAED1A was necessary to match your colour.
Now, next nnotice that inside the sun, we call Lerp with a k value of 1 (see earlier reasoning about the Sky() method). We can ignore any effect from c2 inside Lerp (since that will be multiplied by 0).
Since c1 is white (0xFFFFFF) in your version, we work out the blue component by multiplying 0xFF by 1 * LerpkMultiplier1 = 0xFF * 1.05 = 255 * 1.05 = 267.75. We'll chop off the .75 when we convert back to an int, so let's ignore that. What is 267 in Hex? 0x10B. Assuming other LerpkMultipliers of 1, we get 0x10B + 0xFF00 + 0xFF0000 as our final calculation. That is a hex value of 0x100000B. I can only assume that you've added an And clause to the blue component with a bitmask ox 0xFF, in which case you get 0xFFFF0B. And that's why it's yellow, you've completely killed off the blue component of your sun's colour.
Now, as s decreases (outside of 50 pixels from the sun's centre) pretty quickly it will reach s = 0.95 (within 2 pixels according to my calculations). AT this point, the blue component calculation comes out below 0x100, and you're back with the blue component being fully present, and you switch back to a white-ish colour (I say white-ish - the blue component is given slightly more weight than the red and green so it will be a blue tinged glow rather than plain white.)
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
Quote:
Originally Posted by
EntityX
ok I'll remove the post in CodeBank. You can put one up if you like or Jenner can.
Two points
1) The process of working through the code and understanding it and then refactoring the code is the main takeaway from this, for me. Not the finished piece of code itself.
2) My version doesn't work. I've got some integer arithmetic going on somewhere that shouldn't be happening. I can tell this by taking advantage of a property of the Random class. Starting with the same seed generates the same sequence every time. Since I have done a straight port, the same sequence of random numbers means the same numbers go into the calculations each time (if I had reordered too much this would no longer hold) so I can compare the results of the VB version with my C# version by making the following changes:
vbnet Code:
Private rnd As New Random(1)
csharp Code:
private Random m_rnd = new Random(1);
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
I stopped messing with this code a while ago now. I'd love to refactor it and fully document it out, but I don't have the time.
I totally agree with Evil Giraffe though, the core functions like Lerp() should be left as they are, because when type in "Lerp" into Google, I get as the first hit, the Wikipedia on Linear Interpolation and it tells me what the function must look like; they're standard functions.
I'm actually surprised nobody made the Sky(), Water(), etc take a Type Color as an argument, or send a Type Point argument to Sky() for the sun's position. It seems like a logical step forward.
The biggest problem with this code in my opinion is the sloppy-as-hell use of numerical types. Shifting between integers and floats all over the place without concern for numerical integrity or understanding is a recipe for confusion. Maybe not the mot amazing code ever, but a nice example of mathematically generated scenes.
-
2 Attachment(s)
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
I went ahead and had the thread in CodeBank removed. Earlier I had 2 versions in this post but I just deleted the one that has the LerpkMultiplier1 to 3 in it so now there's just the version that doesn't have those. I noticed that even though you can get some different results using those 3 variables I added to the Lerp function the results aren't that great or else the results can be gotten using other adjustments. The version here has an adjustments form that looks like what you see in this screenshot. If you wanted to add or remove some variables for adjustment you could use this if you want.
When the program starts it has the default values in the textboxes. Click Generate Picture to get a picture. No need to hit the space bar. If you close the picture form using the close box the adjustments form will reopen and you can try some other adjustments. Esc key will close the program from either form as it did before.
-
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
The 383 and 384 values (yDivisor, k1L, k1R) that you've made configurable probably shouldn't be made configurable, as they are linked to the horizon height at half the height of the image. There are some assumptions made in the code that prevent certain computations generating a value outside of a certain range (for example, arguments passed to k in Lerp should be between 0 and 1 inclusive - there are some computations that could go out of whack if you allow the divisor to change).
I don't mean to keep banging on about this, but it would behoove you to understand how these values are being used and any constraints on them before altering them willy-nilly.
-
1 Attachment(s)
Re: [RESOLVED] Convert VB6 Code to VB2010. Code from "The most amazing VB6 Code ever"
I suspected you might say something like that which is why I said, "If you wanted to add or remove some variables for adjustment you could use this if you want." The reason those added variables are there is because I was simply experimenting with adding variables. Sure for some values that you enter you might get an undesirable result but you might also be able to create something that is interesting that you wouldn't otherwise be able to create. If you take out everything that would ever possibly create an undesirable result then your range of possibilities goes down. You can modify my code though however you like and create your own version that suits you.
If you were going to take some more things out I would say what you just mentioned, yDivisor, k1L, and k1R, would be first on the list. I would leave kxL and kxR in even if there's a good reason to take them out because you can get some interesting results by using them. Using yDivisor doesn't do that much.
