C# と VB.NET の質問掲示板

ASP.NET、C++/CLI、Java 何でもどうぞ

C# と VB.NET の入門サイト

Re[2]: VB2013,8近傍でのラベリング処理について


(過去ログ 119 を表示中)

[トピック内 3 記事 (1 - 3 表示)]  << 0 >>

■69807 / inTopicNo.1)  VB2013,8近傍でのラベリング処理について
  
□投稿者/ ななし (3回)-(2014/01/30(Thu) 22:29:44)

分類:[.NET 全般] 

こんばんは。ななしと申します。現在、VB2013を用いた画像処理について学習しています。
今回質問させて頂くのは、8近傍で輪郭を追跡するラベリングについてです。

http://imagingsolution.blog107.fc2.com/blog-entry-198.html

上記webページを参考にしてプログラムを作成してみたのですが、うまく行きません。
どこがおかしいのかわかる方がおられましたらご指摘頂けると幸いです。

Color.Black, Color.Redのみで描画された画像について、Color.Redのピクセルを発見したら、
そこから輪郭を追跡しラベル付けをするプログラムを作成したつもりです。
よろしくお願いいたします。


---以下ソースコード---

Private Sub Button19_Click(sender As Object, e As EventArgs) Handles Button19.Click

Dim i As Integer, j As Integer
Dim cColor As Color
Dim Label As Integer = 1
Dim bBitmap As New Bitmap(PictureBox2.Image)
Dim iArrayValue As Integer(,) = New Integer(PictureBox2.Image.Width - 1, PictureBox2.Image.Height - 1)

 For i = 0 To PictureBox2.Image.Width - 1
            For j = 0 To PictureBox2.Image.Height - 1

                cColor = bBitmap.GetPixel(i, j)                'ピクセルの色の取得
                'ピクセルの色の設定
                iArrayValue(i, j) = cColor.R
            Next
        Next

 For i = 0 To PictureBox2.Image.Width - 1
            For j = 0 To PictureBox2.Image.Height - 1
                If iArrayValue(i, j) = Color.Red.R Then
                    SetLabel2(iArrayValue, i, j, Label)
                    Label += 1
                End If
            Next
        Next

End Sub



Private Sub SetLabel2(ByRef iArray As Integer(,), iStartX As Integer, iStartY As Integer, iLabel As Integer)
        '変数の宣言iCount:設定ピクセル数 im,ip,jm,jp:走査基準位置の上下左右位置

        Dim i As Integer, j As Integer, iCount As Integer
        Dim im As Integer, ip As Integer, jm As Integer, jp As Integer
        Dim Vold As Integer, Vnew As Integer
        Dim vec As Integer
        '開始位置のラベルの設定
        iArray(iStartX, iStartY) = iLabel
        'ラベルの設定処理

        i = iStartX
        j = iStartY

        im = i - 1 'im値の設定
        ip = i + 1 'ip値の設定
        jm = j - 1 'jm値の設定
        jp = j + 1 'jp値の設定

        Do
            iCount = 0 '初期化
            'ラベルの設定

            Select Case vec
                Case 0
                    If iArray(im, jp) = Color.Red.R Then
                        iArray(im, jp) = iLabel
                        Vold = vec
                        Vnew = (Vold + 6) Mod 8
                        vec = Vnew
                        i = im
                        j = jp
                        iCount += 1
                        Exit Select
                    End If
                    vec += 1
                Case 1
                    If iArray(i, jp) = Color.Red.R Then
                        iArray(i, jp) = iLabel
                        Vold = vec
                        Vnew = (Vold + 6) Mod 8
                        vec = Vnew
                        i = i
                        j = jp
                        iCount += 1
                        Exit Select
                    End If
                    vec += 1
                Case 2
                    If iArray(ip, jp) = Color.Red.R Then
                        iArray(ip, jp) = iLabel
                        Vold = vec
                        Vnew = (Vold + 6) Mod 8
                        vec = Vnew
                        i = ip
                        j = jp
                        iCount += 1
                        Exit Select
                    End If
                    vec += 1
                Case 3
                    If iArray(ip, j) = Color.Red.R Then
                        iArray(ip, j) = iLabel
                        Vold = vec
                        Vnew = (Vold + 6) Mod 8
                        vec = Vnew
                        i = ip
                        j = j
                        iCount += 1
                        Exit Select
                    End If
                    vec += 1
                Case 4
                    If iArray(ip, jm) = Color.Red.R Then
                        iArray(ip, jm) = iLabel
                        Vold = vec
                        Vnew = (Vold + 6) Mod 8
                        vec = Vnew
                        i = ip
                        j = jm
                        iCount += 1
                        Exit Select
                    End If
                    vec += 1
                Case 5
                    If iArray(i, jm) = Color.Red.R Then
                        iArray(i, jm) = iLabel
                        Vold = vec
                        Vnew = (Vold + 6) Mod 8
                        vec = Vnew
                        i = i
                        j = jm
                        iCount += 1
                        Exit Select
                    End If
                    vec += 1
                Case 6
                    If iArray(im, jm) = Color.Red.R Then
                        iArray(im, jm) = iLabel
                        Vold = vec
                        Vnew = (Vold + 6) Mod 8
                        vec = Vnew
                        i = im
                        j = jm
                        iCount += 1
                        Exit Select
                    End If
                    vec += 1
                Case 7
                    If iArray(im, j) = Color.Red.R Then
                        iArray(im, j) = iLabel
                        Vold = vec
                        Vnew = (Vold + 6) Mod 8
                        vec = Vnew
                        i = im
                        j = j
                        iCount += 1
                        Exit Select
                    End If
                    vec = 0
            End Select
        Loop While iCount <> 0

    End Sub


引用返信 編集キー/
■69808 / inTopicNo.2)  Re[1]: VB2013,8近傍でのラベリング処理について
□投稿者/ Azulean (265回)-(2014/01/30(Thu) 22:40:46)
2014/01/30(Thu) 22:41:44 編集(投稿者)

No69807 (ななし さん) に返信
> 上記webページを参考にしてプログラムを作成してみたのですが、うまく行きません。
> どこがおかしいのかわかる方がおられましたらご指摘頂けると幸いです。

あなたの期待する結果と、現実はどうかをまず説明してみてはどうでしょうか。
今の投稿では、「期待するものではないので、理想の結果と現在の結果を比較して、原因を調査して、修正してくれ」という回答側の労力が高いものとなっています。

また、おかしいと感じているのでしたらデバッグしませんか?
いきなり大きな画像でテストするのではなく、数ピクセル*数ピクセル程度の小さな画像を元にステップ実行すれば、原因を追いかけやすくなると思います。
引用返信 編集キー/
■69812 / inTopicNo.3)  Re[2]: VB2013,8近傍でのラベリング処理について
□投稿者/ ななし (4回)-(2014/01/31(Fri) 02:50:08)
No69808 (Azulean さん) に返信
> 2014/01/30(Thu) 22:41:44 編集(投稿者)
>
> ■No69807 (ななし さん) に返信
>>上記webページを参考にしてプログラムを作成してみたのですが、うまく行きません。
>>どこがおかしいのかわかる方がおられましたらご指摘頂けると幸いです。
>
> あなたの期待する結果と、現実はどうかをまず説明してみてはどうでしょうか。
> 今の投稿では、「期待するものではないので、理想の結果と現在の結果を比較して、原因を調査して、修正してくれ」という回答側の労力が高いものとなっています。
>
> また、おかしいと感じているのでしたらデバッグしませんか?
> いきなり大きな画像でテストするのではなく、数ピクセル*数ピクセル程度の小さな画像を元にステップ実行すれば、原因を追いかけやすくなると思います。

解答ありがとうございます。改めてデバッグしてみたところいくつか問題見えてきました。もう少し試行錯誤してみます。失礼しました。
解決済み
引用返信 編集キー/


トピック内ページ移動 / << 0 >>

このトピックに書きこむ

過去ログには書き込み不可

管理者用

- Child Tree -