32bppBitmapに描画し、4bppBitmap(16色)に保存する。
事前準備
・フォームにMenuStripを貼り付ける。
・その中に、色-(赤、青、緑、黒)と保存を加える
・その下に、296 x 238のPictureBoxを貼り付ける
【ソースコード】
Imports System.Drawing.Imaging
Public Class Form1
Private sBmp As Bitmap
Private StX As Single, StY As Single
Private EnX As Single, EnY As Single
Private mDown As Boolean = False
Private Col(15) As Color
Private p As Pen
Private ColPalette As ColorPalette
Private srBytes() As Byte
Public Structure BITMAPFILEHEADER
Dim bfType As Short
Dim bfSize As Integer
Dim bfReserved1 As Short
Dim bfReserved2 As Short
Dim bfOffBits As Integer
End Structure
Public Structure BITMAPINFO
Dim bmiHeader As BITMAPINFOHEADER
Dim bmiColors() As RGBQUAD
End Structure
Public Structure BITMAPINFOHEADER
Dim biSize As Integer
Dim biWidth As Integer
Dim biHeight As Integer
Dim biPlanes As Short
Dim biBitCount As Short
Dim biCompression As Integer
Dim biSizeImage As Integer
Dim biXPelsPerMeter As Integer
Dim biYPelsPerMeter As Integer
Dim biClrUsed As Integer
Dim biClrImportant As Integer
End Structure
Public Structure RGBQUAD
Dim rgbBlue As Byte
Dim rgbGreen As Byte
Dim rgbRed As Byte
Dim rgbReserved As Byte
End Structure
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
SetDefaultColor()
sBmp = New Bitmap(PictureBox1.Width, PictureBox1.Height, PixelFormat.Format32bppArgb)
End Sub
Private Sub SetDefaultColor()
p = New Pen(Color.Red)
Col(0) = Color.Transparent
Col(1) = Color.Red
Col(2) = Color.Blue
Col(3) = Color.Green
Col(4) = Color.Black
For i As Integer = 5 To 15
Col(i) = Color.Transparent
Next
End Sub
Private Sub PictureBox_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles PictureBox1.MouseDown
mDown = True
StX = e.X : StY = e.Y
EnX = e.X : EnY = e.Y
End Sub
Private Sub PictureBox_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles PictureBox1.MouseMove
If mDown = False Then Exit Sub
EnX = e.X : EnY = e.Y
Dim g As Graphics = Graphics.FromHwnd(PictureBox1.Handle)
g.DrawLine(p, StX, StY, EnX, EnY)
g.Dispose()
g = Graphics.FromImage(sBmp)
g.DrawLine(p, StX, StY, EnX, EnY)
StX = e.X : StY = e.Y
g.Dispose()
End Sub
Private Sub PictureBox_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) Handles PictureBox1.MouseUp
mDown = False
PictureBox1.Invalidate()
End Sub
Private Sub Picture_Box(ByVal sender As Object, ByVal e As PaintEventArgs) Handles PictureBox1.Paint
If sBmp Is Nothing Then Exit Sub
e.Graphics.DrawImage(sBmp, 0, 0, PictureBox1.Width, PictureBox1.Height)
End Sub
Private Sub 赤ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 赤ToolStripMenuItem.Click
p.Color = Color.Red
End Sub
Private Sub 青ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 青ToolStripMenuItem.Click
p.Color = Color.Blue
End Sub
Private Sub 緑ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 緑ToolStripMenuItem.Click
p.Color = Color.Green
End Sub
Private Sub 黒ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 黒 ToolStripMenuItem.Click
p.Color = Color.Black
End Sub
Private Sub 保存SToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 保存SToolStripMenuItem.Click
MakeSaveData()
Save4bppBitmap()
End Sub
Private Sub MakeSaveData()
Dim bmpSr As BitmapData = sBmp.LockBits(New Rectangle(0, 0, sBmp.Width, sBmp.Height), ImageLockMode.ReadWrite, sBmp.PixelFormat)
Dim ptrSr As IntPtr = bmpSr.Scan0
Dim bytesSr As Integer = bmpSr.Stride * sBmp.Height
ReDim srBytes(CInt(bytesSr / 8))
Dim rgbvaluesSr(bytesSr) As Byte
System.Runtime.InteropServices.Marshal.Copy(ptrSr, rgbvaluesSr, 0, bytesSr)
Dim iByte As Byte
Dim jByte As Byte
For i As Integer = 0 To rgbvaluesSr.Length – 8 Step 8
For j As Integer = 0 To 15
If Col(j).B = rgbvaluesSr(i + 0) AndAlso Col(j).G = rgbvaluesSr(i + 1) AndAlso _
Col(j).R = rgbvaluesSr(i + 2) AndAlso Col(j).A = rgbvaluesSr(i + 3) Then
iByte = j
Exit For
End If
iByte = 0
Next
For j As Integer = 0 To 15
If Col(j).B = rgbvaluesSr(i + 4) AndAlso Col(j).G = rgbvaluesSr(i + 5) AndAlso _
Col(j).R = rgbvaluesSr(i + 6) AndAlso Col(j).A = rgbvaluesSr(i + 7) Then
jByte = j
Exit For
End If
jByte = 0
Next
srBytes(CInt(i / 8)) = iByte * 16 + jByte
Next
System.Runtime.InteropServices.Marshal.Copy(rgbvaluesSr, 0, ptrSr, bytesSr)
sBmp.UnlockBits(bmpSr)
End Sub
Private Sub Save4bppBitmap()
Dim fHeader As BITMAPFILEHEADER
fHeader.bfType = &H4D42
fHeader.bfSize = 14 + 40 + 16 * 4 + UBound(srBytes) + 1
fHeader.bfReserved1 = 0
fHeader.bfReserved2 = 0
fHeader.bfOffBits = 14 + 40 + 16 * 4
Dim bInfo As BITMAPINFO
With bInfo.bmiHeader
.biSize = 40
.biWidth = CInt(UBound(srBytes) / sBmp.Height) * 2
.biHeight = -sBmp.Height
.biPlanes = 1
.biBitCount = 4
.biCompression = 0
.biSizeImage = UBound(srBytes) + 1
.biXPelsPerMeter = 0
.biYPelsPerMeter = 0
.biClrUsed = 16
.biClrImportant = 0
End With
ReDim bInfo.bmiColors(15)
For i As Integer = 0 To 15
With bInfo.bmiColors(i)
.rgbBlue = Col(i).B
.rgbGreen = Col(i).G
.rgbRed = Col(i).R
.rgbReserved = 0
End With
Next
Dim bPath As String = “C:\4bppBitmapsample.bmp”
Dim bw As New System.IO.FileStream(bPath, IO.FileMode.Create, IO.FileAccess.Write)
Dim w As New System.IO.BinaryWriter(bw)
Try
w.Write(fHeader.bfType)
w.Write(fHeader.bfSize)
w.Write(fHeader.bfReserved1)
w.Write(fHeader.bfReserved2)
w.Write(fHeader.bfOffBits)
w.Write(bInfo.bmiHeader.biSize)
w.Write(bInfo.bmiHeader.biWidth)
w.Write(bInfo.bmiHeader.biHeight)
w.Write(bInfo.bmiHeader.biPlanes)
w.Write(bInfo.bmiHeader.biBitCount)
w.Write(bInfo.bmiHeader.biCompression)
w.Write(bInfo.bmiHeader.biSizeImage)
w.Write(bInfo.bmiHeader.biXPelsPerMeter)
w.Write(bInfo.bmiHeader.biYPelsPerMeter)
w.Write(bInfo.bmiHeader.biClrUsed)
w.Write(bInfo.bmiHeader.biClrImportant)
For i As Integer = 0 To 15
w.Write(bInfo.bmiColors(i).rgbBlue)
w.Write(bInfo.bmiColors(i).rgbGreen)
w.Write(bInfo.bmiColors(i).rgbRed)
w.Write(bInfo.bmiColors(i).rgbReserved)
Next
For i As Integer = 0 To UBound(srBytes)
w.Write(srBytes(i))
Next
Catch ex As Exception
Finally
w.Close()
bw.Close()
End Try
End Sub
End Class
32bppBitmapから4bppBitmapへの変換には、32bppのカラー情報を、
4bppのカラーパレットへ割り当てることが必要になります。
しかも、4Byteのカラー情報(ARGBそれぞれ1Byteずつ)を4bitにし、
2Pixel分を1Byteとするので、そのための変換も必要になってきます。
その後は、bmp.Saveメソッドを使用してもいいですが、
今回は、あえて手動で保存してみました。
各種ヘッダー情報と、ファイルに書き込む順番が分かれば、
問題ないと思います。
関連記事
システム開発のためのVB.NETプログラミング関係一覧に戻る