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
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