Saving a Bitmap

  • Thread starter Thread starter Lump Kin
  • Start date Start date
L

Lump Kin

I snagged the code following this message from the newsgroups - Thanks
to all who contributed to it!

My question is - How can I modify this code to save the bmp file as
256 color instead of true color? I have tinkered but am not
proficient enough to figure out what I need to modify. I know that I
cannot simply change the header info since the bmp format is being
created directly from the code.

I am assuming that I need to do something different with the RGB
(pixels(p) = c.G etc.) assignments but I'm basically clueless as to
how to go about this. It wouldn't an issue except that the way that
it stands, my bmp file is too large to save as a blob. Since I'm
using about 6 basic colors, 256 colors should be sufficient and make
the file smaller.

Any advice would be appreciated.

Thx!!!


Here's the code -


Imports System.IO

Imports System.Runtime.InteropServices

Module BMP

Public Function SaveBMP(ByVal theBMP As Bitmap, ByVal filename As
String) As
Boolean

'Given a bitmap, which could be from a PictureBox (picturebox.image),
saves
the images to

'filename (of .bmp file format)

Dim c As Color

Dim pad As Boolean = theBMP.Width Mod 2 = 1, p As Long = 0

Dim padding As Short = 0

If pad Then padding = 1

Dim pixels(theBMP.Height * (theBMP.Width + padding) * 3) As Byte

Dim x As Long, y As Long

For y = theBMP.Height - 1 To 0 Step -1

For x = 0 To theBMP.Width - 1

c = theBMP.GetPixel(x, y)

pixels(p) = c.B

p += 1

pixels(p) = c.G

p += 1

pixels(p) = c.R

p += 1

Next

If pad Then

p += 3

End If

Next

Dim outBmp As Byte()

outBmp = CreateBitmap(theBMP.Width, theBMP.Height, pixels)

Dim fs As New FileStream(filename, FileMode.OpenOrCreate)

' Create the writer for data.

Dim w As New BinaryWriter(fs)

w.Write(outBmp)

w.Close()

fs.Close()

SaveBMP = True

End Function

Dim sizeBFH As Integer = 14 'sizeof(BITMAPFILEHEADER)

Private Function CreateBitmap(ByVal width As Integer, ByVal height As
Integer, ByVal bitmapData As Byte()) As Byte()

' Calculate bitmap size - 3 bytes per pixel

' Bitmap scanlines must be aligned at 16 bit boundary.

Dim padding As Short = 0

If (width Mod 2) = 1 Then

'Throw New ArgumentException("Width must be an even number")

padding = 1

End If

Dim WidthHelper As Long = (width * 3) + (width Mod 4)

Dim nSize As Integer = sizeBFH + Marshal.SizeOf(New BITMAPINFOHEADER)
+
(width + padding) * height * 3

Dim data() As Byte = New Byte(nSize) {}

Dim bfh() As Byte = New Byte(sizeBFH) {}

BitConverter.GetBytes(CInt(&H4D42)).CopyTo(data, 0)

BitConverter.GetBytes(nSize).CopyTo(data, 2)

Dim bfhOffBits As Integer = CType((sizeBFH + Marshal.SizeOf(New
BITMAPINFOHEADER)), Integer)

BitConverter.GetBytes(bfhOffBits).CopyTo(data, 10)

Dim bi As BITMAPINFOHEADER = New BITMAPINFOHEADER

bi.biSize = System.Convert.ToUInt32(Marshal.SizeOf(bi))

bi.biBitCount = Convert.ToUInt16(24) ' Creating RGB bitmap. The
following
three members don't matter

bi.biClrUsed = Convert.ToUInt32(0)

bi.biClrImportant = Convert.ToUInt32(0)

bi.biCompression = Convert.ToUInt32(0)

bi.biHeight = height

bi.biWidth = width

bi.biPlanes = Convert.ToUInt16(1)

Dim cb As Integer = (CLng(bi.biHeight) * CLng(bi.biWidth + padding) *
System.Convert.ToInt32(bi.biBitCount) / 8) '8 is bits per byte

bi.biSizeImage = System.Convert.ToUInt32(cb)

bi.biXPelsPerMeter = &HB12 ' 72 ppi, 96 would work well too

bi.biYPelsPerMeter = &HB12 ' 72 ppi

Dim hdr() As Byte = GetBytes(bi)

Buffer.BlockCopy(hdr, 0, data, sizeBFH, hdr.Length)

Buffer.BlockCopy(bitmapData, 0, data, bfhOffBits,
System.Math.Min(bitmapData.Length, cb))

Return data

End Function

' This works only for default-aligned structure.

' It does not work for BITMAPFILEHEADER because bfSize is not aligned
to
DWORD boundary

' Unfortunately CF does not allow specifying structure member
alignment

Private Function GetBytes(ByVal o As Object) As Byte()

Dim size As Integer = Marshal.SizeOf(o.GetType())

Dim p As IntPtr = LocalAlloc(GPTR, size)

Marshal.StructureToPtr(o, p, False)

Dim ret() As Byte = New Byte(size) {}

Marshal.Copy(p, ret, 0, size)

LocalFree(p)

Return ret

End Function

Structure BITMAPINFOHEADER

Public biSize As System.UInt32

Public biWidth As Integer

Public biHeight As Integer

Public biPlanes As System.UInt16

Public biBitCount As System.UInt16

Public biCompression As System.UInt32

Public biSizeImage As System.UInt32

Public biXPelsPerMeter As Integer

Public biYPelsPerMeter As Integer

Public biClrUsed As System.UInt32

Public biClrImportant As System.UInt32

End Structure

Structure BITMAPFILEHEADER

Public bfType As System.UInt16

Public bfSize As System.UInt32

Public bfReserved1 As System.UInt16

Public bfReserved2 As System.UInt16

Public bfOffBits As System.UInt32

End Structure

Const GPTR As Integer = &H40

<DllImport("KERNEL32.dll", SetLastError:=True)> _

Private Function LocalAlloc(ByVal uFlags As Integer, _

ByVal uBytes As Integer) As IntPtr

End Function

<DllImport("KERNEL32.dll", SetLastError:=True)> _

Private Function LocalFree(ByVal hMem As IntPtr) As IntPtr

End Function

End Module
 
Any hints on where to look with this one?

Lump Kin said:
I snagged the code following this message from the newsgroups - Thanks
to all who contributed to it!

My question is - How can I modify this code to save the bmp file as
256 color instead of true color? I have tinkered but am not
proficient enough to figure out what I need to modify. I know that I
cannot simply change the header info since the bmp format is being
created directly from the code.

I am assuming that I need to do something different with the RGB
(pixels(p) = c.G etc.) assignments but I'm basically clueless as to
how to go about this. It wouldn't an issue except that the way that
it stands, my bmp file is too large to save as a blob. Since I'm
using about 6 basic colors, 256 colors should be sufficient and make
the file smaller.

Any advice would be appreciated.

Thx!!!


Here's the code -


Imports System.IO

Imports System.Runtime.InteropServices

Module BMP

Public Function SaveBMP(ByVal theBMP As Bitmap, ByVal filename As
String) As
Boolean

'Given a bitmap, which could be from a PictureBox (picturebox.image),
saves
the images to

'filename (of .bmp file format)

Dim c As Color

Dim pad As Boolean = theBMP.Width Mod 2 = 1, p As Long = 0

Dim padding As Short = 0

If pad Then padding = 1

Dim pixels(theBMP.Height * (theBMP.Width + padding) * 3) As Byte

Dim x As Long, y As Long

For y = theBMP.Height - 1 To 0 Step -1

For x = 0 To theBMP.Width - 1

c = theBMP.GetPixel(x, y)

pixels(p) = c.B

p += 1

pixels(p) = c.G

p += 1

pixels(p) = c.R

p += 1

Next

If pad Then

p += 3

End If

Next

Dim outBmp As Byte()

outBmp = CreateBitmap(theBMP.Width, theBMP.Height, pixels)

Dim fs As New FileStream(filename, FileMode.OpenOrCreate)

' Create the writer for data.

Dim w As New BinaryWriter(fs)

w.Write(outBmp)

w.Close()

fs.Close()

SaveBMP = True

End Function

Dim sizeBFH As Integer = 14 'sizeof(BITMAPFILEHEADER)

Private Function CreateBitmap(ByVal width As Integer, ByVal height As
Integer, ByVal bitmapData As Byte()) As Byte()

' Calculate bitmap size - 3 bytes per pixel

' Bitmap scanlines must be aligned at 16 bit boundary.

Dim padding As Short = 0

If (width Mod 2) = 1 Then

'Throw New ArgumentException("Width must be an even number")

padding = 1

End If

Dim WidthHelper As Long = (width * 3) + (width Mod 4)

Dim nSize As Integer = sizeBFH + Marshal.SizeOf(New BITMAPINFOHEADER)
+
(width + padding) * height * 3

Dim data() As Byte = New Byte(nSize) {}

Dim bfh() As Byte = New Byte(sizeBFH) {}

BitConverter.GetBytes(CInt(&H4D42)).CopyTo(data, 0)

BitConverter.GetBytes(nSize).CopyTo(data, 2)

Dim bfhOffBits As Integer = CType((sizeBFH + Marshal.SizeOf(New
BITMAPINFOHEADER)), Integer)

BitConverter.GetBytes(bfhOffBits).CopyTo(data, 10)

Dim bi As BITMAPINFOHEADER = New BITMAPINFOHEADER

bi.biSize = System.Convert.ToUInt32(Marshal.SizeOf(bi))

bi.biBitCount = Convert.ToUInt16(24) ' Creating RGB bitmap. The
following
three members don't matter

bi.biClrUsed = Convert.ToUInt32(0)

bi.biClrImportant = Convert.ToUInt32(0)

bi.biCompression = Convert.ToUInt32(0)

bi.biHeight = height

bi.biWidth = width

bi.biPlanes = Convert.ToUInt16(1)

Dim cb As Integer = (CLng(bi.biHeight) * CLng(bi.biWidth + padding) *
System.Convert.ToInt32(bi.biBitCount) / 8) '8 is bits per byte

bi.biSizeImage = System.Convert.ToUInt32(cb)

bi.biXPelsPerMeter = &HB12 ' 72 ppi, 96 would work well too

bi.biYPelsPerMeter = &HB12 ' 72 ppi

Dim hdr() As Byte = GetBytes(bi)

Buffer.BlockCopy(hdr, 0, data, sizeBFH, hdr.Length)

Buffer.BlockCopy(bitmapData, 0, data, bfhOffBits,
System.Math.Min(bitmapData.Length, cb))

Return data

End Function

' This works only for default-aligned structure.

' It does not work for BITMAPFILEHEADER because bfSize is not aligned
to
DWORD boundary

' Unfortunately CF does not allow specifying structure member
alignment

Private Function GetBytes(ByVal o As Object) As Byte()

Dim size As Integer = Marshal.SizeOf(o.GetType())

Dim p As IntPtr = LocalAlloc(GPTR, size)

Marshal.StructureToPtr(o, p, False)

Dim ret() As Byte = New Byte(size) {}

Marshal.Copy(p, ret, 0, size)

LocalFree(p)

Return ret

End Function

Structure BITMAPINFOHEADER

Public biSize As System.UInt32

Public biWidth As Integer

Public biHeight As Integer

Public biPlanes As System.UInt16

Public biBitCount As System.UInt16

Public biCompression As System.UInt32

Public biSizeImage As System.UInt32

Public biXPelsPerMeter As Integer

Public biYPelsPerMeter As Integer

Public biClrUsed As System.UInt32

Public biClrImportant As System.UInt32

End Structure

Structure BITMAPFILEHEADER

Public bfType As System.UInt16

Public bfSize As System.UInt32

Public bfReserved1 As System.UInt16

Public bfReserved2 As System.UInt16

Public bfOffBits As System.UInt32

End Structure

Const GPTR As Integer = &H40

<DllImport("KERNEL32.dll", SetLastError:=True)> _

Private Function LocalAlloc(ByVal uFlags As Integer, _

ByVal uBytes As Integer) As IntPtr

End Function

<DllImport("KERNEL32.dll", SetLastError:=True)> _

Private Function LocalFree(ByVal hMem As IntPtr) As IntPtr

End Function

End Module
Click to expand...
 
Back
Top