Using MODI OCR to click on text

[gdyvig]

Here is a script prototype I hope you will find useful. We have the DoOCR vbscript function that can capture text on a screen using MODI, however MODI can do much more. It contains a layout of the document including fonts regcognized, words, and word pixel coordinate positions.

First, vbscript find a word and report its location on a wordlist:

Code: Select all

VBSTART
Function DoOCRGetWordNum(bitmapfile,strTargetWord)
  Dim miDoc
  Dim miLayout
  Dim miWords
  Dim miWord
  Dim miWordText
  Dim strText
  Dim numWords
  Dim numWord
  Dim numWordFound
  on error resume next
  
  Set miDoc = CreateObject("MODI.Document")
  miDoc.Create (bitmapfile)
  miDoc.Images(0).OCR
  
  set miLayout = miDoc.Images(0).Layout
  Set miWords = miDoc.Images(0).Layout.Words
  numWords=miWords.Count
    
  numWord=0
  numWordFound=-1  
  Do  
    strWord=miWords(numWord).Text
    'Case sensitive compare
    'We can also compare on .Id, .LineID, .FontId, and .RecognitionConfidence
    if strWord=strTargetWord then
      numWordFound=numWord
      numWord=numWords
    end if
    numWord=numWord+1
  Loop While NumWord < numWords 
  
  DoOCRGetWordNum = numWordFound
  
  Set miDoc = Nothing
  Set miLayout = Nothing
  Set miWords = Nothing
  Set miWord = Nothing
  Set miWordText = Nothing
End Function
VBEND

Now find the pixel coordinates of the nth word:

Code: Select all

VBSTART
Function DoOCRGetRect(bitmapfile,numWord)
  Dim miDoc
  Dim miRects
  Dim miRect
  Dim strRectInfo
  on error resume next
  
  Set miDoc = CreateObject("MODI.Document")
  miDoc.Create (bitmapfile)
  miDoc.Images(0).OCR
  'Get numWord word
  'numWord = numWord+0
  Set miRects = miDoc.Images(0).Layout.Words(numWord).Rects
  'strRectInfo = "Word falls within " & miRects.Count & " bounding rectangle(s)." & vbCrLf
  For Each miRect In miRects
    strRectInfo = miRect.Left & "," & miRect.Top & "," & miRect.Right & "," & miRect.Bottom
  Next
  
  DoOCRGetRect = strRectInfo
  'Or you might want to calc and return the center of the rectangle
   
  Set miRect = Nothing
  Set miRects = Nothing
  Set miWord = Nothing
  Set miDoc = Nothing

End Function
VBEND

... to be continued

Gale

[gdyvig]

Now to put it all together to click on text:

Code: Select all

//Let suppose sImage contains the text "Home Products Buy Now Downloads"
Let>sImage=C:\MyScreenCapture.bmp
VBEval>DoOCRGetWordNum("%sImage%","Buy"),nWord
MDL>nWord:%nWord%
//Should return nWord=2 (word numbers start with 0)

VBEval>DoOCRGetRect("%sImage%",%nWord%),sRectCoords
MDL>sRectCoords:%sRectCoords%
//Returns left,top,right,bottom pixel coordinates of rectangle bounding the word

//If sImage is for entire screen, we can click on the word coordinates
//Otherwise we need to apply an offset based on the location of sImage
Let>COMMA=,
Separate>%sRectCoords%,%COMMA%,aRectCoords
Let>nCenterX={round((%aRectCoords_1%+%aRectCoords_3%)/2)}
Let>nCenterY={round((%aRectCoords_2%+%aRectCoords_4%)/2)}
MDL>CENTER: %nCenterX%,%nCenterY%
//Click on text
MouseMove>%nCenterX%,%nCenterY%
//Should move mouse to center of the word "Buy"
LClick
//

Gale

[Marcus Tettmar]

Thanks Gale. Very useful.

[kpassaur]

Has anyone gotten MODI to work on a multi-page tiff and / or gotten it to output the text formatted for Word. I have seen this on Code Project, which makes me believe it can be done.

http://www.codeproject.com/KB/office/mo ... ct=1161060

[kikk]

Hi,

Very nice program. I am having problems on pages with more than one word. How can I find f.ex. the 2nd word.


Best

[kpassaur]

Use a regular expression or EasyPattern (check help file for example). With it you can extract just about (not always) anything you want.

[gdyvig]

Hi Kikk and kpassaur,

On Kikk's question:

In my example "Home Products Buy Now Downloads" the word numbers are zero-based.
The 0th word is "Home"
The 1st is "Products"
The 2nd is "buy"
and so on.

If you wanted to get the pixel coordinates of the 2nd word but did not know what that word is, you would must pass in the word number.

Code: Select all

Let>nWord=2
VBEval>DoOCRGetRect("%sImage%",%nWord%),sRectCoords

The functions will need some modifying if you want to find the 2nd occurrance of a particular word.

On Kpassaur's earlier question on multi-page tiff and Word formatting:

I'm not sure what a multi-page tiff is. My script assumes you did a screencapture so the bitmap can only be partial or full page. I believe MODI accepts tiff files if you got them from elsewhere.

You should be able to modify my function to obtain the font of a particular word like this:

Code: Select all

strFont=miWords(numWord).FontId

You could get the line number in the same way using .LineId so you could put the line breaks in the same place (unless you want to let Word Wrap put them where it will, MODI can't tell you which is more appropriate)

Once you have font of each word you should be able to use vbscript's CreateObject to start a Word session, just like we do for MODI.Document and in other forum examples, for Excel. I suppose you could also write the font information to a markup sheet.

Gale

[kikk]

Hi,

"The functions will need some modifying if you want to find the 2nd occurrance of a particular word. "

This was exactly the problem I am facing.


Best
KIKK

[gdyvig]

Hi kikk,

I have not tested this, but believe it will work:

Add a param to the function for nTargetOccurance

Code: Select all

VBSTART
Function DoOCRGetWordNumV2(bitmapfile,strTargetWord, nTargetOccurance)
  Dim miDoc
  Dim miLayout
  Dim miWords
  Dim miWord
  Dim miWordText
  Dim strText
  Dim numWords
  Dim numWord
  Dim numWordFound
  Dim numOccurance
  on error resume next
  
  Set miDoc = CreateObject("MODI.Document")
  miDoc.Create (bitmapfile)
  miDoc.Images(0).OCR
  
  set miLayout = miDoc.Images(0).Layout
  Set miWords = miDoc.Images(0).Layout.Words
  numWords=miWords.Count
    
  numWord=0
  numWordFound=-1
  numOccurance=0  
  Do  
    strWord=miWords(numWord).Text
    'Case sensitive compare
    'We can also compare on .Id, .LineID, .FontId, and .RecognitionConfidence
    if strWord=strTargetWord then
      if numOccuance=nTargetOccurance
        numWordFound=numWord
        numWord=numWords
      endif	 
    end if
    numWord=numWord+1
  Loop While NumWord < numWords 
  
  DoOCRGetWordNum = numWordFound
  
  Set miDoc = Nothing
  Set miLayout = Nothing
  Set miWords = Nothing
  Set miWord = Nothing
  Set miWordText = Nothing
End Function
VBEND

Use the new parameter when calling the revised function:

Code: Select all

//Let suppose sImage contains the text "Home Products Buy Now Downloads - Buy Buy Buy !!!"
Let>sImage=C:\MyScreenCapture.bmp
//zero based nBuyOccurance
Let>nBuyOccurance=1
VBEval>DoOCRGetWordNumV2("%sImage%","Buy",nBuyOccurance),nWord
MDL>nWord:%nWord%
//Should return nWord=2 (word numbers start with 0)

VBEval>DoOCRGetRect("%sImage%",%nWord%),sRectCoords
MDL>sRectCoords:%sRectCoords%
//Returns left,top,right,bottom pixel coordinates of rectangle bounding the word

//If sImage is for entire screen, we can click on the word coordinates
//Otherwise we need to apply an offset based on the location of sImage
Let>COMMA=,
Separate>%sRectCoords%,%COMMA%,aRectCoords
Let>nCenterX={round((%aRectCoords_1%+%aRectCoords_3%)/2)}
Let>nCenterY={round((%aRectCoords_2%+%aRectCoords_4%)/2)}
MDL>CENTER: %nCenterX%,%nCenterY%
//Click on text
MouseMove>%nCenterX%,%nCenterY%
//Should move mouse to center of the word "Buy"
LClick
//

Gale

[cyberiguana]

thanks gale, but how do I use this feature? I'm pretty new at this. I want to locate a word on screen and click on it, which variables in your script I need to change to match my search?

[gdyvig]

Hi cyberiguana,


You will probably want to take the sample code and put it in a Macro Scheduler subroutine.

You will need to use the ScreenCapture command to get the image file (stored in the sImage variable). The ScreenCapture command lets you define the upper left corner of the screen and the width and height you wish to capture. Use GetScreenRes to get the coordinates for the entire screen. Use GetActiveWindow (or GetWindowPos and GetWindowSize) to get the coordinates for a particular window. Because there are so many ways to get the coordinates you want you may want your subroutine to accept either the image file you created or the screen coordinates and let the subroutine create the image file.

The names of the varialbles in your subroutine do not need to match the names of the vbscript variables. I would change the literal string "Buy" to a Macro Scheduler variable with a name such as sTargetWord and change the name of the variabale nBuyOccurance to something more general, like nTargetWordOccurance. Your VBEval statement would become:

Code: Select all

//Suppose screen contains the following text:
//To be or not to be.
//That is the question.
//Shall I be?
Let>sTargetWord=be
Let>nTargetWordOccurance=2

GetScreenRes>w,h
Let>sImage=c:\screen.bmp
ScreenCapture>%sImage%,w,h

VBEval>DoOCRGetWordNumV2("%sImage%","%sTargetWord%",nTargetWordOccurance),nWord

VBEval>DoOCRGetRect("%sImage%",%nWord%),sRectCoords

Note that nTargetWordOccurance refers to the 3 occurances of the word "be" in this case while nWord refers to the occurances of all 13 words (I'm not sure if the puncuation counts as words).

The next step is to make the script less cumbersome by putting it all into the SRT.

Gale

[cyberiguana]

when I try to run it says: Wrong number of arguments orinvalid property assignment 'DoOCRGetWordNum'
heres my code: (image is already captured)

Code: Select all

VBSTART
Function DoOCRGetWordNum(bitmapfile,strTargetWord)
  Dim miDoc
  Dim miLayout
  Dim miWords
  Dim miWord
  Dim miWordText
  Dim strText
  Dim numWords
  Dim numWord
  Dim numWordFound
  on error resume next
  
  Set miDoc = CreateObject("MODI.Document")
  miDoc.Create (bitmapfile)
  miDoc.Images(0).OCR
  
  set miLayout = miDoc.Images(0).Layout
  Set miWords = miDoc.Images(0).Layout.Words
  numWords=miWords.Count
    
  numWord=0
  numWordFound=-1  
  Do  
    strWord=miWords(numWord).Text
    'Case sensitive compare
    'We can also compare on .Id, .LineID, .FontId, and .RecognitionConfidence
    if strWord=strTargetWord then
      numWordFound=numWord
      numWord=numWords
    end if
    numWord=numWord+1
  Loop While NumWord <numWords>sTargetWord=Sample
Let>nTargetWordOccurance=1


Let>sImage=F:\myscreenimage.bmp

VBEval>DoOCRGetWordNum("%sImage%","%sTargetWord%",nTargetWordOccurance),nWord

VBEval>DoOCRGetRect("%sImage%",%nWord%),sRectCoords

[cyberiguana]

exceeded message limit, heres fix:

VBSTART
Function DoOCRGetWordNum(bitmapfile,strTargetWord)
Dim miDoc
Dim miLayout
Dim miWords
Dim miWord
Dim miWordText
Dim strText
Dim numWords
Dim numWord
Dim numWordFound
on error resume next

Set miDoc = CreateObject("MODI.Document")
miDoc.Create (bitmapfile)
miDoc.Images(0).OCR

set miLayout = miDoc.Images(0).Layout
Set miWords = miDoc.Images(0).Layout.Words
numWords=miWords.Count

numWord=0
numWordFound=-1
Do
strWord=miWords(numWord).Text
'Case sensitive compare
'We can also compare on .Id, .LineID, .FontId, and .RecognitionConfidence
if strWord=strTargetWord then
numWordFound=numWord
numWord=numWords
end if
numWord=numWord+1
Loop While NumWord sTargetWord=Sample
Let>nTargetWordOccurance=1

[gdyvig]

Hi cyberiguana,

You would get the invalid number of arguments if you used the VBEval statement modified in my response to Kikk but with the original version of DoOCRGetWordNum.

Original:

Code: Select all

VBEval>DoOCRGetWordNum("%sImage%","%sTargetWord%"),nWord

Version 2:

Code: Select all

VBEval>DoOCRGetWordNumV2("%sImage%","%sTargetWord%",nTargetWordOccurance),nWord

I went back in my previous posts for this thread and renamed the revised function where 3 arguments are required.

Gale