gbCapture

Gary Beene
Member
Join Date: May 2008
Posts: 19401
11 Dec 2022, 10:20 AM
As a followup to the thread on capturing text from an application using OCR, here's an app called gbCapture which can extract text from applications that display multiple pages of text but which do not provide built-in methods of copying and saving the displayed text of the entire document.

Download here.
Web Page here.
Discussion here.

Main window:

When asked to capture pages, gbCapture acts on whatever application it find in the center of the desktop. It captures an image of the application, extracts text from the image and then sends a Next Page keystroke command to the application. It repeats that process for as many pages are the user requests. Additional details about gbCapture can be found on the web page, but here are a few introductory images.

The target window can be shown like this:

The bitmaps and extract text files can be reviewed through this gbCapture window:

And the final composite document can be shown like this:

Source code:
Code:
'Compilable Example:
#Compiler PBWin 10
#Compile Exe  "gbcapture.exe"
#Dim All

#Debug Error On
#Debug Display On

%Unicode = 1
#Include "Win32API.inc"
#Include "WinInet.inc"

#Resource Manifest, 1,      "_icons\xptheme.xml"
#Resource Icon xlogo        "_icons\bwcaptureplus.ico"
#Resource Icon xcaptureplus "_icons\captureplus.ico"
#Resource Icon xleft        "_icons\prev.ico"
#Resource Icon xright       "_icons\next.ico"
#Resource Icon xup          "_icons\up.ico"
#Resource Icon xdown        "_icons\down.ico"
#Resource Icon xhelp        "_icons\help.ico"
#Resource Icon xpower       "_icons\power.ico"
#Resource Icon xsettings    "_icons\settings.ico"
#Resource Icon xstop        "_icons\stop.ico"
#Resource Icon xopen        "_icons\open.ico"
#Resource Icon xtarget      "_icons\target.ico"
#Resource Icon xfiles       "_icons\files.ico"
#Resource Icon xdocument    "_icons\book.ico"
#Resource Icon xhide        "_icons\hide.ico"
#Resource Icon xnumber      "_icons\number.ico"
#Resource Icon xcopy        "_icons\copy.ico"
#Resource Icon xsave        "_icons\save.ico"

$ver = "1.01"
%MultiLineREStyle_Wrap = %WS_Child Or %WS_ClipSiblings Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop Or %ES_SaveSel
$Document = "results\document.txt"
$Tesseract = "c:\program files\tesseract-ocr\tesseract.exe"


Enum Equates Singular
   IDC_Toolbar
   IDC_ListBox
   IDC_Graphic
   IDC_TextBox
   IDC_StatusBar

   IDC_Count
   IDC_Label
   IDC_Ok
   IDC_Cancel

   IDT_Exit
   IDT_Prev
   IDT_Next

   IDT_Capture
   IDT_Stop
   IDT_Blank

   IDT_Open

   IDT_Target
   IDT_Document
   IDT_Files
   IDT_Number

   IDT_Font
   IDT_PageNumbers
   IDT_Settings
   IDT_Help

   IDM_UsePageNumbers
   IDM_LeftRight
   IDM_PageInterval
   IDM_SaveAs
   IDM_CopyAll
   IDM_BGColor

   IDM_Clear
   IDM_UseBeep
   IDM_MultiColumn
   IDM_CaptureDeskTop
   IDM_Exit
   IDM_Sep

   IDM_Update
   IDM_Test

   NoDisplay = 0
   Target
   History
   Results
End Enum

Global hDlg,hToolbar,hListBox,hImageList,hGraphic,hGraphicDC As Dword
Global hThread,hTextBox,hPopupSetting,hPopupTextBox As Dword
Global hDlgNumber, hFontCount,hFontTextBox,hFontToolbar, hFontStatusBar As Dword
Global BGColor, PageInterval, LeftRight, DisplayType, UsePageNumbers, Restart, pID As Long
Global ImgName, TextName, URLPath, LocalPath As WStringZ * %Max_Path
Global hDeskTop, hCenterApp, hCenterWindow, OldProc As Dword
Global CaptureDeskTop, MultiColumn, UseBeep, StopCapture, ActionCount, MaxCount As Long
Global rcCenter As Rect, CurrentImage$, LastText$
Global qFreq, qStart, qStop As Quad


Function PBMain() As Long
   If IsRunning(Exe.Name$) Then sBeep : sBeep : Exit Function
   Dialog New Pixels, 0, "gbCapture " + $ver,,,930,150, %WS_SysMenu To hDlg
   Dialog Set Icon hDlg, "xlogo"
   Dialog Show Modal hDlg Call DlgProc
   If Restart Then pID = Shell(Exe.Path$ + "gbcapture.exe", 1)  'restart this app
End Function

CallBack Function DlgProc() As Long
   Local temp$, iResult As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         Settings_INI "get"
         QueryPerformanceFrequency qFreq
         BuildAcceleratorTable
         CreateSubFolders
         CreateFonts
         CreateTextBox
         OldProc = SetWindowLong(hTextBox, %GWL_WndProc, CodePtr(NewTextProc))  'subclass

         CreateImageList
         'CreatePopupMenus
         CreateToolbar
         SetMenuStatus

         CreateListBox
         CreateGraphicControl
         CreateStatusBar
         SetColors
         ResizeWindow

      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDC_ListBox
               Select Case Cb.CtlMsg
                  Case %LBN_SelChange : LoadSelectedImageAndText
               End Select

            Case %IDC_TextBox
               Select Case Cb.CtlMsg
                  Case %EN_SetFocus
                     Control Send hDlg, %IDC_TextBox, %EM_SetSel, -1, 0
               End Select

            Case %IDT_Exit        : Dialog End hDlg       : sBeep
            Case %IDT_Prev        : GetHandles : PrevPage : sBeep
            Case %IDT_Next        : GetHandles : NextPage : sBeep

            Case %IDT_Capture
               If IsFalse IsFile($Tesseract) Then
                  sBeep : sBeep
                  Statusbar Set Text hDlg, %IDC_Statusbar, 1,0, " gbCapture " + $Ver + "   Cannot Capture. Tesseract Not Found!"
               Else
                  sBeep
                  Thread Create BeginCapture(0) To hThread
                  Thread Close hThread To hThread
               End If

            Case %IDT_Stop : StopCapture = 1

            Case %IDT_Open        : sBeep : OpenDocument

            Case %IDT_Target
               sBeep
               If DisplayType = 1 Then DisplayType = 0 Else DisplayType = 1
               ResizeWindow

            Case %IDT_Number
               sBeep
               ShowNumberDialog
               Statusbar Set Text hDlg, %IDC_StatusBar, 2, 0, "  Pages to Capture: " + Str$(MaxCount)

            Case %IDT_Files
               sBeep
               If DisplayType = 2 Then DisplayType = 0 Else DisplayType = 2
               ResizeWindow

            Case %IDT_Document
               sBeep
               If DisplayType = 3 Then DisplayType = 0 Else DisplayType = 3
               ResizeWindow

            Case %IDT_Settings : sBeep
               If DisplayType = 4 Then DisplayType = 0 Else DisplayType = 4
               ResizeWindow

            Case %IDT_Help
               sBeep
               If IsFile("help\gbcapture.htm")Then
                 URLPath = "help\gbcapture.htm"
               Else
                 URLPath = "http://www.garybeene.com/sw/gbcapture/gbcapture.htm"
               End If
               iResult = ShellExecute(hDlg, "Open", URLPath, $Nul, $Nul, %SW_ShowNormal)

            Case %IDM_UsePageNumbers : sBeep : UsePageNumbers Xor = 1 : SetMenuStatus
               If DisplayType = 4 Then ResizeWindow

            Case %IDM_LeftRight
               sBeep
               LeftRight Xor = 1
               CreateToolbar
               If DisplayType = 4 Then ResizeWindow

            Case %IDM_Clear : sBeep : KillPriorResults : ResizeWindow
               Statusbar Set Text hDlg, %IDC_StatusBar, 1,0, " gbCapture " + $ver + "     Files Cleared"

            Case %IDM_MultiColumn  : sBeep : MultiColumn Xor=1
               If DisplayType = 4 Then ResizeWindow
               Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, " gbCapture " + $ver + "     MultiColumn: " + IIf$(MultiColumn,"ON","OFF")

            Case %IDM_CaptureDeskTop : sBeep : CaptureDeskTop Xor=1
               If DisplayType = 4 Then ResizeWindow
               Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, " gbCapture " + $ver + "     Capture DeskTop: " + IIf$(CaptureDeskTop,"ON","OFF")

            Case %IDM_UseBeep      : sBeep : UseBeep Xor=1 : SetMenuStatus
               If UseBeep Then sBeep
               If DisplayType = 4 Then ResizeWindow
               Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, " gbCapture " + $ver + "     Use Beep: " + IIf$(UseBeep,"ON","OFF")

            Case %IDM_BGColor      : sBeep : ChangeColor     : SetColors
               If DisplayType = 4 Then ResizeWindow

            Case %IDM_Exit         : sBeep : Dialog End hDlg

            Case %IDM_CopyAll      : sBeep
               Control Get Text hDlg, %IDC_TextBox To temp$
               Clipboard Reset
               Clipboard Set Text temp$

            Case %IDM_SaveAs       : sBeep : SaveDocumentAs

            Case %IDM_Update       : sBeep : UpdateEXE

            Case %IDM_PageInterval : sBeep : NextPageInterval
               If DisplayType = 4 Then ResizeWindow
               Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, " gbCapture " + $Ver + "   Page Interval: " + Str$(PageInterval)

            Case %IDM_Test
               GetHandles
               CapturePageImage_DeskTop
               sBeep : sBeep : sBeep

         End Select


'      Case %WM_Size
'         ResizeWindow

'      Case %WM_Notify
'           Select Case Cb.NmId
'               Case %IDT_Exit To %IDT_Help
'                  Select Case Cb.NmCode
'                     Case %TTN_GetDispInfo
'                         P = Cb.LParam
'                         @[email protected] = SetToolTips(Cb.NmId)
'                  End Select
'            End Select

'           nmtb = Cb.LParam
'           Select Case @nmtb.hdr.Code
'              Case %TBN_DROPDOWN
'                 Select Case @nmtb.iItem
'                    Case %IDT_Document
'                       Call SendMessage(@nmtb.hdr.hwndFrom, %TB_GETRECT, @nmtb.iItem, VarPtr(rc))
'                       Call MapWindowPoints(@nmtb.hdr.hwndFrom, %HWND_Desktop, ByVal VarPtr(rc), 2)
'                       Call TrackPopupMenu (hPopupTextBox, 0, rc.nLeft, rc.nBottom, 0, CbHndl, ByVal %Null)
'                    Case %IDT_Settings
'                       Call SendMessage(@nmtb.hdr.hwndFrom, %TB_GETRECT, @nmtb.iItem, VarPtr(rc))
'                       Call MapWindowPoints(@nmtb.hdr.hwndFrom, %HWND_Desktop, ByVal VarPtr(rc), 2)
'                       Call TrackPopupMenu (hPopupSetting, 0, rc.nLeft, rc.nBottom, 0, CbHndl, ByVal %Null)
'                 End Select
'           End Select

'        Case %WM_ContextMenu

      Case %WM_Destroy
         SetWindowLong hTextBox, %GWL_WNDPROC, OldProc   'un-subclass
         Settings_ini "save"

   End Select
End Function

Sub Settings_INI(Task$)
   Local x,y,w,h,ww,hh As Long
   Local xResult, yResult, temp, INIFileName As WStringZ*%Max_Path
   INIFileName = Exe.Path$ + Exe.Name$ + ".ini"
   If Task$ = "get" Then

      'get dialog width/height from INI file and use to set Dialog location
      Getprivateprofilestring "All", "Left", "-1", xResult, %Max_Path, INIFileName
      Getprivateprofilestring "All", "Top", "-1", yResult, %Max_Path, INIFileName
      If xResult = "-1" Then
         Desktop Get Size To ww,hh
         Dialog Get Size hDlg To w,h
         Dialog Set Loc hDlg, ww-w-20,10
      Else
         Dialog Set Loc hDlg, Val(xResult), Val(yResult)  'width/height
      End If

      'get value for string variables
'      Getprivateprofilestring "All", "FontName", "Tahoma", FontName, %Max_Path, INIFileName

      'get value for numeric variables
'      Getprivateprofilestring "All", "FontSize", "10", temp, %Max_Path, INIFileName:  FontSize = Val(temp)
'      Getprivateprofilestring "All", "FontAttr", "0", temp, %Max_Path, INIFileName:  FontAttr = Val(temp)
      Getprivateprofilestring "All", "BGColor", Str$(RGB(235,236,240)), temp, %Max_Path, INIFileName:  BGColor = Val(temp)
      Getprivateprofilestring "All", "UseBeep", "1",          temp, %Max_Path, INIFileName:  UseBeep = Val(temp)
      Getprivateprofilestring "All", "MultiColumn", "0",      temp, %Max_Path, INIFileName:  MultiColumn = Val(temp)
      Getprivateprofilestring "All", "CaptureDeskTop", "1",   temp, %Max_Path, INIFileName:  CaptureDeskTop = Val(temp)
      Getprivateprofilestring "All", "PageInterval", "500",   temp, %Max_Path, INIFileName:  PageInterval = Val(temp)
      Getprivateprofilestring "All", "LeftRight", "1",        temp, %Max_Path, INIFileName:  LeftRight = Val(temp)
      Getprivateprofilestring "All", "UsePageNumbers", "1",   temp, %Max_Path, INIFileName:  UsePageNumbers = Val(temp)
      Getprivateprofilestring "All", "MaxCount", "1",         temp, %Max_Path, INIFileName:  MaxCount = Val(temp)

   End If

   If Task$ = "save" Then
      'save dialog size/location unless minimized or maximized
      If IsFalse(IsIconic(hDlg) Or IsZoomed(hDlg)) Then
         Dialog Get Loc hDlg To x,y
         WritePrivateProfileString "All", "Left", Str$(x), INIFileName
         WritePrivateProfileString "All", "Top", Str$(y), INIFileName
      End If
      'save string variables
'      WritePrivateProfileString "All", "FontName",FontName, INIFileName

      'save numeric variables
'      WritePrivateProfileString "All", "FontSize", (Str$(FontSize)), INIFileName
'      WritePrivateProfileString "All", "FontAttr", (Str$(FontAttr)), INIFileName
      WritePrivateProfileString "All", "BGColor",        (Str$(BGColor)), INIFileName
      WritePrivateProfileString "All", "UseBeep",        (Str$(UseBeep)), INIFileName
      WritePrivateProfileString "All", "MultiColumn",    (Str$(MultiColumn)), INIFileName
      WritePrivateProfileString "All", "CaptureDeskTop", (Str$(CaptureDeskTop)), INIFileName
      WritePrivateProfileString "All", "PageInterval",   (Str$(PageInterval)), INIFileName
      WritePrivateProfileString "All", "LeftRight",      (Str$(LeftRight)), INIFileName
      WritePrivateProfileString "All", "UsePageNumbers", (Str$(UsePageNumbers)), INIFileName
      WritePrivateProfileString "All", "MaxCount",       (Str$(MaxCount)), INIFileName
   End If
End Sub

Sub BuildAcceleratorTable
   Local c As Long, ac() As ACCELAPI, hAccelerator As Dword  ' for keyboard accelator table values
   Dim ac(13)
   ac(c).fvirt = %FVIRTKEY Or %FCONTROL Or %FSHIFT : ac(c).key = %VK_B      : ac(c).cmd  = %IDM_UseBeep          : Incr c   '0
   ac(c).fvirt = %FVIRTKEY Or %FCONTROL Or %FSHIFT : ac(c).key = %VK_C      : ac(c).cmd  = %IDM_CopyAll          : Incr c   '1
   ac(c).fvirt = %FVIRTKEY Or %FCONTROL Or %FSHIFT : ac(c).key = %VK_D      : ac(c).cmd  = %IDM_CaptureDeskTop   : Incr c   '2
   ac(c).fvirt = %FVIRTKEY Or %FCONTROL Or %FSHIFT : ac(c).key = %VK_E      : ac(c).cmd  = %IDM_Clear            : Incr c   '3
   ac(c).fvirt = %FVIRTKEY Or %FCONTROL Or %FSHIFT : ac(c).key = %VK_I      : ac(c).cmd  = %IDM_PageInterval     : Incr c   '4
   ac(c).fvirt = %FVIRTKEY Or %FCONTROL Or %FSHIFT : ac(c).key = %VK_K      : ac(c).cmd  = %IDM_BGColor          : Incr c   '5
   ac(c).fvirt = %FVIRTKEY Or %FCONTROL Or %FSHIFT : ac(c).key = %VK_L      : ac(c).cmd  = %IDM_LeftRight        : Incr c   '6
   ac(c).fvirt = %FVIRTKEY Or %FCONTROL Or %FSHIFT : ac(c).key = %VK_M      : ac(c).cmd  = %IDM_MultiColumn      : Incr c   '7
   ac(c).fvirt = %FVIRTKEY Or %FCONTROL Or %FSHIFT : ac(c).key = %VK_P      : ac(c).cmd  = %IDM_UsePageNumbers   : Incr c   '8
   ac(c).fvirt = %FVIRTKEY Or %FCONTROL Or %FSHIFT : ac(c).key = %VK_S      : ac(c).cmd  = %IDM_SaveAs           : Incr c   '9
   ac(c).fvirt = %FVIRTKEY Or %FCONTROL Or %FSHIFT : ac(c).key = %VK_T      : ac(c).cmd  = %IDM_Test             : Incr c   '10
   ac(c).fvirt = %FVIRTKEY Or %FCONTROL Or %FSHIFT : ac(c).key = %VK_U      : ac(c).cmd  = %IDM_Update           : Incr c   '11
   ac(c).fvirt = %FVIRTKEY                         : ac(c).key = %VK_Escape : ac(c).cmd  = %IDM_Exit             : Incr c   '12
   ac(c).fvirt = %FVIRTKEY                         : ac(c).key   = %VK_F1   : ac(c).cmd  = %IDT_Help             : Incr c   '13
   Accel Attach hDlg, AC() To hAccelerator
End Sub

Function SetToolTips(cID As Long) As String
   Select Case cID         'or this:   @P.hdr.idFrom
      Case %IDT_Exit        : Function = "Exit"
      Case %IDT_Prev        : Function = "Previous Page"
      Case %IDT_Next        : Function = "Next Page"
      Case %IDT_Capture     : Function = "Capture Current Page"
      Case %IDT_Capture     : Function = "Capture Page Count"
      Case %IDT_Stop        : Function = "Stop Capture"
      Case %IDT_Open        : Function = "Open Document"
      Case %IDT_Target      : Function = "Target Window"
      Case %IDT_Files       : Function = "Files"
      Case %IDT_Document    : Function = "Document"
      Case %IDT_Help        : Function = "Open Online Help"
   End Select
End Function

Sub CreateSubFolders
   If IsFolder (Exe.Path$ + "images")  = %False Then MkDir Exe.Path$ + "images"
   If IsFolder (Exe.Path$ + "text")    = %False Then MkDir Exe.Path$ + "text"
   If IsFolder (Exe.Path$ + "results") = %False Then MkDir Exe.Path$ + "results"
   If IsFolder (Exe.Path$ + "help")    = %False Then MkDir Exe.Path$ + "help"
End Sub

Sub CreateGraphicControl
   Control Add Graphic, hDlg, %IDC_Graphic,  "", 10, 200,200,200, %WS_Border
   Control Handle hDlg, %IDC_Graphic To hGraphic
   Graphic Attach hDlg, %IDC_Graphic, ReDraw
   Graphic Get DC To hGraphicDC
   Graphic Set Font hFontTextBox
End Sub

Function TBS() As Long
   Local w,h As Long
   Control Get Size hDlg, %IDC_StatusBar To w,h
   Function = h
End Function

Sub CreateListBox
   Control Add ListBox, hDlg, %IDC_ListBox, , 0,0,100,100, %LBS_Notify Or %WS_TabStop Or %WS_VScroll Or %LBS_NoIntegralHeight Or %WS_Border
   Control Handle hDlg, %IDC_ListBox To hListBox
   Control Set Font hDlg, %IDC_ListBox, hFontTextBox
End Sub

Sub LoadListBox
   Local temp$
   ListBox Reset hDlg, %IDC_ListBox
   temp$ = Dir$("images\*.bmp")
   If Len(temp$) = 0 Then ListBox Add hDlg, %IDC_ListBox, "<no images>" : Exit Sub
   While Len(temp$)
      ListBox Add hDlg, %IDC_ListBox, temp$
      temp$ = Dir$(Next)
   Wend
End Sub

Sub LoadSelectedImageAndText
   Local hBMP As Dword, temp$
   Local x,y,wImg,hImg,wCont,hCont,wNew,hNew As Long

   ListBox Get Text hDlg, %IDC_ListBox To CurrentImage$
   CurrentImage$ = "images\" + CurrentImage$
   If IsFalse IsFile(CurrentImage$) Then
      Graphic Clear
      Control Set Text hDlg, %IDC_TextBox, ""
      Exit Sub
   End If

   Graphic Bitmap Load CurrentImage$,0,0  To hBMP
   Graphic Attach hBMP, 0, ReDraw
   Graphic Get Canvas To wImg, hImg

   Graphic Attach hGraphic, 0
   Graphic Get Canvas To wCont,hCont
   wNew = wImg / Max(wImg / wCont, hImg / hCont)
   hNew = hImg / Max(wImg / wCont, hImg / hCont)
   x = (wCont-wNew)/2
   y = (hCont-hNew)/2

   Graphic Clear
   Graphic Stretch hBMP, 0, (0,0)-(wImg,hImg) To (x,y)-(x+wNew,y+hNew), %Mix_CopySrc, %HalfTone
   Graphic ReDraw

   Graphic Attach hBMP, 0
   Graphic Bitmap End
   Graphic Attach hGraphic, 0

   Open "text\" + PathName$(Name,CurrentImage$) + ".txt" For Binary As #1
   Get$ #1, Lof(1), temp$
   Close #1

   Control Set Text hDlg, %IDC_TextBox, temp$
End Sub

Sub CreateImageList
    ImageList New Icon 48,48,24,15 To hImageList
    ImageList Add Icon hImageList, "xpower"       '1
    ImageList Add Icon hImageList, "xleft"        '2
    ImageList Add Icon hImageList, "xright"       '3
    ImageList Add Icon hImageList, "xlogo"        '4
    ImageList Add Icon hImageList, "xcaptureplus" '5
    ImageList Add Icon hImageList, "xstop"        '6
    ImageList Add Icon hImageList, "xsettings"    '7
    ImageList Add Icon hImageList, "xhelp"        '8
    ImageList Add Icon hImageList, "xopen"        '9
    ImageList Add Icon hImageList, "xup"          '10
    ImageList Add Icon hImageList, "xdown"        '11
    ImageList Add Icon hImageList, "xtarget"      '12
    ImageList Add Icon hImageList, "xfiles"       '13
    ImageList Add Icon hImageList, "xdocument"    '14
    ImageList Add Icon hImageList, "xhide"        '15
    ImageList Add Icon hImageList, "xnumber"      '16
    ImageList Add Icon hImageList, "xsave"        '17
End Sub

Sub CreateTextBox
   Control Add TextBox, hDlg, %IDC_TextBox, "", 0,0,100,100, %MultiLineREStyle_Wrap Or %WS_Border
   Control Handle hDlg, %IDC_TextBox To hTextBox
   Control Set Font hDlg, %IDC_TextBox, hFontTextBox

End Sub

Sub CreateFonts
   Font New "Arial Black", 18, 1 To hFontCount
   Font New "Arial Black", 14, 1 To hFontToolbar
   Font New "Arial Black", 12, 1 To hFontStatusBar
   Font New "Arial Black", 14, 1 To hFontTextBox
End Sub

Sub CreateStatusBar
   Control Add Statusbar, hDlg, %IDC_StatusBar, " gbCapture", 0,0,0,0, %WS_Border Or %CCS_Bottom
   Statusbar Set Parts hDlg, %IDC_StatusBar, 450,250,200
   Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, " gbCapture " + $ver
   Statusbar Set Text hDlg, %IDC_StatusBar, 2, 0, "  Pages to Capture: " + Str$(MaxCount)
   Control Set Font hDlg, %IDC_StatusBar, hFontStatusBar
End Sub

Sub CreateToolbar
    Control Kill hDlg, %IDC_Toolbar
    Control Add Toolbar, hDlg, %IDC_Toolbar,"", 0,0,0,0, %TbStyle_Tooltips Or %TbStyle_Flat Or %WS_Child
    Control Handle hDlg, %IDC_Toolbar To hToolbar
    Control Set Font hDlg, %IDC_Toolbar, hFontToolbar

    SendMessage hToolbar, %TB_SETEXTENDEDSTYLE, 0, %TBSTYLE_EX_DRAWDDARROWS

    Toolbar Set ImageList hDlg, %IDC_Toolbar, hImageList, 0     'default imagelist

    Toolbar Add Button  hDlg, %IDC_Toolbar, 1, %IDT_Exit,  %TbStyle_Button, "Exit"
    If LeftRight Then
       Toolbar Add Button  hDlg, %IDC_Toolbar, 2, %IDT_Prev,  %TbStyle_Button, "Prev"
       Toolbar Add Button  hDlg, %IDC_Toolbar, 3, %IDT_Next,  %TbStyle_Button, "Next"
    Else
       Toolbar Add Button  hDlg, %IDC_Toolbar, 10, %IDT_Prev,  %TbStyle_Button, "Up"
       Toolbar Add Button  hDlg, %IDC_Toolbar, 11, %IDT_Next,  %TbStyle_Button, "Down"
    End If
    Toolbar Add Separator hDlg, %IDC_Toolbar, 5
    Toolbar Add Button  hDlg, %IDC_Toolbar, 16, %IDT_Number,  %TbStyle_Button, "Pages"
    Toolbar Add Button  hDlg, %IDC_Toolbar, 5, %IDT_Capture,  %TbStyle_Button, "Capture"
    Toolbar Add Button  hDlg, %IDC_Toolbar, 6, %IDT_Stop,     %TbStyle_Button, "Stop"
    Toolbar Add Separator hDlg, %IDC_Toolbar, 5
    Toolbar Add Button  hDlg, %IDC_Toolbar, 12, %IDT_Target,  %TbStyle_Button, "Target"
    Toolbar Add Button  hDlg, %IDC_Toolbar, 13, %IDT_Files,   %TbStyle_Button, "Files"
'    Toolbar Add Button  hDlg, %IDC_Toolbar, 14, %IDT_Document,   %TbStyle_Button Or %TbStyle_DropDown, "Document"
    Toolbar Add Button  hDlg, %IDC_Toolbar, 14, %IDT_Document,   %TbStyle_Button, "Document"
    Toolbar Add Button  hDlg, %IDC_Toolbar, 17, %IDM_SaveAs,   %TbStyle_Button, "SaveAs"
    Toolbar Add Separator hDlg, %IDC_Toolbar, 5
'    Toolbar Add Button  hDlg, %IDC_Toolbar, 7, %IDT_Settings,   %TbStyle_Button Or %TbStyle_DropDown, "Settings"
    Toolbar Add Button  hDlg, %IDC_Toolbar, 7, %IDT_Settings,   %TbStyle_Button, "Settings"
    Toolbar Add Button  hDlg, %IDC_Toolbar, 8, %IDT_Help,     %TbStyle_Button, "Help"
End Sub

Sub GetHandles
   Local pt As Point
   Desktop Get Client To pt.x, pt.y
   pt.x = pt.x/2 : pt.y = pt.y/2
   hDeskTop = GetDesktopWindow
   hCenterWindow = WindowFromPoint(pt)
   hCenterApp    = GetParent(hCenterWindow)
End Sub

Sub NextPage
   SetFocus hCenterApp
   SetForeGroundWindow hCenterApp
   keybd_event(%VK_NEXT, 0, 0, 0)
   keybd_event(%VK_NEXT, 0, %KEYEVENTF_KEYUP, 0)
End Sub

Sub PrevPage
   SetFocus hCenterApp
   SetForeGroundWindow hCenterApp
   keybd_event(%VK_PRIOR, 0, 0, 0)
   keybd_event(%VK_PRIOR, 0, %KEYEVENTF_KEYUP, 0)
End Sub

Function IsRunning(EXEName As WStringZ * %Max_Path) As Long
   'returns 0 if instance exits or cannot create mutex. otherwise returns 1.
   Local UniqueName As WStringZ * %Max_Path
   UniqueName = EXEName
   If CreateMutex(ByVal %Null, 0, UniqueName) = 0 Or GetLastError = %ERROR_ALREADY_EXISTS Then Function = 1 : Exit Function
End Function

Sub OpenDocument
   Local iResult As Long
   If IsFalse IsFile($Document) Then
   Else
      iResult = Shell ("notepad " + $Document, 1)
   End If
End Sub

Sub KillPriorResults
   If Len(Dir$("images\*.*"))  Then Kill "images\*.*"
   If Len(Dir$("results\*.*")) Then Kill "results\*.*"
   If Len(Dir$("text\*.*"))    Then Kill "text\*.*"
End Sub

Sub ResizeWindow
   Local w,h As Long
   Select Case DisplayType
      Case 0  'no display
         Dialog Set Size hDlg, 930, 150
         Control Show State hDlg, %IDC_ListBox, %SW_Hide
         Control Show State hDlg, %IDC_Graphic, %SW_Hide
         Control Show State hDlg, %IDC_TextBox, %SW_Hide

      Case 1  'target
         Dialog Set Size hDlg, 930, 900
         Dialog Get Client hDlg To w,h

         Control Set Loc hDlg, %IDC_Graphic, 0,TBH
         Control Set Size hDlg, %IDC_Graphic,w,h-TBH-TBS
         GetHandles
         ShowTarget

         Control Show State hDlg, %IDC_ListBox, %SW_Hide
         Control Show State hDlg, %IDC_Graphic, %SW_Show
         Control Show State hDlg, %IDC_TextBox, %SW_Hide

      Case 2  'history
         Dialog Set Size hDlg, 930, 900
         Dialog Get Client hDlg To w,h

         Control Set Loc hDlg, %IDC_ListBox, 0,TBH      'listbox
         Control Set Size hDlg, %IDC_ListBox, w/5, h-TBH-TBS

         Control Set Loc hDlg, %IDC_Graphic, w/5,TBH      'graphic
         Control Set Size HDlg, %IDC_Graphic, 4*w/5, (h-TBH-TBS)/2

         Control Set Loc hDlg, %IDC_TextBox, w/5,TBH+(h-TBH-TBS)/2      'textbox
         Control Set Size HDlg, %IDC_TextBox, 4*w/5, (h-TBH-TBS)/2

         Control Show State hDlg, %IDC_ListBox, %SW_Show
         Control Show State hDlg, %IDC_Graphic, %SW_Show
         Control Show State hDlg, %IDC_TextBox, %SW_Show

         LoadListBox
         ListBox Select hDlg, %IDC_ListBox, 1
         LoadSelectedImageAndText
         PostMessage GetDlgItem(hDlg, %IDC_TextBox), %EM_SETSEL, -1, 0   'remove and textbox will be highlighted

      Case 3  'document text
         Dialog Set Size hDlg, 930, 900
         Dialog Get Client hDlg To w,h
         Control Set Loc hDlg, %IDC_TextBox, 0,TBH
         Control Set Size hDlg, %IDC_TextBox,w,h-TBH-TBS
         Control Set Text hDlg, %IDC_TextBox, DocumentText

         Control Show State hDlg, %IDC_ListBox, %SW_Hide
         Control Show State hDlg, %IDC_Graphic, %SW_Hide
         Control Show State hDlg, %IDC_TextBox, %SW_Show

         PostMessage GetDlgItem(hDlg, %IDC_TextBox), %EM_SETSEL, -1, 0   'remove and textbox will be highlighted

       Case 4   'settings

         Dialog Set Size hDlg, 930, 900
         Dialog Get Client hDlg To w,h
         Control Set Loc hDlg, %IDC_TextBox, 0,TBH
         Control Set Size hDlg, %IDC_TextBox,w,h-TBH-TBS
         Control Set Text hDlg, %IDC_TextBox, Settings

         Control Show State hDlg, %IDC_ListBox, %SW_Hide
         Control Show State hDlg, %IDC_Graphic, %SW_Hide
         Control Show State hDlg, %IDC_TextBox, %SW_Show

         PostMessage GetDlgItem(hDlg, %IDC_TextBox), %EM_SETSEL, -1, 0   'remove and textbox will be highlighted
   End Select
End Sub

Function TBH As Long
   Local w,h As Long
   Control Get Size hDlg, %IDC_Toolbar To w,h
   TBH = h
End Function

Sub ShowTarget
   Local x,y,wImg,hImg,wCont,hCont,wNew,hNew As Long, hBMP, hBMPDC, hDeskTopDC As Dword

   Dialog Show State hDlg, %SW_Hide
   Sleep 500

   Desktop Get Size To wImg,hImg
   hDeskTopDC = GetDC(%Null)

   Graphic Bitmap New wImg, hImg To hBMP
   Graphic Attach hBMP, 0
   Graphic Get DC To hBMPDC

   BitBlt hBMPDC, 0, 0, wImg, hImg, hDeskTopDC, 0, 0, %SRCCopy
   ReleaseDC %Null, hDeskTopDC

   GetWindowRect hCenterWindow, rcCenter
   Graphic Width 20
   Graphic Box (rcCenter.nLeft,rcCenter.nTop)-(rcCenter.nRight,rcCenter.nBottom),,%Red

   Graphic Attach hGraphic, 0, ReDraw
   Graphic Clear %rgb_LightBlue
   Graphic Get Canvas To wCont,hCont
   wNew = wImg / Max(wImg / wCont, hImg / hCont)
   hNew = hImg / Max(wImg / wCont, hImg / hCont)
   x = (wCont-wNew)/2
   y = (hCont-hNew)/2

   Graphic Stretch hBMP, 0, (0,0)-(wImg,hImg) To (x,y)-(x+wNew,y+hNew), %Mix_CopySrc, %HalfTone
   Graphic ReDraw

   Dialog Show State hDlg, %SW_Show

End Sub

Sub ShowNumberDialog
   Dialog New Pixels, hDlg, "gbCapture",150,100,450,60, %WS_SysMenu To hDlgNumber
   Dialog Set Icon hDlgNumber, "xnumber"

   Control Add Label, hDlgNumber, %IDC_Label, "Page Count:", 10,10,165,40
   Control Set Font hDlgNumber, %IDC_Label, hFontCount

   Control Add TextBox, hDlgNumber, %IDC_Count, Str$(MaxCount), 170,10,90,40
   Control Set Font hDlgNumber, %IDC_Count, hFontCount
   Control Set Color hDlgNumber, %IDC_Count, %Black, BGColor

   Control Add Button, hDlgNumber, %IDC_OK, "OK", 280,10,50,40
   Control Set Font hDlgNumber, %IDC_OK, hFontCount

   Control Add Button, hDlgNumber, %IDC_Cancel, "Cancel", 340,10,100,40
   Control Set Font hDlgNumber, %IDC_Cancel, hFontCount

   Dialog Show Modal hDlgNumber Call NumberDlgProc
End Sub

CallBack Function NumberDlgProc() As Long
   Local temp$
   Select Case Cb.Msg
      Case %WM_InitDialog
'         PostMessage GetDlgItem(hDlgNumber, %IDC_Count), %EM_SETSEL, -1, 0   'remove and textbox will be highlighted
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IdCancel, %IDC_Cancel
               Dialog End hDlgNumber
            Case %IdOk, %IDC_Ok
               Control Get Text hDlgNumber, %IDC_Count To temp$
               If Val(temp$) > 0 Then MaxCount = Val(temp$) Else sBeep
               Dialog End hDlgNumber
         End Select
      Case %WM_Destroy
         sBeep
   End Select
End Function

Sub CaptureImagesAndExtractText
   For ActionCount = 1 To MaxCount
       ImgName  = Exe.Path$ + "images\" + Format$(ActionCount,"0000") + ".bmp"
       TextName = Exe.Path$ + "text\"   + Format$(ActionCount,"0000") + ".txt"
       If CaptureDeskTop = 1 Then CapturePageImage_DeskTop
       If CaptureDeskTop = 0 Then CapturePageImage_Window
       ExtractTextFromImage
       If StopCapture Then Exit Sub
       If ActionCount < MaxCount Then NextPage
       Sleep PageInterval
   Next i
End Sub

Sub CapturePageImage_Window
   'Capture Image to ImgName
   Local hPageDC, hBMP, hBMPDC As Dword, w,h As Long
   GetWindowRect hCenterWindow, rcCenter
   hPageDC = GetDC(hCenterWindow)
   w = rcCenter.Right - rcCenter.Left
   h = rcCenter.Bottom - rcCenter.Top
   Graphic Bitmap New w,h To hBMP
   Graphic Attach hBMP, 0
   Graphic Get DC To hBMPDC
   BitBlt hBMPDC, 0, 0, w, h, hPageDC, 0, 0, %SRCCopy
   ReleaseDC %Null, hPageDC
   Graphic Save ImgName
   Graphic Bitmap End
   Statusbar Set Text hDlg, %IDC_Statusbar, 1,0, " Image File: " + PathName$(Namex,ImgName)
End Sub

Sub ExtractTextFromImage
   Local ExtractedText$
   'extract and clean the text using Tesseract
   Shell ($Tesseract + " --psm " + IIf$(MultiColumn,"4 ","1 ") + ImgName + " " + PathName$(Path,TextName) + PathName$(Name,TextName), 0) 'wait for it to finish
   Open TextName For Binary As #1 : Get$ #1, Lof(1), ExtractedText$ : Close #1 'get extracted text
   CleanText(ExtractedText$)
   If LastText$ = ExtractedText Then 'end of document
      If IsFile(ImgName)  Then Kill ImgName
      If IsFile(TextName) Then Kill TextName
      StopCapture = 1
      Statusbar Set Text hDlg, %IDC_StatusBar, 1,0, "Capture Stopped. End of Document!"
      Exit Sub
   Else
      LastText$ = ExtractedText$                                                   'for comparison, to know when stop
   End If
   Open TextName For Output As #1 : Print #1, ExtractedText$; : Close #1       'save cleaned extracted text
   'append the extracted text to $Document
   Open $Document For Append As #1
   Print #1, $CrLf + ExtractedText$ + IIf$(UsePageNumbers, $CrLf + "Page: " + Str$(ActionCount), "") ;
   Close #1
   Statusbar Set Text hDlg, %IDC_Statusbar, 1,0, " Text File: " + PathName$(Namex,TextName)
End Sub

Sub sBeep
   If UseBeep Then
      Thread Create MakeBeep(0) To hThread
      Thread Close hThread To hThread
   End If
End Sub

Thread Function MakeBeep(ByVal X As Long) As Long
   WinBeep(250,300)
End Function

Sub ChangeColor
   Select Case BGColor
      Case RGB(218,254,223) : BGColor = %White                 'green to white
      Case %White           : BGColor = RGB(204,255,255)       'white to blue
      Case RGB(204,255,255) : BGColor = RGB(235,236,240)       'blue to gray
      Case Else             : BGColor = RGB(218,254,223)       'gray to green
   End Select
End Sub

Sub SetColors
   Control Set Color hDlg, %IDC_TextBox, %Black, BGColor
   Control Set Color hDlg, %IDC_ListBox, %Black, BGColor
   Graphic Color %Black, BGColor
End Sub

Sub SetMenuStatus
   'Popup Menus
    Menu Set State hPopupSetting, ByCmd %IDM_UsePageNumbers, UsePageNumbers * (%MFS_Checked Or %MFS_Enabled)
    Menu Set State hPopupSetting, ByCmd %IDM_UseBeep, UseBeep * (%MFS_Checked Or %MFS_Enabled)
    Menu Set State hPopupSetting, ByCmd %IDM_LeftRight, LeftRight * (%MFS_Checked Or %MFS_Enabled)
End Sub

Sub CreatePopupMenus
    Menu New PopUp To hPopupTextBox
    Menu Add String, hPopupTextBox, "Copy All",  %IDM_CopyAll,  %MF_Enabled
    Menu Add String, hPopupTextBox, "-",  %IDM_Sep,  %MF_Enabled
    Menu Add String, hPopupTextBox, "Save As",  %IDM_SaveAs,  %MF_Enabled

    Menu New PopUp To hPopupSetting
    Menu Add String, hPopupSetting, "Page Numbers",  %IDM_UsePageNumbers,  %MF_Enabled
    Menu Add String, hPopupSetting, "Sounds",  %IDM_UseBeep,  %MF_Enabled
    Menu Add String, hPopupSetting, "Left/Right Arrows",  %IDM_LeftRight,  %MF_Enabled
    Menu Add String, hPopupSetting, "-",  %IDM_Sep,  %MF_Enabled
    Menu Add String, hPopupSetting, "Change BG Color",  %IDM_BGColor,  %MF_Enabled
    Menu Add String, hPopupSetting, "Clear Results",  %IDM_Clear,  %MF_Enabled
    Menu Add String, hPopupSetting, "-",  %IDM_Sep,  %MF_Enabled
End Sub

Function NewTextProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Select Case Msg
      Case %WM_Command
      Case %WM_ContextMenu
'         TrackPopupMenu hPopupTextBox, %TPM_LeftAlign, Lo(Integer,LParam), Hi(Integer, LParam), 0, hDlg, ByVal 0   'put context menu where mouse is
         Function = 0 : Exit Function
   End Select
   Function = CallWindowProc(OldProc, hWnd, Msg, wParam, lParam)
End Function

Function DocumentText() As String
   Local temp$
   Open $Document For Binary As #1 : Get$ #1, Lof(1), temp$ : Close #1
   If Len(temp$) = 0 Then temp$ = " <not found>"
   Function = Trim$(temp$, $CrLf)
End Function

Sub CleanText(ExtractedText$)
   ExtractedText$ = Retain$(ExtractedText$, Any Chr$(10,13, 32 To 126, 128, 226))
   Replace Chr$(226)+Chr$(128) With "'" In ExtractedText$
   Replace $Lf With $CrLf In ExtractedText$   'Tesseract uses $LF not $CRLF
   ExtractedText$ = Trim$(ExtractedText$, Any $CrLf + $Nul + $Spc)
End Sub

Sub SaveDocumentAs
   Local hParent As Dword, title$, folder$, filter$, start$, defaultext$, flags&, filevar$, countvar&
   hParent = hDlg                               'if not parent, use 0 or %hWnd_Desktop
   title$ = ""                                   'if "", then "Save As" is used
   folder$ = PathName$(Path,$Document)           'if "", then current directory is used
   filter$ = Chr$("gbCapture", 0, "*.txt", 0)    'same as:  "BASIC" + $Nul + "*.bas" + $Nul
   start$ = PathName$(Namex,$Document)           'starting filename
   defaultext$ = "txt"
   flags& = %OFN_PathMustExist Or %OFN_Explorer Or %OFN_OverWritePrompt
   Display Savefile hParent, 100, 100, "Save File", folder$, filter$, start$, _
      defaultext$, flags& To filevar$, countvar&
                                                 '  filevar$ contains name of filename to use for Save
                                                 '  countvar$ contains number of files selected
                                                 '  if no file is selected, filevar$ = ""
   If Len(filevar$) Then MsgBox filevar$
End Sub

Sub UpdateEXE
   Statusbar Set Text hDlg, %IDC_StatusBar, 1,0, "gbCapture " + $ver + "    Updating, please wait ..."
   DeleteURLCacheEntry(URLPath)     '1 = success  clear the cache
   URLPath = "http://www.garybeene.com/files/gbcapture.exe"
   LocalPath = Exe.Path$ + "gbcapture.tmp"
   If URLDownloadToFile (Nothing, URLPath, LocalPath, 0, Nothing) = 0 Then
      If IsFile(Exe.Path$ + "gbcapture.old") Then Kill Exe.Path$ + "gbcapture.old"
      Name Exe.Path$ + "gbcapture.exe" As Exe.Path$ + "gbcapture.old"
      Name Exe.Path$ + "gbcapture.tmp" As Exe.Path$ + "gbcapture.exe"
      Restart = 1
      Statusbar Set Text hDlg, %IDC_StatusBar, 1,0, "gbCapture " + $ver + "    Update Succeeded!"
      Dialog End hDlg
   Else
      Statusbar Set Text hDlg, %IDC_StatusBar, 1,0, "gbCapture " + $ver + "    Update Failed!"
   End If
End Sub

Sub NextPageInterval
   Select Case PageInterval
      Case 250  : PageInterval = 500
      Case 500  : PageInterval = 1000
      Case 1000 : PageInterval = 1500
      Case 1500 : PageInterval = 2000
      Case 2000 : PageInterval = 2500
      Case Else : PageInterval = 250
   End Select
End Sub

Thread Function BeginCapture(ByVal X As Long) As Long
   QueryPerformanceCounter   qStart
   StopCapture = 0
   KillPriorResults
   DisplayType = 0
   ResizeWindow
   GetHandles
   CaptureImagesAndExtractText
   QueryPerformanceCounter   qStop
   Statusbar Set Text hDlg, %IDC_Statusbar, 1,0, " gbCapture " + $Ver + "   " + Time$ + "    " + Format$((qStop-qStart)/qFreq,"###.0000") + "s"
   ResizeWindow
   sBeep : sBeep
End Function

Sub CapturePageImage_DeskTop
   Local wImg,hImg As Long, hBMP, hBMPDC, hDeskTopDC As Dword

   GetWindowRect hCenterWindow, rcCenter
   hDeskTopDC = GetDC(%Null)

   wImg = rcCenter.nRight - rcCenter.nLeft - 1
   hImg = rcCenter.nBottom - rcCenter.nTop - 1

   Graphic Bitmap New wImg, hImg To hBMP
   Graphic Attach hBMP, 0
   Graphic Get DC To hBMPDC

   BitBlt hBMPDC, 0, 0, wImg, hImg, hDeskTopDC, rcCenter.nLeft, rcCenter.nTop, %SRCCopy
   ReleaseDC %Null, hDeskTopDC

   Clipboard Reset
   Clipboard Set Bitmap hBMP

   Graphic Save ImgName
   Graphic Bitmap End

   Graphic Attach hGraphic, 0, ReDraw
   Statusbar Set Text hDlg, %IDC_Statusbar, 1,0, " Image File: " + PathName$(Namex,ImgName)

End Sub

Function Settings() As String
   Local temp$, s$
   s$ = Space$(5)
   temp$ = $CrLf + s$ + "gbCapture " + $ver + $CrLf
   Select Case BGColor
      Case RGB(218,254,223) : temp$ += $CrLf + s$ + "BGColor: Green"
      Case %White           : temp$ += $CrLf + s$ + "BGColor: White"
      Case RGB(204,255,255) : temp$ += $CrLf + s$ + "BGColor: Blue"
      Case RGB(235,236,240) : temp$ += $CrLf + s$ + "BGColor: Gray"      'blue to gray
   End Select
   temp$ += $CrLf + s$ + "Use Sound: " + IIf$(UseBeep,"ON", "OFF")
   temp$ += $CrLf + s$ + "OCR MultiColumn: " + IIf$(MultiColumn,"ON", "OFF")
   temp$ += $CrLf + s$ + "Capture Method: " + IIf$(CaptureDeskTop,"DeskTop","Window")
   temp$ += $CrLf + s$ + "Page Interval: " + Str$(PageInterval)
   temp$ += $CrLf + s$ + "Navigation Icons: " + IIf$(LeftRight,"Left/Right", "Up/Down")
   temp$ += $CrLf + s$ + "Insert Page Numbers: " + IIf$(UsePageNumbers, "ON", "OFF")
   temp$ += $CrLf + s$ + "Page Capture Count: " + Str$(MaxCount)
   Function = temp$
End Function
Attached Files
gbcapture.jpg (0, 0 views)
Tags: None
Previous template Next
Announcement

Forum Guidelines

gbCapture

gbCapture
