|
分類:[VB.NET]
分類:[VB.NET]
VB.NETのプログラムで白黒判別プログラムを作成することになったのですが、GetPicxelの使い方が間違っているらしく正しくカウントしてくれません。
ちなみに今作成している問題のプログラムは以下のプログラムです。
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim bmap As Bitmap = New Bitmap(PictureBox1.Width, PictureBox1.Height)
PictureBox1.Image = bmap
Dim fName As String
Dim app As String
app = System.Windows.Forms.Application.StartupPath
With OpenFileDialog1
' 初期表示するファイル名を設定する
.FileName = ""
' ファイルのフィルタを設定する
.Filter = "Open (*.bmp)|*.bmp"
' ダイアログを表示
.ShowDialog()
' Multiselect が True の場合はこのように列挙する
'For Each nFileName As String In OpenFileDialog1.FileNames
'MessageBox.Show(nFileName)
'Next nFileName
fName = .FileName
End With
PictureBox1.Image = image.FromFile(fName)
ErrHandler:
' ユーザーが [キャンセル] をクリックしました。
Exit Sub
End Sub
Function CountNumColor(ByRef DotWW As Long, ByRef DotHH As Long, ByRef CHECK_C As Long) As Integer
Dim Form1 As Object
Dim NumEQ As Double
Dim NumNot As Long
Dim x, y As Long
NumEQ = 0
NumNot = 0
System.Windows.Forms.Application.DoEvents()
For x = 0 To DotHH - 1
For y = 0 To DotWW - 1
System.Windows.Forms.Application.DoEvents()
If CHECK_C = Val("Bitmap.GetPixel(x,y)") Then
NumEQ = NumEQ + 1
Else
NumNot = NumNot + 1
Debug.Write("x,y,Val(Bitmap.GetPixel(x, y)")
End If
Next y
Next x
CountNumColor = NumEQ
End Function
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim Form1 As Object
Dim CheckColorB, CheckColorW As Long
Dim NumEQ, NumEQB, NumEQW As Double
Dim PicWW, PicHH As Long
Lbl_CountB.Text = "0"
Lbl_CountW.Text = "0"
Lbl_Status.Text = "Working..."
Button2.Enabled = False
'**** チェックする範囲を指定 ******
PicHH = 100
PicWW = 100
'**** 黒の数をカウント *****
CheckColorB = RGB(0, 0, 0)
NumEQ = CountNumColor(PicWW, PicHH, CheckColorB)
NumEQB = NumEQ
Lbl_CountB.Text = NumEQB
'**** 白の数をカウント ****
CheckColorW = RGB(255, 255, 255)
NumEQW = CountNumColor(PicWW, PicHH, CheckColorW)
NumEQW = NumEQ
Lbl_CountW.Text = NumEQW
'**** 黒の閉める割合％ ****
Lbl_CountBBW.Text = Format((NumEQB / (NumEQB + NumEQW)), "##%")
Button2.Enabled = True
Lbl_Status.Text = ""
End Sub
このプログラムで問題がありましたらぜひとも教えてください。GetPicxel以外の間違いに気づいた人がいた場合もご意見をお待ちしております。また、この質問で分からないことがございましたら遠慮なく書き込んでください。気づき次第返答いたします。
|