概要
透過Gifを作成する。
背景が透明なGifを作成します。
32bppのビットマップを作成し、それを8bpp(256色)に変換し、
Gifとして保存します。
事前準備はこちらを参照して下さい。
ソースコード
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(255) As Color
Private p As Pen
Private ColPalette As ColorPalette
Private srBytes() As Byte
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 255
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()
SaveGif()
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 / 4))
Dim rgbvaluesSr(bytesSr) As Byte
System.Runtime.InteropServices.Marshal.Copy(ptrSr, rgbvaluesSr, 0, bytesSr)
For i As Integer = 0 To rgbvaluesSr.Length – 4 Step 4
For j As Integer = 1 To 4
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
srBytes(CInt(i / 4)) = j
Exit For
End If
srBytes(CInt(i / 4)) = 0
Next
Next
System.Runtime.InteropServices.Marshal.Copy(rgbvaluesSr, 0, ptrSr, bytesSr)
sBmp.UnlockBits(bmpSr)
End Sub
Private Sub SaveGif()
Dim dBmp As Bitmap = New Bitmap(sBmp.Width, sBmp.Height, PixelFormat.Format8bppIndexed)
Dim bmpDt As BitmapData = dBmp.LockBits(New Rectangle(0, 0, dBmp.Width, dBmp.Height), ImageLockMode.ReadWrite, PixelFormat.Format8bppIndexed)
Dim ptrDt As IntPtr = bmpDt.Scan0
Dim bytesDt As Integer = bmpDt.Stride * dBmp.Height
System.Runtime.InteropServices.Marshal.Copy(srBytes, 0, ptrDt, bytesDt)
dBmp.UnlockBits(bmpDt)
ColPalette = dBmp.Palette
For j As Integer = 0 To 255
ColPalette.Entries(j) = Col(j)
Next
dBmp.Palette = ColPalette
dBmp.Save(“C:\8bppGif.gif”, ImageFormat.Gif)
dBmp.Dispose()
End Sub
End Class
こんな感じの実行結果になります。
また、今回は4色しか使用していないので、高速化のため、
MakeSaveData()の中で、カラー情報を抜き出す際に、
For文をi = 1 to 4としています。
使用する色数に応じて変えてください。
32bppBitmapを4bppBitmapに変換して保存する際と同様に、
LockBitsにて、32bppのBitmapを8bppのBitmapへ変換しています。
ビットマップは、Byte配列が分かると、
かなり自由にいじることができます。
関連記事
システム開発のためのVB.NETプログラミング関係一覧に戻る