NiteWrapper's NOCR function with improved accuracy

[kaenjie2]

Well, I notice that the NOCR function in NiteWrapper control skip coordinate's pixel reading by 1 each step (that is, For x=... Step 2). Not only that, it starts reading at x=20 and ends at y=30. If the darkest pixel lies somewhere there, it'll result in the wrong coordinate. So, this has downgraded the accuracy for a mere improvement of 10-20ms.

So, this is my improved function of the NiteWrapper's NOCR for accuracy, comparing the darkest pixel using luminance method.

Public Function NOCR(link As String) As String
Dim img() As Byte
Dim Pet As StdPicture
Dim lX As Long
Dim lY As Long
Dim lDarkestX As Long
Dim lDarkestY As Long
Dim CurPix As Single
Dim TheDarkest As Single

source = 'I purposefuly removed this. This is the URL of the picture you want to find the darkest pixel
If InStr(1, source, "Content-Type: image/jpeg") <> 0 Then
    source = Mid(source, InStr(1, source, Chr(255) & Chr(216) & Chr(255)), Len(source) - InStr(1, source, Chr(255) & Chr(216) & Chr(255)))
    source = Replace(source, Chr(13) & Chr(10) & Chr(48) & Chr(13) & Chr(10) & Chr(13), "")
End If
img = StrConv(source, vbFromUnicode)
    Set Pet = PicStream(img)
    Set nitepic.Picture = Pet

    LoadPicArray nitepic.Picture

TheDarkest = (0.3 * 255) + (0.59 * 255) + (0.11 * 255)
'As you can see, the three 255 represents RGB respectively and setting them to 255 means starting it with the brightest luminance.

    For lY = 1 To nitepic.ScaleHeight - 1
    
        For lX = 1 To nitepic.ScaleWidth - 1
         
            CurPix = (0.3 * Data(lX * 3 + 2, lY)) + (0.59 * Data(lX * 3 + 1, lY)) + (0.11 * Data(lX * 3, lY))
            If CurPix < TheDarkest Then
                TheDarkest = CurPix
                lDarkestX = lX
                lDarkestY = lY
            End If
        Next
    Next
lDarkestY = nitepic.ScaleHeight - lDarkestY - 1 'Because bitmap store y coordinate in reverse.
NOCR = "&x=" & lDarkestX & "&y=" & lDarkestY

End Function

[Violent_J]

what do you mean source of your own picture?
Like where it is located?

[kaenjie2]

source is the URL of the picture you want to find the darkest pixel. It says source, so i said source too, lol whatever.

[Aethean]

Ive been using it ever since he released it and its never missed so far..

[kaenjie2]

Originally Posted by Aethean

Ive been using it ever since he released it and its never missed so far..

Good for you. The chance of missing the coordinate is very little. So, yeah, it might not make any difference at all.

If you really make a detection of why a haggle failed, whether its sold out or you clicked the wrong coordinate, there should be several that caused by wrong coordinate, maybe after a hundred of failed haggles.

[Violent_J]

Sub DownLoadCaptcha()
    lblstatus.SimpleText = "Downloading capatcha!..."
    strHTML = w.DownloadFile("http://www.neopets.com/captcha_show.phtml?" & Functions.GSB(strHTML, "/captcha_show.phtml?", Chr$(34) & " style="), App.Path & "\captcha.jpg")
    piccaptcha = LoadPicture(App.Path & "\captcha.jpg")
    strCoords = SockOCR.sockBlackOCR(piccaptcha)
End Sub

Nitewrapper OCR may be accurate and all but what is the use if it is not very fast? I use sockopens OCR because it has speed and accuracy (just not a whole lot of accuracy)

[kaenjie2]

hehe, okay. I can see that sockOCR has its own method of comparing darkest pixel. It seems that it has to refer to additional list of data, called dBox or something. Interesting method he got there, id like to learn the theory on that.

Mine use luminance comparison, which is a lot simpler, as you can see it is. Yet still it is considerably accurate. Only 1 wrong coordinate so far, and that was only because the darkest pixel was on the very border of the box, but still it WAS the darkest pixel. I refrain from skipping pixel reading by 1 each step, unlike NOCR and sockOCR. You can see that they put 'Step 2' instead of 'Step 1' in its For loop. And they start reading at x=20 and y=20...

On my computer, putting step 2 in For loop, it clocked 20ms for the comparison of the darkest pixel (minus picture download time). While putting Step 1 clocked 30ms-40ms. Yep, for a downgraded accuracy, I only get 20ms of improvement. For me its not worth it.

But its really up to the individual, if you think even ms is vital then go for it.

Edit:
You can actually modify sockopen OCR to use luminance comparison method. Here's how, just replace the OCR function with this:

Public Function OCR() As String
Dim xPl As Long, yPl As Long
Dim xx as long, yy as long
Dim CurPix As Single
Dim TheDarkest As Single
Dim t As Long: t = timeGetTime()

    picArr picCaptcha.Picture

    TheDarkest = (0.3 * 255) + (0.59 * 255) + (0.11 * 255)

    For xPl = 1 To picCaptcha.ScaleWidth - 1 Step 1
        For yPl = 1 To picCaptcha.ScaleHeight - 1 Step 1
            CurPix = (0.3 * Data(xPl * 3 + 2, yPl)) + (0.59 * Data(xPl * 3 + 1, yPl)) + (0.11 * Data(xPl * 3, yPl))
            If CurPix < TheDarkest Then
                TheDarkest = CurPix
                xx = xPl
                yy = yPl
            End If
        Next yPl
    Next xPl

    yy = picCaptcha.ScaleHeight - yy - 1
    OCR = "&x=" & xx & "&y=" & yy
    t = timeGetTime() - t
End Function

[Violent_J]

I am using sockopens OCR
He has 2

This is the one

Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
Dim offBy As Integer, x As Long, y As Long



Public Function ColorDiff(Color1 As Long, Color2 As Long) As Long
    ColorDiff = Abs((Color1 Mod 256) - (Color2 Mod 256))
    ColorDiff = ColorDiff + Abs(((Color1 \ 256) And 255) - ((Color2 \ 256) And 255))
    ColorDiff = ColorDiff + Abs(((Color1 \ 65536) And 255) - ((Color2 \ 65536) And 255))
End Function

Public Function ChangePicture(picNewCaptcha As String)
    piccaptcha.Picture
End Function


Function sockBlackOCR(sockPicture As PictureBox) As String
    offBy = 350    'This is how far off from black will be accepted as part of the pet, feel free to experiment!

    Do
        For y = 10 To sockPicture.ScaleHeight - 15 Step 4   ' We are scaling the picture vertically, every 4 pixels vertically, is being checked
            For x = 10 To sockPicture.ScaleWidth - 15 Step 4   ' For every time it goes up 4 pixels, it will now scale the image horizontally, every fourth pixel (we skip pixels for speed)
                If ColorDiff(GetPixel(sockPicture.hDC, x, y), vbBlack) < offBy Then    ' If The difference between black and the color of the pixel at the current horizontal and vertical location is smaller than 'offBy' then...
                    ' sockPicture.Circle (X, Y), 2, vbBlue ' Put a circle there if you want to see it work
                    sockBlackOCR = "&x=" & x & "&y=" & y
                    Exit Function
                    Exit Do    ' Exit the loop, you've found the black spot
                End If
            Next x
        Next y
        offBy = offBy + 50    ' If it didn't find any pixels that were that close to black, loosen the slack, and it will search for pixels that are slightly less black also
    Loop

End Function

So if you can incorporated that into this so I can have a bit of both then you would do me a great favor.

[kaenjie2]

hm.. GetPixel is slow compared to the DMA one. DMA is about 5x faster than GetPixel. For that reason Im gonna have to skip reading pixel by 1 each step to speed it up. As ive told you, i usually use step 1 in For-loop for pixel reading. You can skip it further by putting step 3 or step 4 but accuracy is gonna be slightly degraded, its hard to say.

Public Function sockBlackOCR(sockPicture As PictureBox) As String
Dim t As Long, CurPix As Single, TheDarkest As Single
Dim xx As Long, yy As Long

TheDarkest = (0.3 * 255) + (0.59 * 255) + (0.11 * 255)

For y = 2 To sockPicture.ScaleHeight - 2 Step 2   
    For x = 2 To sockPicture.ScaleWidth - 2 Step 2  
        CurPix = GetPixel(sockPicture.hdc, x, y)
        CurPix = (0.3 * (CurPix And &HFF)) + (0.59 * ((CurPix \ &H100) And &HFF)) + (0.11 * ((CurPix \ &H10000) And &HFF))
            If CurPix < TheDarkest Then
                TheDarkest = CurPix
                xx = x
                yy = y
            End If
    Next x
Next y
sockBlackOCR = "&x=" & xx & "&y=" & yy

End Function

[Violent_J]

Do you know his other OCR?