VB 画像をシャープにする

画像をシャープにする


処理前	処理後

以下の関数Sharpenを使用すると、画像をシャープにすることができる。使用例はすぐ下にある。

'''■Sharpen
''' <summary>画像をシャープにします。</summary>
''' <param name="SourceImage">元の画像を指定します。</param>
''' <param name="Value">効果の深さを設定しますが、必ずしもシャープになるわけではありません。</param>
''' <returns>シャープ化された画像を返します。</returns>
''' <remarks></remarks>
Private Function Sharpen(ByVal SourceImage As Image, Optional ByVal Value As Integer = 1) As Bitmap

Dim Kernel(,) As Integer

Value = 3 + 2 * (Value - 1) '3, 5, 7 .... となる等差数列

'Value ×Value の正方行列を作成
Kernel = CType(Array.CreateInstance(GetType(Integer), Value, Value), Integer(,))

    Dim X As Integer
    Dim Y As Integer
    Dim Center As Integer = Value \ 2

    '行列のすべての要素を-1にする。
    For Y = 0 To Value - 1
        For X = 0 To Value - 1
            Kernel(X, Y) = -1
        Next
    Next

'行列の中央の要素をセットする。
Kernel(Center, Center) = Value * Value

Return ApplyKernel(SourceImage, Kernel, 1)

End Function

'''■ApplyKernel
''' <summary>正方行列を使って色変換処理を行う。</summary>
''' <param name="SourceImage">元となる画像</param>
''' <param name="Kernel">使用する正方行列</param>
''' <param name="Weight">重み。通常、重みは正方行列の要素の値の合計。</param>
''' <param name="RUpper">省略可。赤の要素の増分を指定。</param>
''' <param name="GUpper">省略可。緑の要素の増分を指定。</param>
''' <param name="BUpper">省略可。青の要素の増分を指定。</param>
''' <returns>処理後の画像を返します。</returns>
''' <remarks></remarks>
Private Function ApplyKernel(ByVal SourceImage As Image, ByVal Kernel(,) As Integer, ByVal Weight As Integer, Optional ByVal RUpper As Integer = 0, Optional ByVal GUpper As Integer = 0, Optional ByVal BUpper As Integer = 0) As Bitmap

    Dim i As Integer
    Dim j As Integer
    Dim X As Integer
    Dim Y As Integer
    Dim R As Integer
    Dim G As Integer
    Dim B As Integer
    Dim BMP1 As Bitmap '効果適用前の画像
    Dim BMP2 As Bitmap '効果適用後の画像
    Dim C As Color
    Dim Edge As Integer = (Kernel.GetLength(0) \ 2) * 2 '画像のへりの部分のピクセル数
    Dim MatrixSize As Integer = Kernel.GetLength(0)

BMP1 = CType(SourceImage, Bitmap)
BMP2 = New Bitmap(BMP1.Width, BMP1.Height)

For i = 1 To BMP1.Height - Edge
For j = 1 To BMP1.Width - Edge

            R = 0
            G = 0
            B = 0

            'ドット(j, i)の新しい色を算出します。
            For Y = 0 To MatrixSize - 1
                For X = 0 To MatrixSize - 1
                    C = BMP1.GetPixel(j + X - 1, i + Y - 1)
                    R = (C.R * Kernel(X, Y)) + R
                    G = (C.G * Kernel(X, Y)) + G
                    B = (C.B * Kernel(X, Y)) + B
                Next X
            Next Y

            'R, G, Bの値が～の範囲に収まるように調節します。
            R = RGBRange((R + RUpper) \ Weight)
            G = RGBRange((G + GUpper) \ Weight)
            B = RGBRange((B + BUpper) \ Weight)

BMP2.SetPixel(j, i, Color.FromArgb(R, G, B))

Next j
Next i

Return BMP2

End Function

'''■RGBRange
''' <summary>値を0～255の範囲になるように調節します。</summary>
''' <param name="Value">調節前の値を指定します。</param>
''' <returns>調節後の値を返します。この値は必ず0～255の範囲内です。</returns>
''' <remarks></remarks>
Private Function RGBRange(ByVal Value As Integer) As Integer

    Select Case Value
        Case Is < 0
            Return 0
        Case Is > 255
            Return 255
        Case Else
            Return Value
    End Select

End Function

メモ：

・この例では画像の「へり」の部分はシャープになりません。「へり」の幅はSharpen関数の第２引数と一致します。

・この処理には時間がかかります。大量の画像を処理する場合は実用に耐えません。

・このサンプル中のApplyKernel関数、RGBRange関数は他のサンプルに登場する同名の関数とまったく同じ内容です。

使用例１：PictureBox1の画像をシャープにする例

Me.Cursor = Cursors.WaitCursor

PictureBox1.Image = Sharpen(PictureBox1.Image)

Me.Cursor = Cursors.Default

メモ：PictureBox1にはあらかじめ画像を読み込んでおくなどしてImageプロパティに値をセットしておく必要があります。

使用例２：PictureBox1の画像をなんともいえないアバンギャルドな色彩にする例

Me.Cursor = Cursors.WaitCursor

PictureBox1.Image = Sharpen(PictureBox1.Image, 4)

Me.Cursor = Cursors.Default

メモ：PictureBox1にはあらかじめ画像を読み込んでおくなどしてImageプロパティに値をセットしておく必要があります。

VB6でも同じ手法で実現できます。処理速度向上のためにWindows API関数のGetDIBitsやSetDIBitsを使用します。