civilcalc

Autoit OCR without 3rd party software.

42 posts in this topic

#1 ·  Posted (edited)

Hello people.

For the past five years I have been using Autoit for all my programming needs, and the support from the forums has been the best I have ever experienced (apart from the odd mod wannabe troll) and I have always felt like I have taken so much, but given little in return.

I have recently been looking at OCR, and trying to get a reliable system using 3rd party software, but have always found short comings in all the systems available. I beleive I have created the first OCR using JUST autoit script and UDF's.

I will be adding the code here in the near future, but would be looking for someone who could help tidy my script and expand its capabilities, I always write the code just for myself, so it can often be a bit messy or longhanded, when a simplier function would work. So anyone with experience in OCR or UDF's who would like to help finish off this script, let me know and I will PM you what I have so far.

Thanks

Func _OCR($l,$t,$r,$b,$rad,$bkc,$font,$ocrlearn)
    
    $val = ""
    $glue1 = ""
    $glue2 = ""
    $glue3 = ""
    $glue4 = ""
    $glue5 = ""
    $glue6 = ""

    ;add preceding zeros, as pixelsearch doesnt always work without.
    If StringLen($l) = 1 Then $l = "0000"&$l
    If StringLen($l) = 2 Then $l = "000"&$l
    If StringLen($l) = 3 Then $l = "00"&$l
    If StringLen($l) = 4 Then $l = "0"&$l
    If StringLen($t) = 1 Then $t = "0000"&$t
    If StringLen($t) = 2 Then $t = "000"&$t
    If StringLen($t) = 3 Then $t = "00"&$t
    If StringLen($t) = 4 Then $t = "0"&$t
    If StringLen($r) = 1 Then $r = "0000"&$r
    If StringLen($r) = 2 Then $r = "000"&$r
    If StringLen($r) = 3 Then $r = "00"&$r
    If StringLen($r) = 4 Then $r = "0"&$r
    If StringLen($b ) = 1 Then $b = "0000"&$b
    If StringLen($b ) = 2 Then $b = "000"&$b
    If StringLen($b ) = 3 Then $b = "00"&$b
    If StringLen($b ) = 4 Then $b = "0"&$b05
    
    ;create an array of vertical lines for the scan area
    local $array[$r-$l+1]
    ;arr = 'counter'
    $arr = 0
    For $x = $l to $r
        $p =1
        For $y = $t to $b
            ;scan each vertical line in the scan area looking for pixels different to the background colour
            PixelSearch($x,$y,$x,$y,$bkc,$rad)
            If @error = 1 Then $val = $val + ($p*1) ;create a value of the vertical line based on the pixels present
            $p = $p*2
        Next
        $array[$arr] = $val ;load the value into the array
        $arr = $arr+1 ;increase the counter
        $val = 0 ;reset the value to zero for next vertical line
    Next
    
    
    For $a = UBound($array)-1 to 1 step -1
        If $array[$a] = 0 and $array[$a-1] = 0 Then _ArrayDelete($array,$a) ;Delete multiple blank vertical lines from the array
    Next
    If $array[0] = 0 Then _ArrayDelete($array,0)    ;if array is totally blank, delete it
    If Ubound($array) > 2 Then 
        If $array[Ubound($array)-1] = 0 Then _ArrayDelete($array,Ubound($array)-1)  ;delete last element
    EndIf
        
    $string = _ArrayToString($array)
    $string = StringSplit($string,"|0|",1) ;split string at blank verticals to create elements of each character

    $database = FileRead($font) ;read database
    $data = ""
    

    
    For $a = 1 to UBound($string)-1
        If StringInStr($database,"@ "&$string[$a]&" @") Then
            ;check if value already exists in database
            $pos = StringInStr($database,$string[$a]&" @")
            $pos2 = StringInStr($database,"@",0,1,$pos-10)
            $data = $data&StringMid($database,$pos2,($pos-$pos2))
        Else
            ;if not create an image and ask for an input
            $map = StringSplit($string[$a],"|")
            $pattern = $string[$a]
            Local $line[$b-$t+2]
            For $a = 0 to ($b-$t+1)
                $line[$a] = ""
                For $ml = 1 to $map[0]
                    If StringIsInt($map[$ml]/2) = 1 Then 
                        $line[$a] = $line[$a]&"~"
                    Else
                        $line[$a] = $line[$a]&"#"
                    EndIf
                    $map[$ml] = Int($map[$ml]/2)
                Next
            Next
            $image = ""
            For $a = 0 to ($b-$t+1)
                $image = $image&$line[$a]&@CRLF
            Next
            If StringInStr($image,"#") Then 
                $letter = InputBox("Unknown Character","Identify this pattern" & @cr & @cr &@cr & $image,"","",@DesktopWidth-200,@DesktopHeight-200)
                If $letter <> "" Then FileWriteLine($font,$letter & " @ " & $pattern & " @ ")
            EndIf
        EndIf
    Next 
    $data = StringReplace($data,"@","")
    $data = StringReplace($data," ","")
    $data = StringReplace($data,@cr,"")
    $data = StringReplace($data,@crlf,"")
    $data = StringReplace($data,@lf,"")
    Return $data
EndFunc
Edited by civilcalc

Share this post


Link to post
Share on other sites



hi civilcalc,

Why not just post it in its current state and allow those interested to chip in?

It doesn't need to be perfect upon release, we're all here to learn :huh2:

No pressure though, take your time ;)

-smartee

Share this post


Link to post
Share on other sites

hi civilcalc,

Why not just post it in its current state and allow those interested to chip in?

It doesn't need to be perfect upon release, we're all here to learn :huh2:

No pressure though, take your time ;)

-smartee

Ok, I will edit the first post, added some notes to try and explain how it works.

The downside, you must de-activate aero or use windows basic for the pixelsearch function to operate at the correct speed for the script to be any good.

Share this post


Link to post
Share on other sites

#4 ·  Posted (edited)

The basic concept is as follows;

Pick an area to be scanned, the tighter the area, the better it performs.

The UDF creates an array with the same number of elements as the pixel width of the area.

Pixelsearch will check each pixel in the first vertical line and check if each pixel is of a contrasting colour to the background colour (specified as $bkc) any colours within $rad shades are considered 'background'. The first pixel is considered to be worth 1, the next pixel 2, then 4, 8, 16 etc. Once each vertical line is assessed the next vertical line is checked.

so the character;

01~~~~~

02~###~

04~#~#~

08~###~

16~#~#~

32~#~#~

64~~~~~

would produce an array of 0|62|10|62|0

the array is checked from the file $font, if it already exists, it returns the character A or it asks for a definition and saves the result.

I am currently having issues where letters are 'glued' together by not having a clear vertical pixel between them, like "TA" where the top of the T is on the next line to the bottom of the A, each character is visible in the array, but I can't seem to get the script to 'see' the T then remove the T part of the array and check the remainder (A)

Make sense?

It can scan an area of around 100x20 pixels in 0.1 seconds, and I use it mostly when a control is not a traditional type control. It can scan an entire screen in about 3 seconds. It can be taught a whole new font in less than 30 minutes.

Edited by civilcalc

Share this post


Link to post
Share on other sites

Very nice, I hope you continue work on this, until it is something fully functional and workable! :huh2:


[left][sub]We're trapped in the belly of this horrible machine.[/sub][sup]And the machine is bleeding to death...[/sup][sup][/sup][/left]

Share this post


Link to post
Share on other sites

;add preceding zeros, as pixelsearch doesnt always work without.

Because anything else would be uncivilized:

$padded = StringFormat("%05i", 1)
ConsoleWrite($padded & @CRLF)

Share this post


Link to post
Share on other sites

#7 ·  Posted (edited)

why not use

If StringInStr($database,$string[$a]) Then ;check if value already exists in database
    $pos = StringInStr($database,$string[$a])
    $data = $data&StringMid($database,($pos-4),1)
Else

instead of

If StringInStr($database,"@ "&$string[$a]&" @") Then ;check if value already exists in database
        $pos = StringInStr($database,$string[$a]&" @")
        $pos2 = StringInStr($database,"@",0,1,$pos-10)
        $data = $data&StringMid($database,$pos2,($pos-$pos2))
Else

I had the trouble of the first entry in the font file not being recognized, and doing that fixed it. To be honest, I didn't completely understand what you had written for that spot in the first place (the -10 threw me off). I'm still fairly new, and this project will be a great learning experience for me. I love the idea, and the simplicity of it boggles my mind. For a language trying to emulate human input, an OCR seems like a logical step to achieving that goal.

Edit:

the reason the "glued" letters aren't appearing separately is because the last element of the first letter is getting added to the first element of the second letter

TA @ 524|516|964|572|516|4|524|768|708|180|140|1020|512 @

T @ _524|516|964|572|516|4|12 @

A @ ___________________512|768|708|180|140|1020|512 @

So I guess that's why you had the original check in there, because my fix only returns the A...so now to figure out why the first entry in the font file is getting skipped :-(

Edited by blackmage999

Share this post


Link to post
Share on other sites

why not use

If StringInStr($database,$string[$a]) Then ;check if value already exists in database
    $pos = StringInStr($database,$string[$a])
    $data = $data&StringMid($database,($pos-4),1)
Else

instead of

If StringInStr($database,"@ "&$string[$a]&" @") Then ;check if value already exists in database
        $pos = StringInStr($database,$string[$a]&" @")
        $pos2 = StringInStr($database,"@",0,1,$pos-10)
        $data = $data&StringMid($database,$pos2,($pos-$pos2))
Else

I had the trouble of the first entry in the font file not being recognized, and doing that fixed it. To be honest, I didn't completely understand what you had written for that spot in the first place (the -10 threw me off). I'm still fairly new, and this project will be a great learning experience for me. I love the idea, and the simplicity of it boggles my mind. For a language trying to emulate human input, an OCR seems like a logical step to achieving that goal.

Edit:

the reason the "glued" letters aren't appearing separately is because the last element of the first letter is getting added to the first element of the second letter

TA @ 524|516|964|572|516|4|524|768|708|180|140|1020|512 @

T @ _524|516|964|572|516|4|12 @

A @ ___________________512|768|708|180|140|1020|512 @

So I guess that's why you had the original check in there, because my fix only returns the A...so now to figure out why the first entry in the font file is getting skipped :-(

Im not sure why the first entry is skipped either, but I added

Filler @ Filler @ on the first line of the font file

I am also going to add a little bit of code to make the first pixel in each vertical line value 1 then 2,4,8 etc.. so if the ocr is scanning one pixel higher or lower than the font file, characters will still be recognised.

Does this mean you got it to work somewhat? I was worried it all looked a bit over whelming to someone who wasnt me

Share this post


Link to post
Share on other sites

Ideally the font file will just contain single characters, collected using an add-on app that builds a font database for the main OCR to use, then some sort of best fit check to assign each character.

Share this post


Link to post
Share on other sites

#10 ·  Posted (edited)

Im not sure why the first entry is skipped either, but I added

Filler @ Filler @ on the first line of the font file

I am also going to add a little bit of code to make the first pixel in each vertical line value 1 then 2,4,8 etc.. so if the ocr is scanning one pixel higher or lower than the font file, characters will still be recognised.

Does this mean you got it to work somewhat? I was worried it all looked a bit over whelming to someone who wasnt me

It took me a second to read through it all and understand it, but I got there (and that's saying a lot because half the time I cant even read my own script :-p). I was playing around with it using it on the SciTE editor and results were fairly good. The only problems I had were the first entry being skipped (which I fixed by putting @@@@ on the first line) and if there were too many glued letters, it started returning the code for the letters (I tried doing "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG" and it returned a real mess). I'm also trying to figure out how to make it see spaces...

Edited by blackmage999

Share this post


Link to post
Share on other sites

I beleive I have created the first OCR using JUST autoit script and UDF's.

I have made a OCR for the game Runescape without external dependencies. It was somewhat hard to do considering they are trying to countermeasure OCR techniques. Here is my now broken post showing the code:

Eventually I ran into speed issues and created this UDF:

Eventually, I still ran into speed issues and ported the project to C#. I don't think you can create a working OCR that is both reliable (enough) and fast (enough) in just AutoIt.

Share this post


Link to post
Share on other sites

Hello !

Thanks for sharing your work. Can you explain how to use the _OCR() function ? I don't understand the last parameters

Share this post


Link to post
Share on other sites

It took me a second to read through it all and understand it, but I got there (and that's saying a lot because half the time I cant even read my own script :-p). I was playing around with it using it on the SciTE editor and results were fairly good. The only problems I had were the first entry being skipped (which I fixed by putting @@@@ on the first line) and if there were too many glued letters, it started returning the code for the letters (I tried doing "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG" and it returned a real mess). I'm also trying to figure out how to make it see spaces...

Spaces are hard, I would think adding a bit of code that removes two or three vertical lines would be fine, any bigger vertical lines would then be classed as spaces. To be honest the use I have for it, does not require the identification of spaces, so I guess I neglected it somewhat. I am currently working on a fix for glued letters, should have something by the end of the week, the next thing would be giving the script some sort of logic, if you look at the profile of say a capital T, its usually similar regardless of the font, size and/or boldness.

Share this post


Link to post
Share on other sites

Hello !

Thanks for sharing your work. Can you explain how to use the _OCR() function ? I don't understand the last parameters

All the details are in my first posts, this is still work in progress so until its finished its just a concept.

Share this post


Link to post
Share on other sites

#15 ·  Posted (edited)

Hello !

Thanks for sharing your work. Can you explain how to use the _OCR() function ? I don't understand the last parameters

I assume you're talking about the "$ocrlearn". While testing the UDF, I put $ocrlearn = "" as a quick work around. It dosn't look like its used for anything at the moment. I think its either something hes planing or something he took out. Looks like $glue1 = "" through $glue6 = "" don't get called either.

This is what I was using for testing purposes

#include <OCR.au3>
$ocrlearn = ""

; A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
$data = _OCR(209,263,593,278,0,15791353,@DesktopDir & "\font.txt",$ocrlearn) ; the cords make a box around the letters

MsgBox(0, "", $data)

Spaces are hard, I would think adding a bit of code that removes two or three vertical lines would be fine, any bigger vertical lines would then be classed as spaces. To be honest the use I have for it, does not require the identification of spaces, so I guess I neglected it somewhat. I am currently working on a fix for glued letters, should have something by the end of the week, the next thing would be giving the script some sort of logic, if you look at the profile of say a capital T, its usually similar regardless of the font, size and/or boldness.

I think the number of lines required before it sees a space should be dependent on the height of the search area. I'll try to work on this some time this week, maybe try to reverse engineer it and post my results. I might think of something new or I could just fail horribly :-p Edited by blackmage999

Share this post


Link to post
Share on other sites

I assume you're talking about the "$ocrlearn". While testing the UDF, I put $ocrlearn = "" as a quick work around. It dosn't look like its used for anything at the moment. I think its either something hes planing or something he took out. Looks like the $val = "" and $glue1 = "" through $glue6 = "" don't get called either.

This is what I was using for testing purposes

#include <OCR.au3>
$ocrlearn = ""

; A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
$data = _OCR(209,263,593,278,0,15791353,@DesktopDir & "\font.txt",$ocrlearn) ; the cords make a box around the letters

MsgBox(0, "", $data)

I think the number of lines required before it sees a space should be dependent on the height of the search area. I'll try to work on this some time this week, maybe try to reverse engineer it and post my results. I might think of something new or I could just fail horribly :-p

$ocrlearn was going to be a 0/1 trigger for the msgbox to pop up when it encountered a pattern a didnt know, so 1 would mean the box would pop up, and 0 meant it would skip the character and just return ? instead

I am working a slim down version already, and should have something tonight, I am kind of working an GUI that will allow you to teach the font before you use the function. I think I have also figured out a glue fix too.

Share this post


Link to post
Share on other sites

#17 ·  Posted (edited)

This is an significant update and error correction to the original script allowing improved screenOCR, and includes a function to auto-generate font databases using Word. See the comments at the top of the code for more info (and the problems etc).

It's a lot slower than I'd like, but for defined small areas of text (eg controls etc) is more than adequate.

Average is about 10msec per 5x10pixel character

It's also much more accurate than Tesseract or MODI based OCR for screen text.

Here's hoping someone can optimise it better than I can.

David

; Optical Character Recognition system for screen text under Autoit
; Original by civilcalc, 04 July 2011 [from http://www.autoitscript.com/forum/topic/130046-autoit-ocr-without-3rd-party-software/]
; Updated and errors corrected by David Mckenzie 30 Sept 2012
;    also added _learnCharsWithWord to somewhat automate learning fonts

;Notes:-
; $ocrLearn allows a character to be automatically associated with the first recognised character in a block of text
; if you want to operate in batch mode (and ignore any unknown characters), set $ocrLearn = -1
; if $ocrLearn is not set, then an input box will be displayed requesting the value of any unknown characters
; Opt("PixelCoordMode",$param) determines what relative coordinates are referenced (used by PixelSearch)


;The basic concept is as follows;
;Pick a line of text to be scanned, the tighter the area, the better it performs.
; The bounding box is then shrunk to exclude any whitespace at the edges.
;If the entire row of lowermost pixels is active, then it is assumed the line has an underline
; this row will therefore be ignored.
;An array is then created with the same number of elements as the width of the selection, and
; filled with a binary representation of each column
;Pixelsearch is used to check each pixel in the first vertical line.
;If a pixel is not of the background colour (specified as $bkgndColour and variation by $bkgndShadeVariation)
; then it is assigned a value: the uppermost pixel is considered to be worth 1, the next pixel 2, then 4, 8, 16 etc.
;Once each column is summed the next is checked.
;After the summation process any whitespace above each individual character is removed, so it can still
; be recognised if it's together with characters taller or shorter than it.
;so the character;
;pre   &    post removal of blank rows above
;01  ~~~~~
;02  ~###~  01
;04  ~#~#~  02
;08  ~###~  04
;16  ~#~#~  08
;32  ~#~#~  16
;64  ~~~~~  32
;would produce an array of 31|5|31
;
;the array is checked from the file $font, if it already exists, it returns the character A or it asks for a definition and saves the result.
;the database format is one line for each character/block with the saved letter/s preceding the @
;n@ 127|2|1|1|126 @

; Problems:
; It's quite slow -
; Average is about 10msec per 5x10pixel character
; However to compensate for this it's much more accurate than Tesseract or MODI based OCR for screen text.
; The script can only recognise one line of text at a time. You will have to iterate through the text you wish to recognise one line/row at a time.
; Characters must be divided from each other by a column of whitespace. If they are not, they will have to be learnt as pairs/triples, etc.
;   Kerned fonts can thus be a bit of a nuisance (eg {f} and {t} will often have to be learnt as a block with another character
;     The script includes code which scans unrecognised blocks to see if they're made up of previously learnt characters and assumes a split
;      however this can mean some characters are recognised as components of others (eg the first half of w might be recognised as v)
;   Italic fonts are also not feasible to learn with the script as it is
;     A possible fix for this would be to find a tall straight letter such as |, I, l, D or B and use this to calculate the row offset (relative to base row) and compensate for this when using PixelSearch to build the array, or alternatively (but probably with more errors) just use a standard slant angle and calculate pixel corrections based on this.
; Single characters with a blank vertical line internally will be seen as two characters (eg quote {"})
; Spaces aren't always recognised correctly - depending on the size of the gap between characters.
; Underline isn't handled robustly, and some characters (eg _ or -) may be seen as if they are underlined if they are recognised alone, and are more than one pixel row thick
; Characters with the same shape, but different vertical positioning will be confused (eg {'} and {,} in some fonts

#include-once
#Include <Array.au3>        ; needed for array management in _OCR function
#include <Misc.au3>            ; needed for mousepress trapping in mouseOCR function

$blackPix = 0x000000
$whitePix = 0xFFFFFF

;edit the x and y bounds to reflect where word draws it's characters on your system
;_learnCharsWithWord(275,300,310,340)
func _learnCharsWithWord ($left=275,$top=300,$right=310,$bottom=340,$bkgndColour=0xFFFFFF,$bkgndShadeVariation=100,$fontFile="")
    if $fontFile = "" then $fontFile = @ScriptDir & "OCRFontData.txt"
    if StringInStr($fontFile, "") = 0 then $fontFile = @ScriptDir & "" & $fontFile
    Local $fontArr[4]
    $fontArr[0] = "Tahoma"
    $fontArr[1] = "Times New Roman"
    $fontArr[2] = "Arial"
    $fontArr[3] = "Calibri"
    ; Open Word
    $objWord = ObjCreate("Word.Application")
    $objWord.Documents.Add
    $objWord.Visible = True
    $objWord.ActiveDocument.ShowGrammaticalErrors = False
    $objWord.ActiveDocument.ShowSpellingErrors = False
    $objWord.Selection.HomeKey (6)    ; wdStory = 6
    for $fontArrIter = 0 to UBound($fontArr)-1
        for $fontSize = 10 to 12
            FileWriteLine($fontFile,"@*** " & $fontArr[$fontArrIter] & " " & $fontSize & "pt ***@")
            ; Now iterate through all printable character (skipping chr(32)={space})
            for $iter = 33 to 126
                ; Use the clipboard rather than directly typing so Word doesn't autocorrect lowercase to caps
                ClipPut (chr($iter) & @CRLF & @CRLF & @CRLF & @CRLF)
                $objWord.Selection.Font.Name = $fontArr[$fontArrIter]
                $objWord.Selection.Font.Size = $fontSize
                $objWord.Selection.Paste
;                $objWord.Selection.Paste.TypeText chr($iter) & "          "
;                sleep(100)    ;just to ensure word has time to draw the characters correctly
                _OCR($left,$top,$right,$bottom,$bkgndColour,$bkgndShadeVariation,$fontFile, chr($iter))
                $objWord.Selection.HomeKey (6,1)     ;wdLine = 5, wdExtend=1
                $objWord.Selection.Delete
            Next
        Next
    Next
    $objWord.Quit (False)        ; Get rid of Word (don't save)
EndFunc

func mouseOCR()
    Local $hDLL = DllOpen("user32.dll")
    const $LMB = "01"    ; Left mouse button
    const $RMB = "02"     ; Right mouse button
    const $MMB = "04"     ; Middle mouse button (three-button mouse)

    $dragDone = false
    While $dragDone = false
        If _IsPressed($LMB, $hDLL) Then
            $xStart = MouseGetPos(0)
            $yStart = MouseGetPos(1)

            while _IsPressed($LMB, $hDLL)
            WEnd

            $xEnd = MouseGetPos(0)
            $yEnd = MouseGetPos(1)
            $dragDone = True
        EndIf
    WEnd
    MouseClick("left",$xEnd,$yEnd)    ; This to get rid of any highlights/selection of text from the drag operation
    $OCRString = _OCR($xStart,$yStart,$xEnd,$yEnd)
    ConsoleWrite ($OCRString)
    DllClose($hDLL)
    Return $OCRString
EndFunc

Func _OCR($left,$top,$right,$bottom,$bkgndColour=0xFFFFFF,$bkgndShadeVariation=100,$fontFile="",$ocrLearn="")
    const $spaceMult = 1.5        ; not sure what the average size of space is compared to gap between characters

    $startTime = TimerInit()
    if $fontFile = "" then $fontFile = @ScriptDir & "OCRFontData.txt"
    if StringInStr($fontFile, "") = 0 then $fontFile = @ScriptDir & "" & $fontFile
    if not FileExists ($fontFile) Then
        FileWriteLine($fontFile,"@**************************************@")
        FileWriteLine($fontFile,"@****** AutoIt OCR Font Data **********@")
        FileWriteLine($fontFile,"@**************************************@")
        FileWriteLine($fontFile," @ space @")
    EndIf


;    ConsoleWrite ("Starting OCR..." & @CRLF)
    ;find the left row with coloured pixels
    For $x = $left to $right
        For $y = $top to $bottom
            ;scan each vertical line in the scan area looking for pixels different to the background colour
            PixelSearch($x,$y,$x,$y,$bkgndColour,$bkgndShadeVariation)
            If @error = 1 Then        ; colour is found
                $left = $x
                ExitLoop 2
            EndIf
        Next
    Next


    ;find the right row with coloured pixels
    For $x = $right to $left - 1 step - 1
        For $y = $top to $bottom
            ;scan each vertical line in the scan area looking for pixels different to the background colour
            PixelSearch($x,$y,$x,$y,$bkgndColour,$bkgndShadeVariation)
            If @error = 1 Then
                $right = $x
                ExitLoop 2
            EndIf
        Next
    Next
    if $x < $left then
        ; There were no non-background pixels found in the selection, so return
        ; Beep()
        ConsoleWriteError ("No foreground pixels found. Exiting...")
        Return 0        ; the encompased area is empty
    endIf

    ;find the top row with coloured pixels
    For $y = $top to $bottom
        For $x = $left to $right
            ;scan each vertical line in the scan area looking for pixels different to the background colour
            PixelSearch($x,$y,$x,$y,$bkgndColour,$bkgndShadeVariation)
            If @error = 1 Then
                $top = $y
                ExitLoop 2
            EndIf
        Next
    Next

    ;find the bottom row with coloured pixels
    For $y = $bottom to $top step - 1
        For $x = $left to $right
            ;scan each line in the scan area looking for pixels different to the background colour
            PixelSearch($x,$y,$x,$y,$bkgndColour,$bkgndShadeVariation)
            If @error = 1 Then
                $bottom = $y
                ExitLoop 2
            EndIf
        Next
    Next

    ;check whether the bottom row is an underline
    If $top = $bottom Then
        ; only one row, so assume it's not an underline
        $hasUnderline = False
    Else
        $hasUnderline = True
        For $x = $left to $right
            PixelSearch($x,$y,$x,$y,$bkgndColour,$bkgndShadeVariation)
            If not @error = 1 Then
                $hasUnderline = False
                ExitLoop
            EndIf
        Next
    EndIf

    ;create an array which contains the sum of the pixels in each column for the scan area
    local $array[$right-$left+1]
    ;arr = 'counter'
;    $arr = 0    ; registers the current column (same as )
    For $x = $left to $right
        $val = 0 ;reset the value to zero for next vertical line
        $p =1
        For $y = $top to $bottom
            If $hasUnderline and $y = $bottom Then ExitLoop
            ;scan each vertical line in the scan area looking for pixels different to the background colour
            PixelSearch($x,$y,$x,$y,$bkgndColour,$bkgndShadeVariation)
            If @error = 1 Then $val = $val + $p ;create a value of the vertical line based on the pixels present
            $p = $p*2
        Next
        $array[$x - $left] = $val ;load the value into the array
;        $arr = $arr+1 ;increase the counter
    Next


    ;now delete any blank rows above the letter (effectively shrink the bounding box down to the top of the character)
    ; do this by dividing all the values in the character array by the lowest numbered pixel of any column for that character
    $minVal = 999999999
    $charStartPos = 0
    $charEndPos = 0
    $newBlank = True        ; The blank variables are used for figuring out the size of spaces in the block
    $blankBlockCount = 0
    $blankColCnt = 0
    For $a = 1 to UBound($array)-1
        ; First go through the array and find the lowest numbered pixel in the current character. Assume each character ends with a blank column
        If $array[$a] > 0 then        ; if the current value is greater than 0 then we haven't got to the end of the character
            ; find the lowest bit set to 1 for the current column, and if it's lower than previous set minVal to that bit
            for $i = 0 to 20
                $bitAnd = BitAND($array[$a],2^$i)
                If $bitAnd > 0 Then
                    if $minVal > $bitAnd then $minVal = $bitAnd
                    ExitLoop
                EndIf
            Next
            $newBlank = True
        Else
            ; create a running total of blanks - average size will be used for guessing the size of spaces in the text
            if $newBlank Then $blankBlockCount = $blankBlockCount + 1
            $blankColCnt = $blankColCnt + 1
            $newBlank = False
        EndIf
        ; If the current column is blank, or is the last column in the array, we must be at the end of the character, so
        ;  bitshift each column in the character by the appropriate amount to eliminate blank rows above it.
        If $array[$a] = 0 Or $a = UBound($array)-1 Then
            $charEndPos = $a - 1
            if $a = UBound($array)-1 then $charEndPos = $a    ; if we're at the end, then need to include the last column
            for $i = $charStartPos to $charEndPos
                $array[$i] = int($array[$i]/$minVal)
            Next
            $minVal = 999999999
            $charStartPos = $charEndPos + 2
            $charEndPos = 0
        EndIf
    Next
    $string = _ArrayToString($array)        ; NB the default delimiter separating each number in the array is "|"

    ; deal with space between characters - assume than more than the average number of columns together are spaces, and give such an artificial value
    $avBlankWidth = ($blankColCnt / $blankBlockCount) * $spaceMult
    ConsoleWrite (@CRLF & $avBlankWidth & @CRLF)
    $spaceSize = ""
    for $a = 0 to $avBlankWidth
        $spaceSize = $spaceSize & "|0"
    Next
    ConsoleWrite (@CRLF & $spaceSize & @CRLF)
    $string = StringReplace($string,$spaceSize,"|0|space|0")
    ConsoleWrite (@CRLF & $string & @CRLF)

    ; ensure there is only one blank column dividing letters, and no blanks at the ends:-
    $curLen = 0
    while $curLen <> stringlen($string)
        $curLen = stringlen($string)
        $string = StringReplace($string,"|0|0|","|0|")
        if StringLeft($string,2) = "0|" then $string = StringMid($string,3)
        if StringRight($string,2) = "|0" then $string = StringLeft($string,StringLen($string)-2)
        $string = StringReplace($string,"||","|")
    WEnd

    ;split string at blank verticals to create an array which contains one character in each member
    $string = StringSplit($string,"|0|",1)
    $database = FileRead($fontFile) ;read database
    $data = ""


    ; now step through each letter to identify it - (one letter is contained in each member of the $string array)
    For $a = 1 to UBound($string)-1
        $pos = StringInStr($database,"@ "&$string[$a]&" @")

        If $pos Then
            ;value already exists in database so read in its corresponding character/s.
            $pos2 = StringInStr($database,"@",0,-1,$pos-1)        ; first get the position of the preceeding '@'
            if $pos2 < 1 then $pos2 = 1    ; nee
            $data = $data & StringMid($database,$pos2,($pos-$pos2))    ; then read in the letter it represents
        ElseIf $ocrLearn <> "" and $ocrLearn <> -1 Then
            ; being trained on single characters, so write to the database file then return
            FileWriteLine($fontFile,$ocrLearn & "@ " & $string[$a] & " @")
            Return
        Else

            $unrecogBlock = $string[$a]

            ;check whether it's made up of a group of previously recognised characters
            $minVal = 999999999
            $charStartPos = 0
            $pos = 0
            $charBlock = StringSplit($string[$a],"|",2)        ; flag 2 = don't use the first element to record the size of the array
            $arrUbound = ubound($charBlock) - 1
            $dataTemp = ""

            ; only check
;            if $arrUbound > 2 Then
                ; iterate through all the columns in the block to try and find recognised characters.
                ; if one is found then add that to the recognised characters and try and recognise more
                ; Block characters must be minimum of 3 columns (0,1,2) (else "," matches lots of things)
                for $charEndPos = 0 to $arrUbound
                    $shiftedString = ""

    ;                $shiftedArr = bitShiftArr($arrToShift,$amountToShift,$startMemb, $endMemb)
                    ; find the lowest bit set to 1 for the current column (=array member), and if it's lower than previous set minVal to that bit
                    $bitMinVal = bitMin($charBlock[$charEndPos])
                    If $minVal > $bitMinVal then $minVal = $bitMinVal

                    ; iterate through each column in the current block and bitShift it to eliminate whitespace above the block
                    for $i = $charStartPos to $charEndPos
                        $shiftedString = $shiftedString & "|" & $charBlock[$i]/(2^$minVal)
                    Next

                    $shiftedString = StringMid($shiftedString, 2)        ; get rid of the leading "|"

                    ; only check character blocks if they're 3 or more columns (to reduce errors from incorrect matches)
                    if $charEndPos > $charStartPos + 1 Then
                        $pos = StringInStr($database,"@ "& $shiftedString &" @")
                        If $pos Then
                            ;value already exists in database so read in its corresponding character/s.
                            $pos2 = StringInStr($database,"@",0,-1,$pos-1)        ; first get the position of the preceeding '@'
                            if $pos2 < 1 then $pos2 = 1    ; nee
                            $dataTemp = $dataTemp & StringMid($database,$pos2,($pos-$pos2))    ; then read in the letter it represents

                            $minVal = 999999999
                            $charStartPos = $charEndPos + 1    ; $charEndPos will be incremented by one at the end of the loop
                            if $charStartPos <= $arrUbound then
                                if $charEndPos >= $arrUbound then $charEndPos = $arrUbound -1
                            Else
                                $data = $data & $dataTemp
                            EndIf

                        EndIf
                    EndIf
                Next
;            EndIf

            ; It couldn't completely split the block either, so if not in batch mode ask the user for input
            If $charStartPos <= $arrUbound And $ocrLearn <> -1 then
                ;no character recognised in database, so create an image and ask for an input
                If $charStartPos > 0 Then
                    ; fix during daylight...
                    $map = StringSplit(_ArrayToString($charBlock, "|" , $charStartPos ),"|")
                Else
                    $map = StringSplit($string[$a],"|")
                EndIf

                Local $leftine[$bottom-$top+2]
                For $i = 0 to ($bottom-$top+1)
                    $leftine[$i] = ""
                    For $ml = 1 to $map[0]
                        If StringIsInt($map[$ml]/2) = 1 Then
                            $leftine[$i] = $leftine[$i]&"~"
                        Else
                            $leftine[$i] = $leftine[$i]&"#"
                        EndIf
                        $map[$ml] = Int($map[$ml]/2)
                    Next
                Next
                $image = ""
                For $i = 0 to ($bottom-$top+1)
                    $image = $image&$leftine[$i]&@CRLF
                Next
                If StringInStr($image,"#") Then
                    ;Beep()
                    $data = dataClean($data)
                    $dataTemp = dataClean($dataTemp)
                    $dataTemp2 = $data
                    if stringLen($dataTemp)>0 then $dataTemp2 = $data & "_" & $dataTemp & "_"
                    $dataTemp2 = dataClean($dataTemp2)
                    $letter = InputBox("Unknown Character","Identify this pattern following" & @cr & "(or just OK to skip identifying it):-" & @cr & $dataTemp2 & @cr & @cr & $image & @cr & @cr & "If you disagree with the guess" & @cr & "(between _s) then type" & @cr & "'@' followed by the correct" & @cr & "character/s","","",200,500,@DesktopWidth-200,@DesktopHeight-500)
                    If $letter <> "" Then
                        If StringLeft($letter,1) = "@" and StringLen($letter) > 1 Then
                            ;The guess was incorrect
                            $dataTemp = ""
                            $letter = StringMid($letter,2)
                            $pattern = $string[$a]
                        Else
                            ;The guess split letters correctly, so just write the remainder to the database
                            $pattern = _ArrayToString($charBlock, "|" , $charStartPos )
                        EndIf
                        ; write to the database file, and update the version held in memory, as well as the data string
                        FileWriteLine($fontFile,$letter & "@ " & $pattern & " @")
                        $database = $database & $letter & "@ " & $pattern & " @" & @CRLF
                        $data = $data & $dataTemp & $letter
                    ElseIf @error = 1 Then        ;The Cancel button was pushed.
                        FileWriteLine($fontFile,"err@! " & $unrecogBlock & " !@")
                        SetError (-2)
                        Return
                    Else
                        FileWriteLine($fontFile,"err@! " & $unrecogBlock & " !@")
                    EndIf
                EndIf
            EndIf
        EndIf
    Next
    $data = dataClean($data)
    ConsoleWrite("Recognised " & stringlen($data) & " characters in " & TimerDiff($startTime) & "msec" & @CRLF)
    ConsoleWrite("Average  " & TimerDiff($startTime)/stringlen($data) & "msec per " & ($right - $left)/stringlen($data) & " x " & $bottom - $top & " pixel character" & @CRLF)
    Return $data
EndFunc


Func dataClean($toClean)
    ; Do a search and replace every iteration so $toClean is up to date (and can be used in the inputbox)
    $toClean = StringReplace($toClean,"@","")
    $toClean = StringReplace($toClean,@crlf,"")
    $toClean = StringReplace($toClean,@cr,"")
    $toClean = StringReplace($toClean,@lf,"")
    Return $toClean
EndFunc

Func bitMin($numToCheck)
    ; returns the location of the lowest bit set
    for $i = 0 to 20
        If BitAND($numToCheck,BitShift(1,-$i)) > 0 Then
            Return $i
        EndIf
    Next
    Return -1
EndFunc
Edited by dgm5555

Share this post


Link to post
Share on other sites

#18 ·  Posted (edited)

Hej There every one. I started using auto it 2 days ago for a outmation program that needed OCR and i whant to thank dgm 5555 for adding this brilliant program, 3 days before i found it.

it works like a charm for sigle charector regonition. but i needed to read a full line with your program didnt support.

so now im sharing my solution to that problem, i hope that you will like and accept this expansion :)

; Optical Character Recognition system for screen text under Autoit
; Original by civilcalc, 04 July 2011 [from http://www.autoitscript.com/forum/topic/130046-autoit-ocr-without-3rd-party-software/]
; Updated and errors corrected by David Mckenzie 1 Oct 2012
; also added _learnCharsWithWord to somewhat automate learning fonts
; Modified to support LineRead by Sebastian Hvenegaard   4 Oct 2012

;Notes:-
; $ocrLearn allows a character to be automatically associated with the first recognised character in a block of text
; if you want to operate in batch mode (and ignore any unknown characters), set $ocrLearn = -1
; if $ocrLearn is not set, then an input box will be displayed requesting the value of any unknown characters
;The basic concept is as follows;
;Pick a line of text to be scanned, the tighter the area, the better it performs.
; The bounding box is then shrunk to exclude any whitespace at the edges.
;If the entire row of lowermost pixels is active, then it is assumed the line has an underline
; this row will therefore be ignored.
;An array is then created with the same number of elements as the width of the selection, and
; filled with a binary representation of each column
;Pixelsearch is used to check each pixel in the first vertical line.
;If a pixel is not of the background colour (specified as $bkgndColour and variation by $bkgndShadeVariation)
; then it is assigned a value: the uppermost pixel is considered to be worth 1, the next pixel 2, then 4, 8, 16 etc.
;Once each column is summed the next is checked.
;After the summation process any whitespace above each individual character is removed, so it can still
; be recognised if it's together with characters taller or shorter than it.
;so the character;
;pre post whitespace removal
;01~~~~~
;02~###~01
;04~#~#~02
;08~###~04
;16~#~#~08
;32~#~#~16
;64~~~~~32
;would produce an array of 0|31|5|31|0
;
;the array is checked from the file $font, if it already exists, it returns the character A or it asks for a definition and saves the result.
;I am currently having issues where letters are 'glued' together by not having a clear vertical pixel between them, like "TA" where the top of the T is on the next line to the bottom of the A, each character is visible in the array, but I can't seem to get the script to 'see' the T then remove the T part of the array and check the remainder (A)
;It can scan an area of around 100x20 pixels in 0.1 seconds, and I use it mostly when a control is not a traditional type control. It can scan an entire screen in about 3 seconds. It can be taught a whole new font in less than 30 minutes.
; Opt("PixelCoordMode",$param) determines what relative coordinates are referenced (via pixelSearch)
; Problems:
; The script can only recognise one line of text at a time. Multiple lines will mess things up badly, so you will have to iterate through the text you wish to recognise one line/row at a time.; The code can only recognise one line of text at a time, so you will have to iterate through each line yourself
; Characters must be divided from each other by a column of whitespace. If they are not, they will have to be
; learnt as pairs/triples, etc. This means kerned fonts can be a bit of a nuisance, and italic fonts are not feasible to learn.
; Single characters with a blank vertical line internally will be seen as two characters (eg quote {"}) depending on the font)
; underline isn't handled robustly, and some characters (eg _ or -) may be seen as if they are underlined if they are more than one row thick
; characters with the same shape, but different vertical orientation will be confused (eg {'} and {,} in some fonts
#include-once
#Include <Array.au3>
$blackPix = 0x000000
$whitePix = 0xFFFFFF
;edit the x and y bounds to reflect where word draws it's characters on your system
;_learnCharsWithWord(275,300,310,340)
func _learnCharsWithWord ($left=275,$top=300,$right=310,$bottom=340,$bkgndColour=0xFFFFFF,$bkgndShadeVariation=100,$fontFile="")
if $fontFile = "" then $fontFile = @ScriptDir & "OCRFontData.txt"
if StringInStr($fontFile, "") = 0 then $fontFile = @ScriptDir & "" & $fontFile
Local $fontArr[4]
$fontArr[0] = "Tahoma"
$fontArr[1] = "Times New Roman"
$fontArr[2] = "Arial"
$fontArr[3] = "Calibri"
; Open Word
$objWord = ObjCreate("Word.Application")
$objWord.Documents.Add
$objWord.Visible = True
$objWord.ActiveDocument.ShowGrammaticalErrors = False
$objWord.ActiveDocument.ShowSpellingErrors = False
$objWord.Selection.HomeKey (6) ; wdStory = 6
for $fontArrIter = 0 to UBound($fontArr)-1
for $fontSize = 10 to 15
FileWriteLine($fontFile,"@*** " & $fontArr[$fontArrIter] & " " & $fontSize & "pt ***@")
; Now iterate through all printable character (skipping chr(32)={space})
for $iter = 33 to 126
; Use the clipboard rather than directly typing so Word doesn't autocorrect lowercase to caps
ClipPut (chr($iter) & @CRLF & @CRLF & @CRLF & @CRLF)
$objWord.Selection.Font.Name = $fontArr[$fontArrIter]
$objWord.Selection.Font.Size = $fontSize
$objWord.Selection.Paste
; $objWord.Selection.Paste.TypeText chr($iter) & "       "
; sleep(100) ;just to ensure word has time to draw the characters correctly
_OCR_SingleCharacter($left,$top,$right,$bottom,$bkgndColour,$bkgndShadeVariation,$fontFile, chr($iter))
$objWord.Selection.HomeKey (6,1) ;wdLine = 5, wdExtend=1
$objWord.Selection.Delete
Next
Next
Next
$objWord.Quit (False) ; Get rid of Word (don't save)
EndFunc

; added a read line function with space support. :)
Func _OCR_ReadLine($left,$top,$right,$bottom,$bkgndColour=0xFFFFFF,$bkgndShadeVariation=100,$fontFile="",$FontWidth=12,$FontHigth=21)
;$FontWidth=12,$FontHigth=18 standard iai font size.
; devide the block to segments that can be used in the_OCR_SingleCharacter
$data = ""
For $x = $left to $right
$blockrigth = $left + $FontWidth
;MsgBox(0,"MSGBOX",$blockrigth)
if $blockrigth < $right then
$char = _OCR_SingleCharacter($left,$top,$blockrigth,$bottom,$bkgndColour,$bkgndShadeVariation,$fontFile,0)
if $char == 0 then
$char = " "
endif
$data = $data & $char
; debug messege box
;MsgBox(0,"MSGBOX","char: " & $char & " Data:" & $data & " Left: " & $left & " Rigth: " & $blockrigth & " Total: " & $right & " Font Size: "& $FontWidth & " x " & $FontHigth )
$left = $blockrigth
endif
if $left = $right then ExitLoop
next
Return $data
EndFunc
Func _OCR_SingleCharacter($left,$top,$right,$bottom,$bkgndColour=0xFFFFFF,$bkgndShadeVariation=100,$fontFile="",$ocrLearn="")
if $fontFile = "" then $fontFile = @ScriptDir & "OCRFontData.txt"
if StringInStr($fontFile, "") = 0 then $fontFile = @ScriptDir & "" & $fontFile
;find the left row with coloured pixels
For $x = $left to $right
For $y = $top to $bottom
;scan each vertical line in the scan area looking for pixels different to the background colour
PixelSearch($x,$y,$x,$y,$bkgndColour,$bkgndShadeVariation)
If @error = 1 Then ; colour is found
$left = $x
ExitLoop 2
EndIf
Next
Next
;find the right row with coloured pixels
For $x = $right to $left - 1 step - 1
For $y = $top to $bottom
;scan each vertical line in the scan area looking for pixels different to the background colour
PixelSearch($x,$y,$x,$y,$bkgndColour,$bkgndShadeVariation)
If @error = 1 Then
$right = $x
ExitLoop 2
EndIf
Next
Next
if $x < $left then
; There were no non-background pixels found in the selection, so return
; Beep()
Return 0 ; the encompased area is empty
endIf
;find the top row with coloured pixels
For $y = $top to $bottom
For $x = $left to $right
;scan each vertical line in the scan area looking for pixels different to the background colour
PixelSearch($x,$y,$x,$y,$bkgndColour,$bkgndShadeVariation)
If @error = 1 Then
$top = $y
ExitLoop 2
EndIf
Next
Next
;find the bottom row with coloured pixels
For $y = $bottom to $top step - 1
For $x = $left to $right
;scan each line in the scan area looking for pixels different to the background colour
PixelSearch($x,$y,$x,$y,$bkgndColour,$bkgndShadeVariation)
If @error = 1 Then
$bottom = $y
ExitLoop 2
EndIf
Next
Next
;check whether the bottom row is an underline
If $top = $bottom Then
; only one row, so assume it's not an underline
$hasUnderline = False
Else
$hasUnderline = True
For $x = $left to $right
PixelSearch($x,$y,$x,$y,$bkgndColour,$bkgndShadeVariation)
If not @error = 1 Then
$hasUnderline = False
ExitLoop
EndIf
Next
EndIf
;create an array which contains the sum of the pixels in each column for the scan area
local $array[$right-$left+1]
;arr = 'counter'
; $arr = 0 ; registers the current column (same as )
For $x = $left to $right
$val = 0 ;reset the value to zero for next vertical line
$p =1
For $y = $top to $bottom
If $hasUnderline and $y = $bottom Then ExitLoop
;scan each vertical line in the scan area looking for pixels different to the background colour
PixelSearch($x,$y,$x,$y,$bkgndColour,$bkgndShadeVariation)
If @error = 1 Then $val = $val + $p ;create a value of the vertical line based on the pixels present
$p = $p*2
Next
$array[$x - $left] = $val ;load the value into the array
;    $arr = $arr+1 ;increase the counter
Next
;now delete any blank rows above the letter (effectively shrink the bounding box down to the top of the character)
; do this by dividing all the values in the character array by the minimum value of any column for that character
$minVal = 999999999
$charStartPos = 0
$charEndPos = 0
For $a = 1 to UBound($array)-1
If $array[$a] > 0 then ; if the current value is greater than 0 then we haven't got to the end of the character
for $i = 0 to 20
; find the lowest bit set to 1
$bitAnd = BitAND($array[$a],2^$i)
If $bitAnd > 0 Then
     if $minVal > $bitAnd then $minVal = $bitAnd
     ExitLoop
EndIf
Next
Else
$charEndPos = $a - 1
for $i = $charStartPos to $charEndPos
$array[$i] = int($array[$i]/$minVal)
Next
$minVal = 999999999
$charStartPos = $charEndPos + 2
$charEndPos = 0
EndIf
Next
$string = _ArrayToString($array) ; NB the default delimiter separating each number in the array is "|"
; deal with special case (space between characters)
; assume than more than two blank columns together are spaces, and give it an artificial value
$string = StringReplace($string,"|0|0|0|0|","|0|134217727|0|")
; ensure there is only one blank column dividing letters:-
$curLen = 0
while $curLen <> stringlen($string)
$curLen = stringlen($string)
$string = StringReplace($string,"|0|0|","|0|")
WEnd
;split string at blank verticals to create an array which contains one character in each member
$string = StringSplit($string,"|0|",1)
$database = FileRead($fontFile) ;read database
$data = ""
; now step through each letter to identify it
; (one letter is contained in each member of the $string array)
For $a = 1 to UBound($string)-1
$pos = StringInStr($database,"@ "&$string[$a]&" @")
If $pos Then
;value already exists in database so read in its corresponding character/s.
$pos2 = StringInStr($database,"@",0,-1,$pos-1) ; first get the position of the preceeding '@'
if $pos2 < 1 then $pos2 = 1 ; nee
$data = $data & StringMid($database,$pos2,($pos-$pos2)) ; then read in the letter it represents
; Do a search and replace every iteration so $data is up to date (and can be used in the inputbox)
$data = StringReplace($data,"@","")
$data = StringReplace($data,@crlf,"")
$data = StringReplace($data,@cr,"")
$data = StringReplace($data,@lf,"")
ElseIf $ocrLearn <> "" Then
If $ocrLearn <> -1 Then
     ; write to the database file then return
     FileWriteLine($fontFile,$ocrLearn & "@ " & $string[$a] & " @")
     Return
EndIf
Else
;no character recognised in database, so create an image and ask for an input
$map = StringSplit($string[$a],"|")
$pattern = $string[$a]
Local $leftine[$bottom-$top+2]
For $i = 0 to ($bottom-$top+1)
     $leftine[$i] = ""
     For $ml = 1 to $map[0]
     If StringIsInt($map[$ml]/2) = 1 Then
     $leftine[$i] = $leftine[$i]&"~"
     Else
     $leftine[$i] = $leftine[$i]&"#"
     EndIf
     $map[$ml] = Int($map[$ml]/2)
     Next
Next
$image = ""
For $i = 0 to ($bottom-$top+1)
     $image = $image&$leftine[$i]&@CRLF
Next
If StringInStr($image,"#") Then
     ;Beep()
     $letter = InputBox("Unknown Character","Identify this pattern following:-" & @cr & $data & @cr &@cr & $image,"","",200,500);@DesktopWidth-200,@DesktopHeight-500)
     If $letter <> "" Then
     ; write to the database file, and update the version held in memory, as well as the data string
     FileWriteLine($fontFile,$letter & "@ " & $pattern & " @")
     $database = $database & $letter & "@ " & $pattern & " @" & @CRLF
     $data = $data & $letter
     ElseIf @error = 1 Then ;The Cancel button was pushed.
     if 6 = msgbox (4,"Cancel pressed?","Do you want to exit the script?") Then Exit
EndIf
EndIf
EndIf
Next
Return $data
EndFunc

it work just like it used to but with a line read funktion that takes in the $left,$top,$right,$bottom of the full line you whant to read.

and chop it op into segments with the $Fontswidth and fed it into the single char reader.

stamp it together and return the ful line as a string and i can handle spaces though only work with fixed size font like 12x21

i do appogice for any sppelling mastakes in this post and program

LoneWolf

Edited by LoneWolf92

Share this post


Link to post
Share on other sites

#19 ·  Posted (edited)

allso i found that with the font im using this program with i got some error reading letters with a line base that got mastaken for a $Underline

so by line 179 i changed

$hasUnderline = False ;True

so that way it will newer think that there is an underline (that i dont use) and solved the problem in my case, hope it work for you guys as well :)

Edited by LoneWolf92

Share this post


Link to post
Share on other sites

Hi LoneWolf92,

Very odd...

can you give a bit more detail regarding the problem with recognising the entire line, as I can't see that your code does anything much different than is already done internally.

Could you perhaps include a screenshot of the line/s of text you're trying to recognise.

It won't recognise the line correctly if there is a varied background (eg text on a picture) - in which case you would need to modify the code to mask the background image from the array recognised. However it should recognise a plain line of text perfectly, especially if it is a fixed size font. I wonder if in fact the problem was it incorrectly thought there *wasn't* a line underneath the text, when there actually was. This would mean it considered all the characters were joined together.

I tested it again after a few minor mods, on text in your post. Trying to recognise the first line of your text by dragging over the entire line in one go with the (new) mouseOCR() function took 54 sec to train, and yielded:-

"Hej There every one. I started using auto it 2 days ago for a outmation program that needed OCR and i whant to thank"

The second line took a further 14 sec to train and yeilded:

"dgm 5555 for adding this briIIiant program, 3 days before i found it."

NB brilliant is spelt incorrectly with two capital i's, but you can't tell because the screen image is the same (at least on my version of the web page)

PS I was wondering about adding a switch to turn off the underline, but since I never envisaged manually training one character at a time, I figured the issue would virtually never arise, so didn't bother.

Curiously...

David

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!


Register a new account

Sign in

Already have an account? Sign in here.


Sign In Now