もじゅ２ - karui_omoiの日記

' 画像加工
Module Module02_image_processing

Friend kaneru1() As Integer = {0, 1, 0,
1, -4, 1,
0, 1, 0} 'カーネル係数

Friend kaneru2() As Integer = {1, 1, 1,
1, -8, 1,
1, 1, 1} 'カーネル係数

' ガウスぼかし処理(From GaussianBlur)
Public Function GaussianBlurXY(ByVal src_bmp As Bitmap, ByVal zone As Integer) As Bitmap 'ソース画像　，ぼかし度？

Dim range As Integer = zone * 3

Dim w As Integer = src_bmp.Width

Dim h As Integer = src_bmp.Height

' 短辺の1/5より大きい場合は無視する

If range <= 0 Or range >= Math.Min(w, h) \ 5 Then

Return Nothing

End If

Dim gf(range) As Double

For i As Integer = 0 To range

gf(i) = Math.Exp(-i * i / (2 * zone * zone))

Dim sum, sa, sr, sg, sb, gauss As Double

Dim tmp_bmp As Bitmap = New Bitmap(src_bmp)

Dim dis_bmp As Bitmap = New Bitmap(src_bmp)

Dim rect As Rectangle = New Rectangle(0, 0, w, h)

Dim src_bmpData As Imaging.BitmapData = src_bmp.LockBits(rect, Imaging.ImageLockMode.ReadWrite, Imaging.PixelFormat.Format32bppArgb)

Dim src_ptr As IntPtr = src_bmpData.Scan0

Dim tmp_bmpData As Imaging.BitmapData = tmp_bmp.LockBits(rect, Imaging.ImageLockMode.ReadWrite, Imaging.PixelFormat.Format32bppArgb)

Dim tmp_ptr As IntPtr = tmp_bmpData.Scan0

Dim dis_bmpData As Imaging.BitmapData = dis_bmp.LockBits(rect, Imaging.ImageLockMode.ReadWrite, Imaging.PixelFormat.Format32bppArgb)

Dim dis_ptr As IntPtr = dis_bmpData.Scan0

Dim stride As Integer = dis_bmpData.Stride

Dim rgba_step As Integer = CInt(stride / dis_bmpData.Width) ' RGBの時は3,RGBAの時は4

Dim bytes As Integer = stride * h

Dim dis_argb(bytes - 1) As Byte

Dim tmp_argb(bytes - 1) As Byte

Dim src_argb(bytes - 1) As Byte

System.Runtime.InteropServices.Marshal.Copy(dis_ptr, dis_argb, 0, bytes)

System.Runtime.InteropServices.Marshal.Copy(tmp_ptr, tmp_argb, 0, bytes)

System.Runtime.InteropServices.Marshal.Copy(src_ptr, src_argb, 0, bytes)

' 水平方向に平均化(src_argb->tmp_argb)

For y As Integer = 0 To h - 1

For x As Integer = 0 To w - 1

sum = 0

sa = 0

sr = 0

sg = 0

sb = 0

Dim offset As Integer

For ix As Integer = x - range To x + range

If ix < 0 Or ix >= w Then Continue For

offset = stride * y + ix * rgba_step

gauss = gf(Math.Abs(ix - x))

sa += src_argb(offset + 3) * gauss

sr += src_argb(offset + 2) * gauss * src_argb(offset + 3)

sg += src_argb(offset + 1) * gauss * src_argb(offset + 3)

sb += src_argb(offset + 0) * gauss * src_argb(offset + 3)

sum += gauss

offset = stride * y + x * rgba_step

If sa > 0 Then

tmp_argb(offset + 3) = AdjustByte(sa / sum)

tmp_argb(offset + 2) = AdjustByte(sr / sa)

tmp_argb(offset + 1) = AdjustByte(sg / sa)

tmp_argb(offset + 0) = AdjustByte(sb / sa)

Else

tmp_argb(offset + 3) = 0

tmp_argb(offset + 2) = 0

tmp_argb(offset + 1) = 0

tmp_argb(offset + 0) = 0

End If

' 垂直方向に平均化(tmp_argb->dis_argb)

For y As Integer = 0 To h - 1

For x As Integer = 0 To w - 1

sum = 0

sa = 0

sr = 0

sg = 0

sb = 0

Dim offset As Integer

For iy As Integer = y - range To y + range

If iy < 0 Or iy >= h Then Continue For

offset = stride * iy + x * rgba_step

gauss = gf(Math.Abs(iy - y))

sa += tmp_argb(offset + 3) * gauss

sr += tmp_argb(offset + 2) * gauss * tmp_argb(offset + 3)

sg += tmp_argb(offset + 1) * gauss * tmp_argb(offset + 3)

sb += tmp_argb(offset + 0) * gauss * tmp_argb(offset + 3)

sum += gauss

offset = stride * y + x * rgba_step

If sa > 0 Then

dis_argb(offset + 3) = AdjustByte(sa / sum)

dis_argb(offset + 2) = AdjustByte(sr / sa)

dis_argb(offset + 1) = AdjustByte(sg / sa)

dis_argb(offset + 0) = AdjustByte(sb / sa)

Else

dis_argb(offset + 3) = 0

dis_argb(offset + 2) = 0

dis_argb(offset + 1) = 0

dis_argb(offset + 0) = 0

End If

' 処理結果を配列からコピー

System.Runtime.InteropServices.Marshal.Copy(dis_argb, 0, dis_ptr, bytes)

System.Runtime.InteropServices.Marshal.Copy(tmp_argb, 0, tmp_ptr, bytes)

System.Runtime.InteropServices.Marshal.Copy(src_argb, 0, src_ptr, bytes)

dis_bmp.UnlockBits(dis_bmpData)

tmp_bmp.UnlockBits(tmp_bmpData)

src_bmp.UnlockBits(src_bmpData)

tmp_bmp.Dispose()

tmp_bmp = Nothing

' src_bmpは呼び出し元で準備したものなので、操作しない

Return dis_bmp

End Function

' カラーコードを8ビット値に入るように調整する

Public Function AdjustByte(ByVal value As Integer) As Byte

If value < 0 Then

Return 0

ElseIf value > 255 Then

Return 255

End If

Return value

End Function

Public Function AdjustByte(ByVal value As Double) As Byte

If value < 0 Then

Return 0

ElseIf value > 255 Then

Return 255

End If

Return value

End Function

'グレーを算出
Public Function Gray_Calculation(r As Integer, g As Integer, b As Integer) '赤緑青

Dim re_color As Integer = r * 0.3 + g * 0.59 + b * 0.11
If re_color > 255 Then
re_color = 255
End If

Return re_color

End Function

'グレー画像を返す
Public Function RGB_to_Gray(n_bmp As Bitmap) '画像

Dim Re_bmp As Bitmap = n_bmp.Clone

' Bitmap処理の高速化開始
Dim bmpP As Module01_BitmapPlus = New Module01_BitmapPlus(Re_bmp)
bmpP.BeginAccess()
For i As Integer = 0 To Re_bmp.Width - 1
For j As Integer = 0 To Re_bmp.Height - 1

'グレーを算出
Dim n_Gray As Integer = Gray_Calculation(bmpP.GetPixel(i, j).R, bmpP.GetPixel(i, j).G, bmpP.GetPixel(i, j).B) '赤緑青

bmpP.SetPixel(i, j, Color.FromArgb(255, n_Gray, n_Gray, n_Gray)) 'アルファ（透明度）、赤、緑、青

Next
Next
' Bitmap処理の高速化終了
bmpP.EndAccess()

Return Re_bmp

End Function

'白黒
Public Function siro_kuro(n_bmp As Bitmap, border As Integer) '画像，白黒のしきい値

Dim Re_bmp As Bitmap = n_bmp.Clone

'グレーの色を返す
Dim n_Gray As Integer = Gray_Calculation(bmpP.GetPixel(i, j).R, bmpP.GetPixel(i, j).G, bmpP.GetPixel(i, j).B) '赤緑青

'白黒
If n_Gray >= border Then 'しきい値
n_Gray = 255
Else
n_Gray = 0
End If

bmpP.SetPixel(i, j, Color.FromArgb(255, n_Gray, n_Gray, n_Gray)) 'アルファ（透明度）、赤、緑、青

Next
Next
' Bitmap処理の高速化終了
bmpP.EndAccess()

Return Re_bmp

End Function

'エッジ算出
Public Function rinkak_Calculation(n_arr(,) As Integer, a1() As Integer) '画像の2次元　値はグレースケール,倍率1-9 カーネル係数

Dim len0 As Integer = n_arr.GetLength(0) ' 0次元目の要素数を取得
Dim len1 As Integer = n_arr.GetLength(1) ' 1次元目の要素数を取得
Dim re_arr(len0, len1) As Integer

For i As Integer = 0 To len0 - 1 '横
For j As Integer = 0 To len1 - 1 '縦
If i = 0 Or i = len0 - 1 Or j = 0 Or j = len1 - 1 Then ' 端
re_arr(i, j) = 0 '輪郭なしとします
Else
re_arr(i, j) += n_arr(i - 1, j - 1) * a1(0) '左上
re_arr(i, j) += n_arr(i, j - 1) * a1(1) '上
re_arr(i, j) += n_arr(i + 1, j - 1) * a1(2) '右上
'
re_arr(i, j) += n_arr(i - 1, j) * a1(3) '左
re_arr(i, j) += n_arr(i, j) * a1(4) '真ん中
re_arr(i, j) += n_arr(i + 1, j) * a1(5) '右
'
re_arr(i, j) += n_arr(i - 1, j + 1) * a1(6) '左下
re_arr(i, j) += n_arr(i, j + 1) * a1(7) '下
re_arr(i, j) += n_arr(i + 1, j + 1) * a1(8) '右下
End If
If re_arr(i, j) > 255 Then
re_arr(i, j) = 255
ElseIf re_arr(i, j) < 0 Then
re_arr(i, j) = 0
End If

Next
Next

Return re_arr

End Function

'エッジ画像を返す
Public Function rinkak_ga(n_bmp As Bitmap, Black_white As Integer, kaneru() As Integer) '画像 , 白黒しきい値 ,倍率1-9 カーネル係数

Dim Re_bmp As Bitmap = n_bmp.Clone

' Bitmap処理の高速化開始
Dim bmpP1 As Module01_BitmapPlus = New Module01_BitmapPlus(Re_bmp)

bmpP1.BeginAccess()

Dim len0 As Integer = Re_bmp.Width - 1 ' 0次元目の要素数を取得
Dim len1 As Integer = Re_bmp.Height - 1 ' 1次元目の要素数を取得
Dim n_arr1(len0, len1) As Integer
Dim n_arr2(len0, len1) As Integer

For i As Integer = 0 To len0 - 1
For j As Integer = 0 To len1 - 1
'グレーの色を返す
Dim n_Gray As Integer = Gray_Calculation(bmpP1.GetPixel(i, j).R, bmpP1.GetPixel(i, j).G, bmpP1.GetPixel(i, j).B) '赤緑青

'白黒
If n_Gray >= Black_white Then 'しきい値
n_Gray = 255
Else
n_Gray = 0
End If
n_arr1(i, j) = n_Gray
Next
Next

n_arr2 = rinkak_Calculation(n_arr1, kaneru) '画像の2次元　値はグレースケール,倍率1-9

For i As Integer = 0 To len0 - 1
For j As Integer = 0 To len1 - 1

bmpP1.SetPixel(i, j, Color.FromArgb(255, n_arr2(i, j), n_arr2(i, j), n_arr2(i, j))) 'アルファ（透明度）、赤、緑、青

Next
Next

' Bitmap処理の高速化終了
bmpP1.EndAccess()

Return Re_bmp

End Function

End Module