Capture a part of screen and OCR it

[wangdong]

I am working on a project that requires to OCR a part of PDF. I couldn't find any useful information on how to do this. But I have an idea that maybe can do the job.

I want a function that allows user to select an area on the screen and save that part of scrren to a picture file and then I will use another function to OCR the picture.

Can anyone give me some advice on it? I am having a problem to capture the screen (not whole screen, but a part of it). Or do you think there is a better solution for this?

 

[johnwm]

Can you just use the Select tool in the (free) Adobe Reader to select the text, then right-click to save to the clipboard. Any text selected is saved as text - no OCR required.

________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first.
'If we're supposed to work in Hex, why have we only got A fingers?'
Essex Steam UK for steam enthusiasts

 

[wangdong]

pdf documents are scanned in. You cannot select the text on a scanned PDF.

 

[bjd4jc]

Do a search in this forum for 'Screen Capture' and you will find many threads that relate. I would suggest reading a lot of them because there are some caveats.

As far as OCR, do you have an OCR method that you prefer to use? I have recently been playing around with the Microsoft Office Document Imaging library which comes with Office 2003 (I think even in the basic editions but you would have to check). The only downfall to this is that you must deal with TIF format which VB does not natively support...

 

[bjd4jc]

OK, since it's Friday and I need something very similar I decided to piece together some code from these forums and create a solution for you.

Credit needs to go to strongm for thread222-787961 and to Hypetia for thread222-516967 (there might have been one other thread involved but I can't remember)

You will need the following references:
Microsoft Windows Image Acquisition Library v2.0 (see
thread222-787961)
Microsoft Internet Controls
Microsoft Office Document Imaging 11.0 Type Library (requires Office 2003 as discussed above)

Code wise you will need the following
A Form
A Web Browser Control (WebBrowser1) (or some other way to display the pdf on the form)
A PictureBox (Picture1)
A Command Button (Command1)

Then, paste the following code in it's entirety into the form:

Option Explicit
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicArray As Long, RefIID As Any, ByVal OwnsHandle As Long, IPic As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function GetSystemMetrics& Lib "user32" (ByVal nIndex&)

Private Sub TakeSnapshot(imgLeft As Long, imgTop As Long, imgWidth As Long, imgHeight As Long, picFile As String)
    Dim hWndDesk As Long, hDCDesk As Long
    Dim myDC As Long, myBmp As Long, hOldBmp As Long
    'Get desktop window handle
    hWndDesk = GetDesktopWindow
    'Get desktop device context
    hDCDesk = GetDC(hWndDesk)
    
    'Create memory dc
    myDC = CreateCompatibleDC(hDCDesk)
    'Create memory bitmap
    myBmp = CreateCompatibleBitmap(hDCDesk, imgWidth, imgHeight)
    
    'Select the bitmap into dc replacing the old one.
    hOldBmp = SelectObject(myDC, myBmp)
    
    'Delete the original 1x1 monochrome bitmap
    'We dont need it
    DeleteObject hOldBmp
    
    'Copy the desired image from desktop dc to our mem dc
    BitBlt myDC, 0, 0, imgWidth, imgHeight, hDCDesk, imgLeft, imgTop, vbSrcCopy
    
    'Release the desktop dc
    ReleaseDC hWndDesk, hDCDesk
    
    'Convert the bitmap handle (myBmp)
    'into vb Picture object
    Dim Pic As Object
    Dim P(0 To 4) As Long, G(0 To 15) As Byte
    G(1) = 4: G(2) = 2: G(8) = 192: G(15) = 70
    P(0) = 20: P(1) = vbPicTypeBitmap: P(2) = myBmp
    OleCreatePictureIndirect P(0), G(0), 1, Pic
    
    'Save the picture to file
    SavePicture Pic, picFile
    DoEvents
    
    'Deselect the memory bitmap from memory dc
    SelectObject myDC, 0
    
    'Delete memory bitmap
    DeleteObject myBmp
    
    'Delete memory dc
    DeleteDC myDC
End Sub

Private Sub Command1_Click()
     Dim hpx As Long
     Dim lpx As Long
     Dim tpx As Long
     Dim wpx As Long
     Dim MenuBarHeight As Long
     Dim BorderWidth As Long
     
     BorderWidth = GetSystemMetrics(45)
             
     wpx = (Me.Width / Screen.TwipsPerPixelX) - (BorderWidth * 2)
     tpx = (Me.Top / Screen.TwipsPerPixelY)
     hpx = Me.Height / Screen.TwipsPerPixelY - BorderWidth
     lpx = Me.Left / Screen.TwipsPerPixelX + BorderWidth
     
     MenuBarHeight = hpx - Me.ScaleHeight
     
    
     'TakeSnapshot 0, 0, 200, 200, "C:\snapshot.bmp"
     TakeSnapshot lpx, tpx + MenuBarHeight, wpx, hpx - MenuBarHeight, "C:\snapshot.bmp"
     
     Me.Picture1 = LoadPicture("c:\snapshot.bmp")
     Me.Picture1.Top = 0
     Me.Picture1.Left = 0
     Me.Picture1.Width = Me.Width
     Me.Picture1.Height = Me.Height
     Me.Picture1.Visible = True
     Me.Picture1.ZOrder "0"
        
End Sub

Private Sub Form_Load()
    Me.WebBrowser1.Navigate "file://c:/output.pdf"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    End
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Static ClickCount As Long
    
    ClickCount = ClickCount + 1
    
    Static FirstX As Long
    Static FirstY As Long
    Dim SecondX As Long
    Dim SecondY As Long
    
    Dim hpx As Long
    Dim lpx As Long
    Dim tpx As Long
    Dim wpx As Long
    Dim MenuBarHeight As Long
    Dim BorderWidth As Long
    
    
    If ClickCount = 1 Then
        FirstX = X / Screen.TwipsPerPixelX
        FirstY = Y / Screen.TwipsPerPixelY
        Exit Sub
    End If
    
    If ClickCount = 2 Then
        SecondX = X / Screen.TwipsPerPixelX
        SecondY = Y / Screen.TwipsPerPixelY
    End If

    BorderWidth = GetSystemMetrics(45)
    
            
    'Get the borders of the form
    tpx = (Me.Top / Screen.TwipsPerPixelY)
    hpx = Me.Height / Screen.TwipsPerPixelY - BorderWidth
    lpx = Me.Left / Screen.TwipsPerPixelX + BorderWidth
    MenuBarHeight = hpx - Me.ScaleHeight
    
    'now, go int a get inside of the form
    wpx = Abs(FirstX - SecondX)
    hpx = Abs(FirstY - SecondY)
    
    If FirstX < SecondX Then
        lpx = lpx + FirstX
    Else
        lpx = lpx + SecondX
    End If
    
    If FirstY < SecondY Then
        tpx = tpx + FirstY
    Else
        tpx = tpx + SecondY
    End If
    
    TakeSnapshot lpx, tpx + MenuBarHeight, wpx, hpx, "C:\snapshot2.bmp"
    Me.Picture1.ZOrder "0"
    Me.Picture1.Visible = False
    ClickCount = 0
    
    MsgBox OCRImage(ConvertToTif("C:\snapshot2.bmp"))
    
End Sub

Private Function ConvertToTif(ImageName As String) As String
    Dim imgFile As New ImageFile
    Dim IP As New ImageProcess
    Dim strFileName As String
    
    imgFile.LoadFile ImageName
    
    IP.Filters.Add IP.FilterInfos("Convert").FilterID
    IP.Filters(1).Properties("FormatID").Value = wiaFormatTIFF
    IP.Filters(1).Properties("Quality").Value = 5
    
    Set imgFile = IP.Apply(imgFile)
     
    strFileName = Replace(ImageName, imgFile.FileExtension, ".tif")
    
    If Dir(strFileName) <> "" Then
        Kill strFileName
    End If
    
    imgFile.SaveFile strFileName
    Set imgFile = Nothing
    
    ConvertToTif = strFileName
End Function

Private Function OCRImage(strFileName As String) As String
    Dim objDoc As MODI.Document
    Dim objImg As MODI.Image
    
    Set objDoc = New MODI.Document
    objDoc.Create (strFileName)
    Set objImg = objDoc.Images(0)
    objImg.OCR
    
    OCRImage = objImg.Layout.Text
    
End Function

I hope this helps you and that you have the necessary components to do this (Windows XP and Office 2003). If not, perhaps someone else can help you a little more...

 

[bjd4jc]

Oh, I should have said that to run it, click the command button and then click on the form twice (essentially creating a box) and it will ocr whatever you clicked.