32bppビットマップに描画し、4bpp(16色)ビットマップに保存する


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メソッドを使用してもいいですが、
今回は、あえて手動で保存してみました。
各種ヘッダー情報と、ファイルに書き込む順番が分かれば、
問題ないと思います。


関連記事



・Bitmapに自由線を描画し表示する(ver2)



システム開発のためのVB.NETプログラミング関係一覧に戻る


Google検索の結果


system-development