by Serdar YUKSEL (4 Submissions)
Category: Math/Dates
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sun 2nd August 2009
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
PATTERN SEARCHER 1.0 This utility can searching pattern inside image according to pearson correlation values. This software include functions
API Declarations
(ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Option Base 1 'set array base to 1
Private resmat(150, 150) As Variant
Private patmat(150, 150) As Variant
Private hesmat As Long
Private hesap As Long
Private Phesa As Long
Private Reis As String
Private seyis As String
Private n As Integer
Private f As Integer
Private m As Integer
Private k As Integer
Private ad As Integer
Private cont As Integer
Private t As Double
'korelayon için değiskenler
Private toplam1 As Long
Private toplam2 As Long
Private fark1 As Long
Private fark2 As Long
Private korel As Double
Private hh As Integer
Private ww As Integer
Private verti As Integer
Private horis As Integer
VBcoders
On Error Resume Next
MkDir App.Path & "\" & Text5.Text & Date
ad = Val(Text7)
t = Val(Text6) / 100
f = Picture1.Width - Picture2.Width
k = Picture1.Height - Picture2.Height
Timer1.Enabled = True
hh = Picture2.Height - 4
ww = Picture2.Width - 6
End Sub
Private Sub Dur_Click()
End Sub
Private Sub donust_Click()
verti = Picture1.Height
horis = Picture1.Width
If Option1.Value = True Then
Call d1
End If
If Option2.Value = True Then
Call d2
End If
If Option3.Value = True Then
Call d3
End If
If Option4.Value = True Then
Call d4
End If
If Option5.Value = True Then
Call d5
End If
End Sub
Private Sub Form_Load()
cont = 0
pixel = 3
Form1.ScaleMode = pixel
Picture1.ScaleMode = pixel
Picture2.ScaleMode = pixel
Picture3.ScaleMode = pixel
n = 0
m = 0
hesmat = 0
End Sub
Private Sub infos_Click()
MsgBox "Serdar Yüksel, e mail: [email protected]"
End Sub
Private Sub nesneac_Click()
On Error GoTo error:
cmd1.DialogTitle = "Open Picture"
cmd1.Filter = "Pictures (*.Bmp *.Jpg *.Gif)|*.bmp; *.jpg; *.gif"
cmd1.ShowOpen
Picture2.Picture = LoadPicture(cmd1.FileName)
error:
Err.Clear
vert = Picture2.Width
hor = Picture2.Height
Text3.Text = vert
Text4.Text = hor
End Sub
Private Sub resac_Click()
Dim vert, hor As Integer
On Error GoTo error:
cmd1.DialogTitle = "Open Picture"
cmd1.Filter = "Pictures (*.Bmp *.Jpg *.Gif)|*.bmp; *.jpg; *.gif"
cmd1.ShowOpen
Picture1.Picture = LoadPicture(cmd1.FileName)
Picture3.Picture = LoadPicture(cmd1.FileName)
error:
Err.Clear
vert = Picture1.Width
hor = Picture1.Height
Text1.Text = vert
Text2.Text = hor
Picture3.Width = Picture1.Width
Picture3.Height = Picture1.Height
End Sub
Private Sub reset_Click()
Unload Me
Form1.Show
End Sub
Private Sub stop_Click()
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer()
If n > f Then
n = 0
m = m + ad
Rtb.Text = Rtb.Text & vbCrLf & "*******"
End If
If m > k Then
Timer1.Enabled = False
End If
Call patern
Call matris
End Sub
Private Function matris()
On Error GoTo hata
For i% = 1 To ww
For j% = 1 To hh
resmat(i%, j%) = Round(GetPixel(Picture3.hDC, i% + n, j% + m) / 100000)
hesmat = hesmat + Round(Abs(resmat(i%, j%) - patmat(i%, j%)) / 100000)
hesap = resmat(i%, j%)
Phesa = patmat(i%, j%)
Reis = Reis & hesap & ";"
seyis = seyis & Phesa & ";"
If j% = ww Then
Reis = Reis & vbCrLf & ";"
seyis = seyis & vbCrLf & ";"
End If
Next j%
Next i%
Call korelasyon
If korel > t Then
Rtb.Text = Rtb.Text & i% + n & ";" & j% + m & vbCrLf & ";"
Picture1.DrawWidth = 5
Picture1.DrawMode = 13
Picture1.Line (i% + n, j% + m)-(i% + n, j% + m), vbYellow
pt.Text = pt.Text & Reis
pt.SaveFile App.Path & "\" & Text5.Text & Date & "\" & Text5.Text & i% + n & "-" & j% + m & ".csv", Text
pt.Text = ""
st.Text = pt.Text & seyis
st.SaveFile App.Path & "\" & Text5.Text & Date & "\" & Text5.Text & "-" & "NESNE" & ".csv", Text
st.Text = ""
cont = cont + 1
Label3.Caption = cont
hata:
End If
korel = "0"
hesmat = 0
Reis = ""
seyis = ""
n = n + ad
End Function
Private Function patern()
For i% = 1 To ww
For j% = 1 To hh
patmat(i%, j%) = Round(GetPixel(Picture2.hDC, i%, j%) / 100000)
Next j%
Next i%
End Function
Private Function korelasyon()
On Error Resume Next
uz% = hh * ww
For i% = 1 To ww
For j% = 1 To hh
t1& = t1& + resmat(i%, j%)
t2& = t2& + patmat(i%, j%)
Next j%
Next i%
ort1& = Round(t1& / uz%, 2)
ort2& = Round(t2& / uz%, 2)
For i% = 1 To ww
For j% = 1 To hh
xy# = Round(xy# + ((resmat(i%, j%) - ort1&) * (patmat(i%, j%) - ort2&)), 2)
xm# = Round(xm# + (resmat(i%, j%) - ort1&) ^ 2, 2)
ym# = Round(ym# + (patmat(i%, j%) - ort2&) ^ 2, 2)
Next j%
Next i%
korel = xy# / Sqr(xm# * ym#)
t1& = "0"
t2& = "0"
ort1& = "0"
ort2& = "0"
xy# = "0"
xm# = "0"
ym# = "0"
End Function
Private Function d1()
Picture3.DrawWidth = 3
Picture3.DrawMode = 13
For i% = 1 To horis
For j% = 1 To verti
Picture3.Line (i%, j%)-(i%, j%), GetPixel(Picture1.hDC, i%, j%) + 5000
Next j%
Next i%
End Function
Private Function d2()
Picture3.DrawWidth = 3
Picture3.DrawMode = 13
For i% = 1 To horis
For j% = 1 To verti
ks# = GetPixel(Picture1.hDC, i%, j%)
If ks# > 2000000 And ks# < 10000000 Then
Picture3.Line (i%, j%)-(i%, j%), GetPixel(Picture1.hDC, i%, j%)
Else
Picture3.Line (i%, j%)-(i%, j%), vbBlack
End If
Next j%
Next i%
End Function
Private Function d3()
Picture3.DrawWidth = 3
Picture3.DrawMode = 13
For i% = 1 To horis
For j% = 1 To verti
Picture3.Line (i%, j%)-(i%, j%), Sqr(Abs(GetPixel(Picture1.hDC, i%, j%)))
Next j%
Next i%
End Function
Private Function d4()
Picture3.DrawWidth = 3
Picture3.DrawMode = 13
For i% = 1 To horis
For j% = 1 To verti
Picture3.Line (i%, j%)-(i%, j%), (GetPixel(Picture1.hDC, i%, j%) + GetPixel(Picture1.hDC, i% + 1, j% + 1) / 2)
Next j%
Next i%
End Function
Private Function d5()
Picture3.DrawWidth = 3
Picture3.DrawMode = 13
For i% = 1 To horis
For j% = 1 To verti
If (GetPixel(Picture1.hDC, i% - 1, j%) / 1000000) * (GetPixel(Picture1.hDC, i%, j + 1) / 1000000) * (GetPixel(Picture1.hDC, i%, j% - 1) / 1000000) * (GetPixel(Picture1.hDC, i%, j%) / 1000000) * (GetPixel(Picture1.hDC, i% + 1, j%) / 1000000) < 10000 Then
Picture3.Line (i%, j%)-(i%, j%), vbWhite
Else
Picture3.Line (i%, j%)-(i%, j%), GetPixel(Picture1.hDC, i%, j%)
End If
Next j%
Next i%
End Function
No comments have been posted about PATTERN SEARCHER 1.0 This utility can searching pattern inside image according to pearson correlati. Why not be the first to post a comment about PATTERN SEARCHER 1.0 This utility can searching pattern inside image according to pearson correlati.
