ピクセルあたり 1 ビット
これにより、.Net のみから最小の PNG が生成されます。白黒であることに注意してください - グレースケールでさえありません。ドキュメントに便利です。
消費者コード:
Dim src = (the original bitmap)
Using img = New Bitmap(src.Width, src.Height, PixelFormat.Format16bppRgb555) ' Provided Make1bpp function requires this
img.SetResolution(src.HorizontalResolution, src.VerticalResolution)
Using g = Graphics.FromImage(img)
g.Clear(Color.White) ' remove transparancy
g.DrawImage(src, 0, 0, src.Width, src.Height)
End Using
Using img2 As Bitmap = Make1bpp(img)
img2.SetResolution(src.HorizontalResolution, src.VerticalResolution)
Dim myencoder = (From parm In ImageCodecInfo.GetImageEncoders() Where parm.MimeType = "image/png").First()
Dim encoderParams = New EncoderParameters(1)
encoderParams.Param(0) = New EncoderParameter(Encoder.ColorDepth, 8L)
If IO.File.Exists(pngName) Then
IO.File.Delete(pngName)
End If
img2.Save(pngName, myencoder, encoderParams)
End Using
End Using
Make1bpp
これは、PNGエンコーダーが気にすることです
Function Make1bpp(ByVal bmpIN As Bitmap) As Bitmap
Dim bmpOUT As Bitmap
bmpOUT = NewBitmap(bmpIN.Width, bmpIN.Height, PixelFormat.Format1bppIndexed)
bmpOUT.SetResolution(bmpIN.HorizontalResolution, bmpIN.VerticalResolution)
' seems like I've got this crap in this program about 100x.
If bmpIN.PixelFormat <> PixelFormat.Format16bppRgb555 Then
Throw New ApplicationException("hand-coded routine can only understand image format of Format16bppRgb555 but this image is " & _
bmpIN.PixelFormat.ToString & ". Either change the format or code this sub to handle that format, too.")
End If
' lock image bytes
Dim bmdIN As BitmapData = bmpIN.LockBits(New Rectangle(0, 0, bmpIN.Width, bmpIN.Height), _
Imaging.ImageLockMode.ReadWrite, bmpIN.PixelFormat)
' lock image bytes
Dim bmdOUT As BitmapData = bmpOUT.LockBits(New Rectangle(0, 0, bmpOUT.Width, bmpOUT.Height), _
Imaging.ImageLockMode.ReadWrite, bmpOUT.PixelFormat)
' Allocate room for the data.
Dim bytesIN(bmdIN.Stride * bmdIN.Height) As Byte
Dim bytesOUT(bmdOUT.Stride * bmdOUT.Height) As Byte
' Copy the data into the PixBytes array.
Marshal.Copy(bmdIN.Scan0, bytesIN, 0, CInt(bmdIN.Stride * bmpIN.Height))
' > this val = white pix. (each of the 3 pix in the rgb555 can hold 32 levels... 2^5 huh.)
Dim bThresh As Byte = CByte((32 * 3) * 0.66)
' transfer the pixels
For y As Integer = 0 To bmpIN.Height - 1
Dim outpos As Integer = y * bmdOUT.Stride
Dim instart As Integer = y * bmdIN.Stride
Dim byteval As Byte = 0
Dim bitpos As Byte = 128
Dim pixval As Integer
Dim pixgraylevel As Integer
For inpos As Integer = instart To instart + bmdIN.Stride - 1 Step 2
pixval = 256 * bytesIN(inpos + 1) + bytesIN(inpos) ' DEPENDANT ON Format16bppRgb555
pixgraylevel = ((pixval) And 31) + ((pixval >> 5) And 31) + ((pixval >> 10) And 31)
If pixgraylevel > bThresh Then ' DEPENDANT ON Format16bppRgb555
byteval = byteval Or bitpos
End If
bitpos = bitpos >> 1
If bitpos = 0 Then
bytesOUT(outpos) = byteval
byteval = 0
bitpos = 128
outpos += 1
End If
Next
If bitpos <> 0 Then ' stick a fork in any unfinished busines.
bytesOUT(outpos) = byteval
End If
Next
' unlock image bytes
' Copy the data back into the bitmap.
Marshal.Copy(bytesOUT, 0, _
bmdOUT.Scan0, bmdOUT.Stride * bmdOUT.Height)
' Unlock the bitmap.
bmpIN.UnlockBits(bmdIN)
bmpOUT.UnlockBits(bmdOUT)
' futile attempt to free memory.
ReDim bytesIN(0)
ReDim bytesOUT(0)
' return new bmp.
Return bmpOUT
End Function