Visual Basic でOpenCV⑰ - 透視投影

Visual BasicOpenCVを使用し、矩形を検出し、それを透視投影します。

透視投影

Visual BasicOpenCV⑮ - 矩形の検出を応用し、透視投影を行うプログラムを紹介します。ユーザーインターフェースなどは、これまでと同じです。ただし、TextBox へ指定する値は、透視投影後の画像サイズです。

Form1 .vb

Form1 に対するソースコードは若干の変更がありますので、その部分だけ示します。

:
Public Sub New()
    :
    Panel1.AutoScroll = True
    PBox.Location = New Point(0, 0)
    tSTextBox.Text = "400 x 300"                               ' 追加
    tSTextBox.TextBoxTextAlign = HorizontalAlignment.Center    ' 追加

    :
End Sub

:

Private Sub ToolMenuEffect_Click(sender As Object, e As EventArgs) _
                                            Handles ToolMenuEffect.Click
        :
        Cursor = Cursors.WaitCursor
        mForm2.DoCvShow(ccvfunc, tSTextBox.Text)
        :
End Sub
:

コンストラクターでTextBox の値を設定します。本プログラムで設定するのは透視投影後の画像サイズです。実際の透視投影はToolMenuEffect_Click メソッド内からForm2 のDoCvShow メソッドを呼び出して処理します。DoCvShow メソッドの引数にTextBox の値を与えるのは先のプログラムと同様です。異なるのはDoCvShow メソッドが値を返さないことです。

Form2 .vb

結果を表示するForm2 に対するソースコードは、以前と少し変わります。その部分だけ示します。

:
Public Sub DoCvShow(ccvfunc As CCvFunc, size As String)
    mCcvfunc = ccvfunc

    Dim bmp As Bitmap = mCcvfunc.DoCvFunction(size)
    If bmp IsNot Nothing Then
        PBox.Image = bmp
        AdjustWinSize(PBox.Image)
        Show()
    End If
End Sub
:

DoCvShow メソッドは、基本的に以前のプログラムと大きな違いはなく、単に何も返さないメソッドに変わるだけです。
斜めに撮影された名刺や印刷物などを自動認識し、正面から撮影した画像へ変換します。プログラムの説明から始めると説明が分かりにくくなるため、実行例を先に示します。プログラムを起動し、画像ファイルをドロップすると、自動で透視投影が実行されます。

実行


結果から分かるように正面から撮影したように透視投影されます。結果のサイズは入力画像を読み込んだフォームで指定したサイズを使用します。入力画像からアスペクト比などを判別できないため、このように使用者が指定します。この例では結果のサイズをデフォルトの「400 x 300」を使用したため、結果のアスペクトは崩れています。

試しに「400 x 300」を「300 x 400」へ変更し、再度透視投影してみます。

CCvFunc.vb

それではソースコードの説明を行いましょう。実際の透視投影を行う、CCv の派生クラスCCvFunc の5 つのメソッドを順に説明します。

DoCvFunctionメソッド

Public Function DoCvFunction(size As String) As Drawing.Bitmap
    mDst = mSrc.Clone()
    Dim delimitter = {"X"c, "x"c} ' delimitter
    Dim resolutions = size.Split(delimitter)

    Dim persWidth = Convert.ToInt32(resolutions(0))
    Dim persHeight = Convert.ToInt32(resolutions(1))

    Dim gray As New Mat()
    Cv2.CvtColor(mSrc, gray, ColorConversionCodes.RGB2GRAY)
    Cv2.Threshold(gray, gray, 128, 255, ThresholdTypes.Binary)


    Dim contours As Point()()
    Dim hierarchy As HierarchyIndex()
    Cv2.FindContours(gray, contours, hierarchy, RetrievalModes.Tree,
                                    ContourApproximationModes.ApproxTC89L1)

    Dim tmpContours = New Point()() {}
    For i = 0 To contours.Length - 1
        Dim a As Double = Cv2.ContourArea(contours(i), False)
        If a > 50 * 50 Then         ' only an area of 50 x 50 or more
            Dim approx As Point()   ' contour to a straight line
            approx = Cv2.ApproxPolyDP(contours(i),
                            0.01 * Cv2.ArcLength(contours(i), True), True)
            If approx.Length = 4 Then ' rectangle only
                tmpContours = New Point()() {approx}
                Exit For            ' only first one
            End If
        End If
    Next
    mDst = New Mat(persHeight, persWidth, mSrc.Type(), Scalar.LightCoral)
    If tmpContours.Length = 0 Then
        Return OpenCvSharp.Extensions.BitmapConverter.ToBitmap(mDst)
    End If

    mPsrc = New Point2f(3) {}    ' perspective source
    For i = 0 To mPsrc.Length - 1
        mPsrc(i) = CType(tmpContours(0)(i), Point2f)
    Next
    SortSrcPoints(mPsrc)

    mPdst = New Point2f() {New Point2f(0.0F, 0.0F), ' perspective destination
                            New Point2f(0.0F, persHeight - 1),
                                New Point2f(persWidth - 1, persHeight - 1),
                                    New Point2f(persWidth - 1, 0.0F)}
    Dim bmp As Drawing.Bitmap = DoPers(mSrc, mDst, mPsrc, mPdst)
    Return bmp
End Function

Char() 型のdelimitter にデリミッターを与え、Split メソッドでサイズの値を resolutionsへ得たのち、persWidth とpersHeight へ格納します。
Cv2.FindContours メソッド呼び出しに先立ち、まずCv2.CvtColor メソッドでカラー画像をグレイスケール画像に変換します。そして、Cv2.Threshold メソッドで閾値処理を行い輪郭の検出が行いやすい画像へ変換します。この例では、
Cv2.Threshold(gray, gray, 128, 255, ThresholdTypes.Binary)
を指定します。閾値や2 値化の手法はいろいろ試し、処理対象画像に合わせた値や方法を採用してください。2 値化した画像をCv2.FindContours メソッドに与え、輪郭を検出します。各輪郭は点のベクトルとして格納されます(Point()())。次に、Cv2.ContourArea メソッドを使用し、領域の面積を求め小さなものは排除します。ある程度以下のものを排除し、Cv2.ApproxPolyDP メソッドで輪郭を直線近似化します。
Cv2.ApproxPolyDP メソッドは、指定され引数で与えられた精度で多角形曲線を近似します。近似した結果がapprox へ格納されます。このapprox を調べ、頂点が4 つのものだけを選出すると矩形を検出できます。
透視投影処理に先立ち、結果を保持するMat オブジェクトを指定のサイズとLightCoralで生成します。矩形を検出できなかったら生成した画像をBitmap オブジェクトへ変換し、呼び出し元へ返します。これによって、オブジェクトを検出できなかった場合、結果表示フォームはLightCoral で塗りつぶされます。
検出できたら、矩形の頂点を保持しているtmpContours(Point()())の最初の4 点をmPsrc(Point2f())へコピーしたのち、頂点の並び替えを行います。このmPsrc はクラスのフィールドで、ほかのメソッドからも参照されます。座標の格納順がOpenCvSharp の法則に則っているとは限らないため、SortSrcPoints を呼び出し並び替えます。並び替えたmPsrc と、格納するMat オブジェクトの座標を格納したmPdst を使って透視投影を行います。透視投影はDoPers メソッドで処理します。

DoPersメソッド

Private Function DoPers(mSrc As Mat, mDst As Mat,
                mPsrc As Point2f(), mPdst As Point2f()) As Bitmap
    Dim persMatrix As Mat = Cv2.GetPerspectiveTransform(mPsrc, mPdst)
    Cv2.WarpPerspective(mSrc, mDst, persMatrix,
                                mDst.Size(), InterpolationFlags.Cubic)

    Dim bmp As Bitmap = OpenCvSharp.Extensions.BitmapConverter.ToBitmap(mDst)
    Return bmp
End Function

透視投影を行うDoPers メソッドは単純なメソッドです。引数で受け取った入力と出力のMat オブジェクト、そして透視投影に必要な2 つの座標を使って透視投影を行います。透視投影そのものについては、Visual BasicOpenCV⑪ - アフィン変換透視投影で解説済みです。本メソッドは、処理結果をBitmap オブジェクトへ変換し、呼び出し元へ返します。

SortSrcPointsメソッド

Private Sub SortSrcPoints(points As Point2f())
    Dim sortedPointsc = New Point2f(3) {}

    For j = 3 To 1 Step -1          ' Sort by X
        For i = 0 To j - 1
            If points(i).X > points(i + 1).X Then
                Swap(points(i), points(i + 1))
            End If
        Next
    Next

    If points(0).Y > points(1).Y Then
        Swap(points(0), points(1))
    End If
    If points(2).Y < points(3).Y Then
        Swap(points(2), points(3))
    End If
End Sub

SortSrcPoints メソッドは、受け取った頂点を並び替えます。DoPersメソッドで使用する投影元の座標の並びは、下図に示す順序で並んでいる必要があります。このため、本メソッドで、不定な順に格納されているpointsの座標を並び替えます。

つまり、pointsに格納されている座標を、左上を先頭に、左下、右下、右上の順に並び替えます。もし、座標の並びが前記のルールに従っていないと、透視投影に失敗します。

Rotatedメソッド

Public Function Rotated() As Drawing.Bitmap
    Dim temp = mPsrc(0)
    mPsrc(0) = mPsrc(1)
    mPsrc(1) = mPsrc(2)
    mPsrc(2) = mPsrc(3)
    mPsrc(3) = temp

    Dim bmp As Drawing.Bitmap = DoPers(mSrc, mDst, mPsrc, mPdst)
    Return bmp
End Function

Rotated メソッドは、表示用のフォームでマウスをクリックするたびに呼び出されるメソッドです。呼び出されるたびに座標を右回りに90°回転し、それをBitmap オブジェクトへ変換して返します。このメソッドはクラスのフィールを直接操作していますが、できれば引数で受け渡す方がオブジェクト指向に沿うでしょう。

Swapメソッド

Private Sub Swap(ByRef A, ByRef B)
    Dim Tmp
    Tmp = B
    B = A
    A = Tmp
End Sub

Swapメソッドは、単純に引数の内容をスワップするだけです。