事前準備
・フォームにPictureBoxを貼り付け、DockプロパティをFillにする。
Imports System.Runtime.InteropServices
Public Class Form1
Private Const DIB_RGB_COLORS As Integer = 0
Private Const SRCCOPY As Integer = 13369376
Public Structure BITMAPINFO
Dim bmiHeader As BITMAPINFOHEADER
Dim bmiColors() As RGBQUAD
End Structure
Public Structure RGBQUAD
Dim rgbBlue As Byte
Dim rgbGreen As Byte
Dim rgbRed As Byte
Dim rgbReserved As Byte
End Structure
Public Structure BITMAPINFOHEADER
Dim biSize As Int32
Dim biWidth As Int32
Dim biHeight As Int32
Dim biPlanes As Int16
Dim biBitCount As Int16
Dim biCompression As Int32
Dim biSizeImage As Int32
Dim biXPelsPerMeter As Int32
Dim biYPelsPerMeter As Int32
Dim biClrUsed As Int32
Dim biClrImportant As Int32
End Structure
Declare Function StretchDIBits Lib “gdi32.dll” _
(ByVal hdc As Integer, ByVal XDest As Integer, ByVal YDest As Integer, _
ByVal nDestWidth As Integer, ByVal nDestHeight As Integer, ByVal XSrc As Integer, _
ByVal YSrc As Integer, ByVal nSrcWidth As Integer, ByVal nSrcHeight As Integer, _
ByVal lpBits As Byte(), ByRef lpBitsInfo As BITMAPINFOHEADER, ByVal iUsage As Integer, _
ByVal dwRop As Integer) As Integer
Declare Function SetStretchBltMode Lib “gdi32” (ByVal hdc As IntPtr, ByVal iStretchMode As Integer) As Integer
Private BmpInfo As BITMAPINFO
Private Dib As Byte()
Private ind As Integer = 1
Private Sub Form_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
MakeDIB(PictureBox1.Width, PictureBox1.Height)
End Sub
Private Sub MakeDIB(ByVal Width As Integer, ByVal Height As Integer)
If PictureBox1.Width Mod 4 <> 0 Then Exit Sub
ReDim BmpInfo.bmiColors(255)
With BmpInfo.bmiHeader
.biSize = System.Runtime.InteropServices.Marshal.SizeOf(BmpInfo)
.biWidth = Width
.biHeight = -Height
.biBitCount = 24
.biPlanes = 1
.biCompression = 0
.biSizeImage = PictureBox1.Width * PictureBox1.Height * 3
End With
For i As Integer = 0 To 255
BmpInfo.bmiColors(i).rgbBlue = i
BmpInfo.bmiColors(i).rgbGreen = i
BmpInfo.bmiColors(i).rgbRed = i
BmpInfo.bmiColors(i).rgbReserved = 0
Next
ReDim Dib(Width * Height * 3 – 1)
For i As Integer = 0 To UBound(Dib)
Dib(i) = 0
Next
End Sub
Private Sub Pict_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles PictureBox1.MouseMove
If PictureBox1.Width Mod 4 <> 0 Then Exit Sub
Dib((PictureBox1.Width * e.Y + e.X) * 3 + ind) = 255
Dim gp As Graphics = PictureBox1.CreateGraphics
Dim hDC As IntPtr = gp.GetHdc()
Draw()
gp.Dispose()
End Sub
Private Sub Draw()
Dim gp As Graphics = PictureBox1.CreateGraphics
Dim hDC As IntPtr = gp.GetHdc()
StretchDIBits(hDC, 0, 0, PictureBox1.Width, PictureBox1.Height, 0, 0, PictureBox1.Width, PictureBox1.Height, Dib, BmpInfo.bmiHeader, DIB_RGB_COLORS, SRCCOPY)
Marshal.Release(hDC)
gp.Dispose()
End Sub
End Class
マウスが動いたところに、緑色の線ができてくると思います。
8bpp以下のインデックス形式の時は、多少、手間がかかる処理が必要になります。
関連記事
・API関連
・BITMAPINFOHEADER
・RGBQUAD
システム開発のためのVB.NETプログラミング関係一覧に戻る
