dmkp231

Hi I was wondering if there was a better way of setting pixels other than the bitmap class.

It has the annoying habit of not letting you set the perimeter of the image's pixels:

X = 0, y = 0 or x = width, y = height.

It is also incredibly slow.

Any way I can get the setpixel function from vb6 or something similar for the pictureBox Stretching the bitmap to the size of the picturebox makes a border around it (because the bitmap has to be slightly larger to allow me to set all the necessary pixels).

Hope I was clear :/

Would be nice to know how to view the code that powers the SetPixel function for the bitmap class, do you know how I can view it

Hope someone can help :)



Re: Visual Basic Express Edition BitMap SetPixel

jo0ls

SetPixel works. As the first pixel is (0,0) the last pixel is (width - 1, height -1)

The code that powers SetPixel is not in vb.

You can do things faster by copying arrays of integers directly into the bitmap's memory. But it is not simple.

GDI+ is also faster for some things.

Imports System.Runtime.InteropServices

Public Class Form1

Private pb As New PictureBox

Sub New()
InitializeComponent()
Me.Controls.Add(pb)
pb.Dock = DockStyle.Fill
Draw1() ' change to test the different subs
End Sub

' definately the slowest
Sub Draw1()
Dim bm As New Bitmap(pb.Width, pb.Height)
' fill with red
Dim g As Graphics = Graphics.FromImage(bm)
g.Clear(Color.Yellow)
g.Dispose()
' setpixel border
' top left pixel is (0,0) bottom right pixel is (bm.width - 1, bm.height - 1)
For x As Integer = 0 To pb.Width - 1
bm.SetPixel(x, 0, Color.Red)
bm.SetPixel(x, bm.Height - 1, Color.Red)
Next
For y As Integer = 0 To pb.Height - 1
bm.SetPixel(0, y, Color.Red)
bm.SetPixel(bm.Width - 1, y, Color.Red)
Next
pb.Image = bm
End Sub

' probably the fastest in this particular case.
Sub Draw2()
Dim bm As New Bitmap(pb.Width, pb.Height)
Dim g As Graphics = Graphics.FromImage(bm)
g.Clear(Color.Yellow)
' You need to take 1 off width and height here too.
Dim rec As New Rectangle(0, 0, bm.Width - 1, bm.Height - 1)
g.DrawRectangle(Pens.Red, rec)
g.Dispose()
pb.Image = bm
End Sub

' much faster if you have to test each pixel.
' much more complicated
Sub Draw3()
Dim bm As New Bitmap(pb.Width, pb.Height)
Dim g As Graphics = Graphics.FromImage(bm)
g.Clear(Color.Red) ' fastest way to set all pixels to red.
g.Dispose()
Dim bmd As Drawing.Imaging.BitmapData
' lock the bitmap's memory
bmd = bm.LockBits(New Rectangle(0, 0, bm.Width, bm.Height), Imaging.ImageLockMode.ReadWrite, Imaging.PixelFormat.Format32bppArgb)

' create a 1d array of integers representing all the colors in the bitmap
' the first element is pixel(0,0), the next is (1,0) etc...
Dim pixels(bm.Width * bm.Height - 1) As Integer
' copy the bitmaps pixels into the array
Marshal.Copy(bmd.Scan0, pixels, 0, pixels.Length)
Dim yellow As Integer = Color.Yellow.ToArgb
For x As Integer = 0 To bm.Width - 1
pixels(x) = yellow
pixels(((bm.Height - 1) * (bm.Width)) + x) = yellow
Next
For y As Integer = 0 To bm.Height - 1
pixels((y * bm.Width)) = yellow
pixels((y * bm.Width) + bm.Width - 1) = yellow
Next
' copy the array back
Marshal.Copy(pixels, 0, bmd.Scan0, pixels.Length)
' unlock
bm.UnlockBits(bmd)
pb.Image = bm
End Sub
End Class





Re: Visual Basic Express Edition BitMap SetPixel

AndrewVos

Search for FastPixel on codeproject. It's an old project I did using the code mentioned above. It's much easier to use though in my opinion because it has SetPixel methods the same as the Bitmap class does.




Re: Visual Basic Express Edition BitMap SetPixel

Tall Dude

JoOls has you on the right track.

For a lot of drawing/graphics solutions,

See the man, Bob Powell at

http://www.bobpowell.net/faqmain.htm






Re: Visual Basic Express Edition BitMap SetPixel

dmkp231

Hmm I found that fastpixel thing earlier today, not sure how it works though, will try it if nothing else works.

Maybe if I elaborate more on what I am doing it will make things clearer :p

Populous:The beginning map/level files have 128*128 tiles. They're all in the file which is 192137bytes big which contains all the details of the objects on the level and stuff... don't really need to tell you about that.

Each tile is 2 bytes in length.

So I open it like so :

Dim bMap as New Bitmap(130,130)

Dim land(0 to 127, 0 to 127) as Short

FileOpen(fHnd, "C:\Program Files\Bullfrog\Populous\levels\levl2001.dat", openmode.binary)

FileGet(fHnd, land,1)

FileClose(fHnd)

then I do a formula to turn it into a colour and paint it to the bitmap class with setpixel.

Its good, but it does not allow you to paint on the edge of the bitmap (x = 0, y = 0 or x = width of bitmap, y = height of bitmap), which means I have to make the bitmap bigger to fit the whole map in, and because its slow I don't just paint it into a bigger bitmap instead of stretching it to fit inside the picturebox with the size mode property.

Stretching it to fit inside a picturebox, stretches the extra pixels around the edge making it not to scale with how it should look. This also means if I want to interact with the level and stuff it wouldn't be exactly represented.

So I was wondering if there was a way of getting something similar to pSet from VB6 for the picturebox, or a way of viewing the code for the SetPixel command in the bitmap class so I could make my own pictureBox.

Hope that helps





Re: Visual Basic Express Edition BitMap SetPixel

jo0ls

Like I said, you can use setpixel for the edges of the bitmap.
The right hand edge is at x = width - 1

Anyway, I got the demo and had a play. The values are the height of the land right I don't have your color converter thing so I've read in the values from the file and translated them into a grey. So if the lowest value was 0 then that will be represented by RGB (0,0,0), if the highest value was 1000 then it will get (255,255,255). All values in between get a value in between.

Click file to open a dat file. Then click go, go1, go2 to try the different methods. The number in the caption bar is the time taken in ms. On my old computer I get 800ms for setPixel, 1ms for lockbits, and nearly 1 second drawing rectangles with GDI. Lockbits is good.

Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging

Public Class Form1

Private pb As New PictureBox
Private WithEvents b1, b2, b3, b4 As New Button
Private stepSize As Double ' for my dumb color conversion
Private minLandLevel As UShort
Private sw As New Stopwatch
Private haveFile As Boolean = False
Private mapdata() As UShort

Sub New()
InitializeComponent()
Me.Controls.AddRange(New Control() {pb, b1, b2, b3, b4})
b4.Text = "File"
b4.Location = New Point(10, 10)
b1.Text = "Go"
b1.Location = New Point(10, b4.Bottom + 10)
b2.Text = "Go 2"
b2.Location = New Point(10, b1.Bottom + 10)
b3.Text = "Go 3"
b3.Location = New Point(10, b2.Bottom + 10)
pb.Left = b1.Right + 10
pb.BackColor = Color.Black
pb.Size = New Size(768, 768)
pb.SizeMode = PictureBoxSizeMode.StretchImage
Me.ClientSize = New Size(pb.Right + 10, 768)
End Sub

Private Sub b4_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles b4.Click
haveFile = False
Dim ofd As New OpenFileDialog
ofd.Filter = "*.dat|*.dat"
If ofd.ShowDialog = Windows.Forms.DialogResult.OK Then
Dim stream1 As IO.Stream = IO.File.OpenRead(ofd.FileName)
Dim binaryReader1 As New IO.BinaryReader(stream1)
mapdata = New UShort((128 * 128) - 1) {}
Dim max As UShort = UShort.MinValue
minLandLevel = UShort.MaxValue
Try
For i As Integer = 0 To mapData.Length - 1
mapData(i) = binaryReader1.ReadUInt16
If mapData(i) > max Then
max = mapData(i)
ElseIf mapData(i) < minLandLevel Then
minLandLevel = mapData(i)
End If
Next
Catch ex As Exception
Debug.WriteLine(ex.Message)
Me.Text = "No file loaded"
Exit Sub
Finally
binaryReader1.Close()
stream1.Close()
End Try
' I don't know how you are creating the colors.
' The values in the array represent the height of the land
' I'll just convert the height value into a grey.
Dim range As Integer = max - minLandLevel
stepSize = 255 / range
haveFile = True
Me.Text = IO.Path.GetFileNameWithoutExtension(ofd.FileName)
Else
Me.Text = "No file Loaded"
End If

End Sub

Private Function GetGrey(ByVal value As UShort) As Color
' Convert value to a grey
Dim grey As Byte = CByte((value - minLandLevel) * stepSize)
Dim color1 As Color = Color.FromArgb(grey, grey, grey)
Return color1
End Function

'Set Pixel
Private Sub MakeMap()
sw.Reset()
sw.Start()
Dim bm As New Bitmap(128, 128)
For i As Integer = 0 To mapdata.Length - 1
Dim x As Integer = i Mod 128
Dim y As Integer = i \ 128
bm.SetPixel(x, y, GetGrey(mapdata(i)))
Next
sw.Stop()
Me.Text = sw.ElapsedMilliseconds
If pb.Image IsNot Nothing Then pb.Image.Dispose() : pb.Image = Nothing
pb.Image = bm
End Sub

' Lockbits
Private Sub MakeMap2()
sw.Reset()
sw.Start()
Dim bm As New Bitmap(128, 128)
Dim bmd As BitmapData
bmd = bm.LockBits(New Rectangle(0, 0, 128, 128), ImageLockMode.WriteOnly, PixelFormat.Format32bppRgb)
Dim pixels((128 * 128) - 1) As Integer
For i As Integer = 0 To pixels.Length - 1
Dim grey As Integer = CInt((mapdata(i) - minLandLevel) * stepSize)
Dim color As Integer = (grey << 16) Or (grey << 8) Or (grey << 0)
' If color > 0 Then Debugger.Break()
pixels(i) = color
Next
Marshal.Copy(pixels, 0, bmd.Scan0, pixels.Length)
bm.UnlockBits(bmd)
sw.Stop()
Me.Text = sw.ElapsedMilliseconds
If pb.Image IsNot Nothing Then pb.Image.Dispose() : pb.Image = Nothing
pb.Image = bm
End Sub

' make something bigger
Private Sub makeMap3()
sw.Reset()
sw.Start()
Dim bm As New Bitmap(768, 768) ' 6x bigger
Dim g As Graphics = Graphics.FromImage(bm)
For i As Integer = 0 To mapdata.Length - 1
Dim x As Integer = i Mod 128
Dim y As Integer = i \ 128
Dim rec As New Rectangle(x * 6, y * 6, 6, 6)
g.FillRectangle(New SolidBrush(GetGrey(mapdata(i))), rec)
Next
g.Dispose()
sw.Stop()
Me.Text = sw.ElapsedMilliseconds
If pb.Image IsNot Nothing Then pb.Image.Dispose() : pb.Image = Nothing
pb.Image = bm
End Sub

Private Sub b1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles b1.Click
If haveFile Then MakeMap() Else Me.Text = "no file loaded"
End Sub

Private Sub b2_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles b2.Click
If haveFile Then MakeMap2() Else Me.Text = "no file loaded"
End Sub

Private Sub b3_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles b3.Click
If haveFile Then makeMap3() Else Me.Text = "no file loaded"
End Sub
End Class





Re: Visual Basic Express Edition BitMap SetPixel

dmkp231

Here's the code I use to make the colours and load the map.

Public Class Form1

Dim land(0 To 127, 0 To 127) As Short

Dim tile As Short

Dim bMap As New Bitmap(520, 520)

Dim fHnd As Integer = FreeFile()

Dim x As Integer, y As Integer

Dim A As Long = &HFF, CR As Long, CG As Long, CB As Long, col As Long

Public Sub OpenMap(ByVal filename As String, ByVal imgMap As PictureBox)

FileOpen(fHnd, filename, OpenMode.Binary)

FileGet(fHnd, land, 1)

FileClose(fHnd)

For x = 1 To 128

For y = 1 To 128

tile = land(x - 1, y - 1)

If ((System.Math.Sqrt(System.Math.Sqrt(tile)) * 2) ^ 1.8).ToString.Contains(".") Then ' not a square number

col = tile \ 4

Else

col = ((System.Math.Sqrt(System.Math.Sqrt(tile)) * 2) ^ 1.8)

End If

CR = 48 - col

If CR < 0 Then CR = 0

CG = col

If CG < 32 Then CG = 32

If CG > 255 Then CG = 255

CB = 48 - col

If CB < 0 Then CB = 0

If CR = 0 And CG = 0 And CB = 0 Then CR = 1

If tile = 0 Then

bMap.SetPixel(x * 4 + 1, y * 4 + 1, Color.FromArgb(A, 0, 0, Int(Rnd() * 10) + 100))

bMap.SetPixel(x * 4 + 1, y * 4 + 2, Color.FromArgb(A, 0, 0, Int(Rnd() * 10) + 100))

bMap.SetPixel(x * 4 + 1, y * 4 + 3, Color.FromArgb(A, 0, 0, Int(Rnd() * 10) + 100))

bMap.SetPixel(x * 4 + 1, y * 4 + 4, Color.FromArgb(A, 0, 0, Int(Rnd() * 10) + 100))

bMap.SetPixel(x * 4 + 2, y * 4 + 1, Color.FromArgb(A, 0, 0, Int(Rnd() * 10) + 100))

bMap.SetPixel(x * 4 + 2, y * 4 + 2, Color.FromArgb(A, 0, 0, Int(Rnd() * 10) + 100))

bMap.SetPixel(x * 4 + 2, y * 4 + 3, Color.FromArgb(A, 0, 0, Int(Rnd() * 10) + 100))

bMap.SetPixel(x * 4 + 2, y * 4 + 4, Color.FromArgb(A, 0, 0, Int(Rnd() * 10) + 100))

bMap.SetPixel(x * 4 + 3, y * 4 + 1, Color.FromArgb(A, 0, 0, Int(Rnd() * 10) + 100))

bMap.SetPixel(x * 4 + 3, y * 4 + 2, Color.FromArgb(A, 0, 0, Int(Rnd() * 10) + 100))

bMap.SetPixel(x * 4 + 3, y * 4 + 3, Color.FromArgb(A, 0, 0, Int(Rnd() * 10) + 100))

bMap.SetPixel(x * 4 + 3, y * 4 + 4, Color.FromArgb(A, 0, 0, Int(Rnd() * 10) + 100))

bMap.SetPixel(x * 4 + 4, y * 4 + 1, Color.FromArgb(A, 0, 0, Int(Rnd() * 10) + 100))

bMap.SetPixel(x * 4 + 4, y * 4 + 2, Color.FromArgb(A, 0, 0, Int(Rnd() * 10) + 100))

bMap.SetPixel(x * 4 + 4, y * 4 + 3, Color.FromArgb(A, 0, 0, Int(Rnd() * 10) + 100))

bMap.SetPixel(x * 4 + 4, y * 4 + 4, Color.FromArgb(A, 0, 0, Int(Rnd() * 10) + 100))

Else

bMap.SetPixel(x * 4 + 1, y * 4 + 1, Color.FromArgb(A, CR, CG, CB))

bMap.SetPixel(x * 4 + 1, y * 4 + 2, Color.FromArgb(A, CR, CG, CB))

bMap.SetPixel(x * 4 + 1, y * 4 + 3, Color.FromArgb(A, CR, CG, CB))

bMap.SetPixel(x * 4 + 1, y * 4 + 4, Color.FromArgb(A, CR, CG, CB))

bMap.SetPixel(x * 4 + 2, y * 4 + 1, Color.FromArgb(A, CR, CG, CB))

bMap.SetPixel(x * 4 + 2, y * 4 + 2, Color.FromArgb(A, CR, CG, CB))

bMap.SetPixel(x * 4 + 2, y * 4 + 3, Color.FromArgb(A, CR, CG, CB))

bMap.SetPixel(x * 4 + 2, y * 4 + 4, Color.FromArgb(A, CR, CG, CB))

bMap.SetPixel(x * 4 + 3, y * 4 + 1, Color.FromArgb(A, CR, CG, CB))

bMap.SetPixel(x * 4 + 3, y * 4 + 2, Color.FromArgb(A, CR, CG, CB))

bMap.SetPixel(x * 4 + 3, y * 4 + 3, Color.FromArgb(A, CR, CG, CB))

bMap.SetPixel(x * 4 + 3, y * 4 + 4, Color.FromArgb(A, CR, CG, CB))

bMap.SetPixel(x * 4 + 4, y * 4 + 1, Color.FromArgb(A, CR, CG, CB))

bMap.SetPixel(x * 4 + 4, y * 4 + 2, Color.FromArgb(A, CR, CG, CB))

bMap.SetPixel(x * 4 + 4, y * 4 + 3, Color.FromArgb(A, CR, CG, CB))

bMap.SetPixel(x * 4 + 4, y * 4 + 4, Color.FromArgb(A, CR, CG, CB))

End If

Next y

Next x

imgMap.Image = bMap

End Sub





Re: Visual Basic Express Edition BitMap SetPixel

dmkp231

I'm trying to make a map editor now, and when I try to make it increase or decrease the land height it doesn't do anything :/