Tuhan, tolong berkahi apa yang hamba kerjakan hari ini. jadikan menjadi jalan yang lurus dan mudah. Amien.
Jumat, 31 Mei 2013
program untuk pengolahan citra dalam membedakan foto1 atau foto ke 2
listing program
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Dim Arr1(0 To 29, 0 To 29) As Integer
Dim Arr2(0 To 29, 0 To 29) As Integer
Dim Relevance() As Integer
Dim Rel As Integer
Dim Alphabet As Integer
Private Sub cmdBandingkan_Click()
Dim i, j, r, g, b, w1, w2, h1, h2, w3 As Integer
Dim pic1, pic2, count As Long
c = 0
count = 0
w1 = 0
h1 = 0
w2 = 0
h2 = 0
For i = 0 To Picture1.ScaleWidth
w1 = w1 + 1
Next i
For i = 0 To Picture1.ScaleHeight
h1 = h1 + 1
Next i
For i = 0 To Picture2.ScaleWidth
w2 = w2 + 1
Next i
For i = 0 To Picture2.ScaleHeight
h2 = h2 + 1
Next i
If (w1 > w2) Then
w3 = w1
Else
w3 = w2
End If
If (h1 > h2) Then
h3 = h1
Else
h3 = h2
End If
For i = 0 To w3 - 1
For j = 0 To h3 - 1
p1 = GetPixel(Picture1.hdc, i, j)
p2 = GetPixel(Picture2.hdc, i, j)
r1 = p1 Mod 256
r2 = p2 Mod 256
g1 = (p1 Mod 256) / 256
g2 = (p2 Mod 256) / 256
b1 = ((p1 Mod 256) / 256) / 256
b2 = ((p2 Mod 256) / 256) / 256
If r1 > 228 Or g1 > 228 Or b1 > 228 Then
SetPixel Picture1.hdc, i, j, vbWhite
Else
SetPixel Picture1.hdc, i, j, vbBlack
End If
If r2 > 288 Or g2 > 288 Or b2 > 228 Then
SetPixel Picture2.hdc, i, j, vbWhite
Else
SetPixel Picture2.hdc, i, j, vbBlack
End If
Next j
Next i
For i = 0 To w3 - 1
For j = 0 To h3 - 1
pic1 = GetPixel(Picture1.hdc, i, j)
pic2 = GetPixel(Picture2.hdc, i, j)
If pic1 = pic2 Then
count = count + 1
End If
c = c + 1
Next j
Next i
dv = (count / c) * 100 'decesion variable
dp = Round(dv, 2) '2 decimal place
If dp >= 80 Then
MsgBox dp, vbOKOnly, "Identical"
Else
MsgBox dp, vbOKOnly, "Different"
End If
End Sub
Private Sub cmdBrowse1_Click()
cd1.Filter = "File Gambar | *.jpg; *.bmp"
cd1.ShowOpen
Picture1.Picture = LoadPicture(cd1.FileName)
End Sub
Private Sub cmdBrowse2_Click()
cd1.Filter = "File Gambar | *.jpg; *.bmp"
cd1.ShowOpen
Picture2.Picture = LoadPicture(cd1.FileName)
End Sub
selamat mencobaa...!!!goodluckk.
Langganan:
Posting Komentar (Atom)
Tidak ada komentar:
Posting Komentar