MysticalNeopian
asked on
Speeding up my OCR
Hello everyone I'm using the GetPixelAPI to scan an image... can anyone help me make it vastly faster?
In a module
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
Public Function ColorDiff(myColor1 As Long, _
myColor2 As Long) As Long
ColorDiff = Abs((myColor1 Mod 256) - (myColor2 Mod 256))
ColorDiff = ColorDiff + Abs(((myColor1 \ 256) And 255) - ((myColor2 \ 256) And 255))
ColorDiff = ColorDiff + Abs(((myColor1 \ 65536) And 255) - ((myColor2 \ 65536) And 255))
End Function
Public Function DownloadFile(URL As String, _
LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then
DownloadFile = True
End If
End Function
--------------------------
the program
--------
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, _
ByVal X As Long, _
ByVal Y As Long) As Long
Public Sub FindPet()
Dim CurrDiff As Long
Dim DoubleCheck As Long
Dim highScore As Integer
Dim TempScore As Integer
Dim picKey As Object
Dim mMaster As Object
Dim TotDiff As Integer
Dim NumDiff As Integer
Dim Threshold As Integer
'Select which background image for code
For img = 1 To 14
Select Case img
Case 1:
Set picKey = picDesert
Case 2:
Set picKey = picMain
Case 3:
Set picKey = picPlateau
Case 4:
Set picKey = picKiko
Case 5:
Set picKey = picFarm
Case 6:
Set picKey = picMeri
Case 7:
Set picKey = picCave
Case 8:
Set picKey = picDesert2
Case 9:
Set picKey = picMain2
Case 10:
Set picKey = picPlateau2
Case 11:
Set picKey = picKiko2
Case 12:
Set picKey = picFarm2
Case 13:
Set picKey = picMeri2
Case 14:
Set picKey = picCave2
End Select
TempScore = 0
TotDiff = 0
NumDiff = 0
For X% = 10 To picKey.ScaleWidth Step 30
For Y% = 10 To picKey.ScaleHeight Step 30
CurrDiff = ColorDiff(GetPixel(picView .hDC, X%, Y%), GetPixel(picKey.hDC, X%, Y%))
If CurrDiff < 600 Then
TotDiff = TotDiff + CurrDiff
NumDiff = NumDiff + 1
End If
If CurrDiff < 50 Then
TempScore = TempScore + 1
End If
Next Y%
Next X%
If TempScore > highScore Then
Set mMaster = picKey
highScore = TempScore
Threshold = TotDiff / NumDiff + 20
End If
Next img
'Find the pet in the image
highScore = 0
For X% = 10 To mMaster.ScaleWidth - 11 Step 10
For Y% = 15 To mMaster.ScaleHeight - 16 Step 15
TempScore = 0
For X1% = X% - 10 To X% + 10 Step 5
For Y1% = Y% - 15 To Y% + 15 Step 5
CurrDiff = ColorDiff(GetPixel(picView .hDC, X1%, Y1%), GetPixel(mMaster.hDC, X1%, Y1%)) + Modifier
If CurrDiff > Threshold Then
TempScore = TempScore + CurrDiff / 10
End If
Next Y1%
Next X1%
If TempScore > highScore Then
highScore = TempScore
CodeX = X%
CodeY = Y%
End If
Next Y%
Next X%
picView.PSet (CodeX, CodeY), vbRed
picView.Circle (CodeX, CodeY), 20, vbBlue
End Sub
In a module
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
Public Function ColorDiff(myColor1 As Long, _
myColor2 As Long) As Long
ColorDiff = Abs((myColor1 Mod 256) - (myColor2 Mod 256))
ColorDiff = ColorDiff + Abs(((myColor1 \ 256) And 255) - ((myColor2 \ 256) And 255))
ColorDiff = ColorDiff + Abs(((myColor1 \ 65536) And 255) - ((myColor2 \ 65536) And 255))
End Function
Public Function DownloadFile(URL As String, _
LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then
DownloadFile = True
End If
End Function
--------------------------
the program
--------
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, _
ByVal X As Long, _
ByVal Y As Long) As Long
Public Sub FindPet()
Dim CurrDiff As Long
Dim DoubleCheck As Long
Dim highScore As Integer
Dim TempScore As Integer
Dim picKey As Object
Dim mMaster As Object
Dim TotDiff As Integer
Dim NumDiff As Integer
Dim Threshold As Integer
'Select which background image for code
For img = 1 To 14
Select Case img
Case 1:
Set picKey = picDesert
Case 2:
Set picKey = picMain
Case 3:
Set picKey = picPlateau
Case 4:
Set picKey = picKiko
Case 5:
Set picKey = picFarm
Case 6:
Set picKey = picMeri
Case 7:
Set picKey = picCave
Case 8:
Set picKey = picDesert2
Case 9:
Set picKey = picMain2
Case 10:
Set picKey = picPlateau2
Case 11:
Set picKey = picKiko2
Case 12:
Set picKey = picFarm2
Case 13:
Set picKey = picMeri2
Case 14:
Set picKey = picCave2
End Select
TempScore = 0
TotDiff = 0
NumDiff = 0
For X% = 10 To picKey.ScaleWidth Step 30
For Y% = 10 To picKey.ScaleHeight Step 30
CurrDiff = ColorDiff(GetPixel(picView
If CurrDiff < 600 Then
TotDiff = TotDiff + CurrDiff
NumDiff = NumDiff + 1
End If
If CurrDiff < 50 Then
TempScore = TempScore + 1
End If
Next Y%
Next X%
If TempScore > highScore Then
Set mMaster = picKey
highScore = TempScore
Threshold = TotDiff / NumDiff + 20
End If
Next img
'Find the pet in the image
highScore = 0
For X% = 10 To mMaster.ScaleWidth - 11 Step 10
For Y% = 15 To mMaster.ScaleHeight - 16 Step 15
TempScore = 0
For X1% = X% - 10 To X% + 10 Step 5
For Y1% = Y% - 15 To Y% + 15 Step 5
CurrDiff = ColorDiff(GetPixel(picView
If CurrDiff > Threshold Then
TempScore = TempScore + CurrDiff / 10
End If
Next Y1%
Next X1%
If TempScore > highScore Then
highScore = TempScore
CodeX = X%
CodeY = Y%
End If
Next Y%
Next X%
picView.PSet (CodeX, CodeY), vbRed
picView.Circle (CodeX, CodeY), 20, vbBlue
End Sub
ASKER
I know someone can help me out!
Try NOT to scan every pixel...
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER