The program below uses this code to OCR text on the screen, enabling the user to draw a border around the text to be OCR'd using a mouse. It puts the scanned text into a rtf control where the text can be tidied up, saved as a .rtf file or copied [Using CTRL-C] for pasting into a word processor eg LibreWrite for advanced formatting.
Code: Select all
EnableExplicit
XIncludeFile "OCRModule2.pbi"
UseModule WinOCR
XIncludeFile "GetScreenRegion.pbi"
UseModule ModuleGetScreenRegion
Enumeration
#MainWindow = 10
#Editor
#MainMenu
#mnuSave
#mnuClear
#mnuCopy
#HK_1 ;Constant For hot key
#IDSysTray
#TrayIcon
#PopUpTrayMenu
#mnuTrayIconShow
#mnuExit
#mnuCHMHelp
EndEnumeration
#ST_SELECTION = 2 ;Required by RTFEditor_InsertRTFText()
Global Quit=#False, MenuID, hEdit
Global strucOCR.STRUC_OCR ; Declare OCR Structure
Global bIsIconised
Macro LOWORD(value)
(value & $FFFF)
EndMacro
Macro HIWORD(value)
((value >> 16) & $FFFF)
EndMacro
Procedure CreateTrayMenu()
CreatePopupMenu(#PopUpTrayMenu)
MenuItem(#mnuTrayIconShow,"Show OCR window")
MenuItem(#mnuExit,"Exit OCR reader")
MenuItem(#mnuCHMHelp, "Help")
EndProcedure
Procedure HideOCRWindow()
If bIsIconised = #False ;Must not call AddSysTrayIcon() if icon is already shown
bIsIconised = #True
HideWindow(#MainWindow, #True)
AddSysTrayIcon(#IDSysTray, WindowID(#MainWindow), ImageID(#TrayIcon))
SysTrayIconToolTip(#IDSysTray, "OCR Screen reader")
EndIf
EndProcedure
Procedure ShowOCRWindow()
If bIsIconised = #True ; ;Must not call RemoveSysTrayIcon() if icon is not shown
bIsIconised = #False
RemoveSysTrayIcon(#IDSysTray) ;Need to do this only if window is iconised
HideWindow(#MainWindow, #False)
SetActiveWindow(#MainWindow)
SetWindowState(#MainWindow, #PB_Window_Normal)
EndIf
EndProcedure
Procedure CreateMainMenu()
CreateImageMenu(#MainMenu, WindowID(#MainWindow)) ; menu creation starts....
MenuTitle("&Actions")
MenuItem(#mnuSave, "Save")
MenuItem(#mnuCopy, "Copy Ctrl-C")
MenuItem(#mnuClear, "Clear")
MenuTitle("&Help")
MenuItem(#mnuCHMHelp, "Help")
EndProcedure
Procedure Editor_GetExtentOfFile(Filename$)
Protected ext$, FileType
ext$=Right(Filename$, 3)
If ext$="txt"
FileType=#SF_TEXT
Else
FileType=#SF_RTF
EndIf
ProcedureReturn FileType
EndProcedure
Procedure StreamSaveFileCallback(hFile, pbBuff, cb, pcb)
ProcedureReturn WriteFile_(hFile, pbBuff, cb, pcb, 0)!1
EndProcedure
Procedure GetExtentOfFile(Filename$)
Protected ext$, FileType
ext$=Right(Filename$, 3)
If ext$="txt"
FileType=#SF_TEXT
Else
FileType=#SF_RTF
EndIf
ProcedureReturn FileType
EndProcedure
Procedure.s Editor_SaveFile(hRichEd)
;This procedure requests the name of the file to which the current document is to be saved
;It will create a file with this name or, if the file exists, overwrite the existing file
;It returns the name of the file used to store the document or an empty string if the file could not be created/overwritten
Protected StreamData.EDITSTREAM, Filename$="", FileType
Protected FileID = 0; ;This can be any number to ID the file
;Filename$ = SaveFileRequester("Save file", "", "RTF (.rtf)|*.rtf", 0) ;set name of file to save
;Filename$ = SaveFileRequester("Save file", "", "RTF (.rtf)|*.rtf", 0) ;set name of file to save
Filename$ = SaveFileRequester("Save file", "", "RTF (*.rtf)|*.rtf|Text (.txt)|*.txt",0) ;set name of file to save
If Filename$=""
MessageRequester("File not saved", "A correct filename was not supplied:"+Chr(13)+Filename$, #PB_MessageRequester_Warning)
Else
FileType= GetExtentOfFile(Filename$)
If FileType=#SF_RTF And GetExtensionPart(Filename$) <> "rtf" ;[UPDATED 22 July 2021]
Filename$=Filename$+".rtf"
EndIf
If CreateFile(FileID, Filename$)
StreamData\dwCookie = FileID(FileID) ;Get window handle for the file
StreamData\dwError = #Null
StreamData\pfnCallback = @StreamSaveFileCallback() ; set the address of the callback procedure
SendMessage_(hRichEd, #EM_STREAMOUT, FileType, @StreamData)
CloseFile(FileID)
EndIf
EndIf
ProcedureReturn Filename$
EndProcedure
Procedure Editor_SetFontSize(hRichEd, Fontsize.l)
Protected format.CHARFORMAT
format\cbSize = SizeOf(CHARFORMAT)
format\dwMask = #CFM_SIZE
format\yHeight = FontSize *20
SendMessage_(hRichEd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format)
EndProcedure
Procedure Editor_ClearText(hRichEd)
Protected blankText$="", st.SETTEXTEX
SendMessage_(hRichEd, #EM_SETSEL, 0, -1) ; Select all text
st\flags = #ST_SELECTION
st\codepage = #CP_ACP ;#CP_UTF8 ;
SendMessage_(hRichEd, #EM_SETTEXTEX, @st, @blankText$)
SendMessage_(hRichEd, #EM_SETMODIFY, #False, 0) ;Clear the modified flag for the RTE
EndProcedure
Procedure RTFEditor_InsertRTFText(hRichEd, rtfText$)
;This procedure inserts text with rtf format into the rtf control at the current insertion point
;If text in the rich text editor is selected then it will be replaced by the contents of rtfText$
;hRichEd - The window handle for the rtf control
;rtfText$ - the rtf text; this must start with {\rtf
Protected RTFbuffer, st.SETTEXTEX
RTFbuffer = AllocateMemory(Len(rtfText$)+1)
If RTFbuffer
PokeS(RTFbuffer, rtfText$, #PB_Any, #PB_Ascii)
st\flags = #ST_SELECTION
st\codepage = #CP_ACP ;#CP_UTF8 ;
SendMessage_(hRichEd, #EM_SETTEXTEX, @st, RTFbuffer)
FreeMemory(RTFbuffer)
EndIf
EndProcedure
Procedure RunOCR(*strucOCR.STRUC_OCR)
;This is a thread created by OCRText()
;It OCRs the text in the selected region of the screen
*strucOCR\sLanguages = WinOCR::get_Languages()
; If *strucOCR\sFile <> ""
; *strucOCR\sFromFile = WinOCR::get_TextFromFile(*strucOCR\sFile)
; EndIf
If *strucOCR\ImageID
*strucOCR\sFromImage = WinOCR::get_TextFromImageID(*strucOCR\ImageID)
EndIf
EndProcedure
Procedure HBitmapFromScreen(X, Y, W, H)
;This creates a bitmap for the OCR to process, based on the selected region of the screen
;X, Y, W, H represents the region of the screen to process
;X and Y are the top x- and y- coordinates of the selected region
;W - the width of the selected region
;H - the height of the selected region.
Protected HDC = GetDC_(0)
Protected HBM = CreateCompatibleBitmap_(HDC, W, H)
Protected PDC = CreateCompatibleDC_(HDC)
SelectObject_(PDC, HBM)
BitBlt_(PDC, 0, 0, W, H, HDC, X, Y, #SRCCOPY)
DeleteDC_(PDC)
ReleaseDC_(0, HDC)
ProcedureReturn HBM
EndProcedure
Procedure OCRText(*strucOCR.STRUC_OCR)
Define thread = CreateThread(@RunOCR(), *strucOCR)
If thread
WaitThread(thread)
EndIf
EndProcedure
Procedure DoOCR()
strucOCR\ImageID = HBitmapFromScreen(ScreenRegion\X, ScreenRegion\Y, ScreenRegion\width, ScreenRegion\height)
OCRText(@strucOCR)
EndProcedure
Procedure MainWinCallback(WindowID, uMsg, WParam, LParam)
Protected MainWidth, MainHeight, Result
Result = #PB_ProcessPureBasicEvents
Select uMsg
Case #WM_HOTKEY
Select WParam
Case #HK_1 ;Hotkey with ref #HK_1 was pressed
HideOCRWindow() ;Needed as if window is restored under the window with text to OCR then only part of the screen is read - don't know why this is?
GetScreenRegion()
DoOCR()
;ShowWindow_(WindowID(#MainWindow),#SW_RESTORE)
ShowOCRWindow()
Editor_SetFontSize(hEdit, 12)
RTFEditor_InsertRTFText(hEdit, strucOCR\sFromImage)
EndSelect
Case #WM_SIZE ;Main window has been resized. Resize editor gadget
MainWidth = LOWORD(lParam); // width of client area of resized window
MainHeight = HIWORD(lParam); // height of client area of resized window
MoveWindow_(hEdit, #PB_Any, #PB_Any, MainWidth, MainHeight, #False)
EndSelect
ProcedureReturn Result
EndProcedure
CatchImage(#TrayIcon, ?TrayIcon)
InitDesktop()
OpenWindow(#MainWindow, #PB_Any, #PB_Any, 550, 470, "OCR screen reader", #PB_Window_Invisible | #PB_Window_SizeGadget|#PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
HideOCRWindow()
CreateMainMenu()
CreateTrayMenu()
hEdit = EditorGadget(#Editor, 10, 10, 500, 330)
Editor_SetFontSize(hEdit, 12)
SetWindowCallback(@MainWinCallback(),#MainWindow)
RegisterHotKey_(WindowID(#MainWindow), #HK_1, #MOD_SHIFT|#MOD_CONTROL|#MOD_ALT,#VK_B)
Repeat
Select WaitWindowEvent()
Case #PB_Event_Menu
MenuID=EventMenu()
Select MenuID
Case #mnuClear
Editor_ClearText(hEdit)
Case #mnuSave
Editor_SaveFile(hEdit)
Case #mnuCopy
SendMessage_(hEdit, #WM_COPY, 0, 0)
Case #mnuTrayIconShow
ShowOCRWindow()
Case #mnuExit
UnregisterHotKey_(WindowID(#MainWindow), #HK_1)
Quit = #True
Case #mnuCHMHelp
OpenHelp("OCR Screen Reader.chm", "ConvertPDFPageToText.html")
EndSelect
Case #PB_Event_MinimizeWindow:
HideOCRWindow()
Case #PB_Event_SysTray
Select EventType()
Case #PB_EventType_RightClick
DisplayPopupMenu(#PopUpTrayMenu,WindowID(#MainWindow))
Case #PB_EventType_LeftClick
ShowOCRWindow()
EndSelect
Case #PB_Event_CloseWindow
Quit=#True
UnregisterHotKey_(WindowID(#MainWindow), #HK_1)
CloseWindow(#MainWindow)
EndSelect
Until Quit=#True
End
DataSection
TrayIcon:
IncludeBinary "OCRScreenReader.ico"
EndDataSection
Code: Select all
;This module is taken from the code at https://www.purebasic.fr/english/viewtopic.php?f=12&t=77835
; - Thanks to fryquez
;To use this module in another module, use:
;XIncludeFile "OCRModule.pbi"
;UseModule WinOCR
EnableExplicit
DeclareModule WinOCR
Structure STRUC_OCR ;{
sFile.s
ImageID.i
;
sLanguages.s
sFromFile.s
sFromImage.s
EndStructure ;}
Declare.s get_Languages()
Declare.s get_TextFromFile(sFile.s, sLanguage.s = "")
Declare.s get_TextFromImageID(ImageID, sLanguage.s = "")
Declare.s get_TextFromHWND(ImageID, sLanguage.s = "")
;
Declare get_FacesFromFile(sFile.s, List rcList.rect())
Declare get_FacesFromImageID(ImageID, List rcList.rect())
Declare get_FacesFromHWND(hWNd, List rcList.rect())
EndDeclareModule
Module WinOCR
;Credits - Malcev @autohotkey.com
;https://www.autohotkey.com/boards/viewtopic.php?t=72674
;https://www.autohotkey.com/boards/viewtopic.php?t=72797
EnableExplicit
#MyRoDebug = 0
;- Interfaces
Interface IInspectable Extends IUnknown
GetIids(*iidCount, *iids)
GetRuntimeClassName(*className)
GetTrustLevel(*trustLevel)
EndInterface
Interface IClosable Extends IInspectable
Close()
EndInterface
Interface ILanguageFactory Extends IInspectable
createLanguage(*string, *out)
EndInterface
Interface ILanguage Extends IInspectable
get_LanguageTag(*value)
get_DisplayName(*value)
get_NativeName(*value)
get_Script(*value)
EndInterface
Interface IBitmapDecoderStatics Extends IInspectable
BmpDecoderId(*value.guid)
JpegDecoderId(*value.guid)
PngDecoderId(*value.guid)
TiffDecoderId(*value.guid)
GifDecoderId(*value.guid)
JpegXRDecoderId(*value.guid)
IcoDecoderId(*value.guid)
GetDecoderInformationEnumerator(*out)
CreateAsync(*in, *out)
CreateWithIdAsync(*decoderId.guid, *in, *out)
EndInterface
Interface IBitmapDecoder Extends IInspectable
BitmapContainerProperties(*value)
DecoderInformation(*value)
FrameCount(*value)
GetPreviewAsync(*value)
GetFrameAsync(frameIndex, *value)
EndInterface
Interface IBitmapFrameWithSoftwareBitmap Extends IInspectable
GetSoftwareBitmapAsync(*value)
GetSoftwareBitmapConvertedAsync(pixelFormat, alphaMode, *value)
GetSoftwareBitmapTransformedAsync(pixelFormat, alphaMode, transform, exifOrientationMode, colorManagementMode, *value)
EndInterface
Interface IBitmapFrame Extends IInspectable
GetThumbnailAsync(*asyncInfo)
BitmapProperties(*value)
BitmapPixelFormat(*value)
BitmapAlphaMode(*value)
DpiX(*value)
DpiY(*value)
PixelWidth(*value)
PixelHeight(*value)
OrientedPixelWidth(*value)
OrientedPixelHeight(*value)
GetPixelDataAsync(*asyncInfo)
GetPixelDataTransformedAsync(pixelFormat, alphaMode, transform, exifOrientationMode, colorManagementMode, *asyncInfo)
EndInterface
Interface ISoftwareBitmap Extends IInspectable
get_BitmapPixelFormat(*value)
get_BitmapAlphaMode(*value)
get_PixelWidth(*value)
get_PixelHeight(*value)
get_IsReadOnly(*value)
put_DpiX(*value)
get_DpiX(*value)
put_DpiY(*value)
get_DpiY(*value)
LockBuffer(mode, *value)
CopyTo(*bitmap)
CopyFromBuffer(*buffer)
GetReadOnlyView(*value)
EndInterface
Interface IOcrEngineStatics Extends IInspectable
MaxDimensions(*value)
AvailableRecognizerLanguages(*value)
IsLanguageSupported(*Language,*Result)
TryCreateFromLanguage(*Language,*Result)
TryCreateFromUserProfileLanguages(*Result)
EndInterface
Interface IOcrEngine Extends IInspectable
RecognizeAsync(*bitmap, *result)
RecognizerLanguage(*value)
EndInterface
Interface IOcrResult Extends IInspectable
Lines(*value)
TextAngle(*value)
Text(*value)
EndInterface
Interface IRandomAccessStream Extends IInspectable
get_Size(*value)
put_Size(*value)
GetInputStreamAt(position.q, *stream)
GetOutputStreamAt(position.q, *stream)
get_Position(*value)
Seek(position.q)
CloneStream(*stream)
get_CanRead(*value)
get_CanWrite(*value)
EndInterface
Interface IAsyncInfo Extends IInspectable
Id(*id)
Status(*status)
ErrorCode(*errorCode)
Cancel()
Close()
EndInterface
Interface IAsyncOperationWithProgress Extends IInspectable
Completed(asyncInfo, asyncStatus)
Progress(asyncInfo, progressInfo)
GetResults(*Object)
EndInterface
Interface IGlobalizationPreferencesStatics Extends IInspectable
get_Calendars(*value)
get_Clocks(*value)
get_Currencies(*value)
get_Languages(*value)
get_HomeGeographicRegion(*value)
get_WeekStartsOn(*value)
EndInterface
Interface IReadOnlyList Extends IInspectable
get_Item(index, *hString)
count(*value)
EndInterface
Interface IFaceDetectorStatics Extends IInspectable
CreateAsync(*returnValue)
GetSupportedBitmapPixelFormats(*result)
IsBitmapPixelFormatSupported(bitmapPixelFormat, *result)
IsSupported(*returnValue)
EndInterface
Interface IFaceDetector Extends IInspectable
DetectFacesAsync(image, *returnValue)
DetectFacesWithSearchAreaAsync(image, searchArea, *returnValue)
MinDetectableFaceSize(*value)
MaxDetectableFaceSize(*value)
EndInterface
Interface IBitmapEncoderStatics Extends IInspectable
get_BmpEncoderId(*value)
get_JpegEncoderId(*value)
get_PngEncoderId(*value)
get_TiffEncoderId(*value)
get_GifEncoderId(*value)
get_JpegXREncoderId(*value)
GetEncoderInformationEnumerator(*encoderInformationEnumerator)
CreateAsync(encoderId, *stream, *asyncInfo)
CreateWithEncodingOptionsAsync(encoderId, stream, *encodingOptions, *asyncInfo)
CreateForTranscodingAsync(stream, bitmapDecoder, *asyncInfo)
CreateForInPlacePropertyEncodingAsync(stream, bitmapDecoder, *asyncInfo)
EndInterface
Interface ISoftwareBitmapStatics Extends IInspectable
Copy(*source, *value)
Convert(*source, format, *value)
ConvertWithAlpha(*source, format, alpha, *value)
CreateCopyFromBuffer(*source, format, width, height, *value)
CreateCopyWithAlphaFromBuffer(*source, format, width, height, alpha, *value)
CreateCopyFromSurfaceAsync(surface, *value)
CreateCopyWithAlphaFromSurfaceAsync(surface, alpha, *value)
EndInterface
Interface IBitmapEncoder Extends IInspectable
EncoderInformation(*value)
BitmapProperties(*value)
BitmapContainerProperties(*value)
IsThumbnailGenerated(*value)
GeneratedThumbnailWidth(*value)
GeneratedThumbnailHeight(*value)
BitmapTransform(*value)
SetPixelData(pixelFormat, alphaMode, width, height, dpiX.d, dpiY.d, __pixelsSize, *pixels)
GoToNextFrameAsync(*asyncInfo)
GoToNextFrameWithEncodingOptionsAsync(encodingOptions, *asyncInfo)
FlushAsync(*asyncInfo)
EndInterface
Interface IBitmapTransform Extends IInspectable
ScaledWidth(*value)
ScaledHeight(*value)
InterpolationMode(*value)
Flip(*value)
Rotation(*value)
Bounds(*value)
EndInterface
Interface IDetectedFace Extends IInspectable
FaceBox(*returnValue)
EndInterface
;-
;- DataSection
DataSection
IID_IBitmapFrame:
Data.l $72A49A1C
Data.w $8081, $438D
Data.b $91, $BC, $94, $EC, $FC, $81, $85, $C6
IID_IRandomAccessStream:
Data.l $905A0FE1
Data.w $BC53, $11DF
Data.b $8C, $49, $0, $1E, $4F, $C6, $86, $DA
IID_IClosable:
Data.l $30D5A829
Data.w $7FA4, $4026
Data.b $83, $BB, $D7, $5B, $AE, $4E, $A9, $9E
IID_IBitmapFrameWithSoftwareBitmap:
Data.l $FE287C9A
Data.w $420C, $4963
Data.b $87, $AD, $69, $14, $36, $E0, $83, $83
IID_IAsyncInfo:
Data.l $00000036
Data.w $00, $00
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IPicture:
Data.l $7BF80980
Data.w $BF32, $101A
Data.b $8B, $BB, $00, $AA, $0, $30, $0C, $AB
IID_ILanguageFactory:
Data.l $9B0252AC
Data.w $C27, $44F8
Data.b $B7, $92, $97, $93, $FB, $66, $C6, $3E
IID_IBitmapDecoderStatics:
Data.l $438CCB26
Data.w $BCEF, $4E95
Data.b $BA, $D6, $23, $A8, $22, $E5, $8D, $01
IID_IOcrEngineStatics:
Data.l $5BFFA85A
Data.w $3384, $3540
Data.b $99, $40, $69, $91, $20, $D4, $28, $A8
IID_IGlobalizationPreferencesStatics:
Data.l $1BF4326
Data.w $ED37, $4E96
Data.b $B0, $E9, $C1, $34, $0D, $1E, $A1, $58
EndDataSection
Prototype pRoInitialize(initType)
Prototype pWindowsCreateString(a, b, c)
Prototype pRoGetActivationFactory(a, b, c)
Prototype pWindowsDeleteString(a)
Prototype pWindowsGetStringRawBuffer(a, length)
Prototype pCreateRandomAccessStreamOnFile(file, iRead, *GUID, *out)
Prototype pCreateRandomAccessStreamOverStream(*stream, options, *riid, *ppv)
Structure DynamicRuntimeFuncs
WindowsCreateString.pWindowsCreateString
WindowsDeleteString.pWindowsDeleteString
RoGetActivationFactory.pRoGetActivationFactory
WindowsGetStringRawBuffer.pWindowsGetStringRawBuffer
CreateRandomAccessStreamOnFile.pCreateRandomAccessStreamOnFile
CreateRandomAccessStreamOverStream.pCreateRandomAccessStreamOverStream
RoInitialize.pRoInitialize
EndStructure
Global RT_Funcs.DynamicRuntimeFuncs
Global RT_INIT_DONE
Structure MyRTIntArray
i.i[0]
EndStructure
;-
;- HelperFuncs
;-
Procedure RT_Init()
Protected hr.l
#RO_INIT_SINGLETHREADED = 0
#RO_INIT_MULTITHREADED = 1
Protected hCombase = OpenLibrary(#PB_Any, "combase.dll")
If Not hCombase
ProcedureReturn 0
EndIf
RT_Funcs\WindowsCreateString = GetFunction(hCombase, "WindowsCreateString")
RT_Funcs\WindowsDeleteString = GetFunction(hCombase, "WindowsDeleteString")
RT_Funcs\RoGetActivationFactory = GetFunction(hCombase, "RoGetActivationFactory")
RT_Funcs\WindowsGetStringRawBuffer = GetFunction(hCombase, "WindowsGetStringRawBuffer")
RT_Funcs\RoInitialize = GetFunction(hCombase, "RoInitialize")
hCombase = OpenLibrary(#PB_Any, "SHCore.dll")
If Not hCombase
ProcedureReturn 0
EndIf
RT_Funcs\CreateRandomAccessStreamOnFile = GetFunction(hCombase, "CreateRandomAccessStreamOnFile")
RT_Funcs\CreateRandomAccessStreamOverStream = GetFunction(hCombase, "CreateRandomAccessStreamOverStream")
RT_INIT_DONE = 1
Protected *i.MyRTIntArray = @RT_Funcs, i
For i = 0 To (SizeOf(RT_Funcs) / SizeOf(Integer)) - 1
If Not *i\i[i]
RT_INIT_DONE = 0
Break
EndIf
Next
If RT_INIT_DONE
hr = RT_Funcs\RoInitialize(#RO_INIT_MULTITHREADED)
CompilerIf #MyRoDebug : Debug "RoInitialize = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
;RPC_E_CHANGED_MODE = $80010106
EndIf
ProcedureReturn RT_INIT_DONE
EndProcedure
Procedure CreateHString(sString.s, *hString)
ProcedureReturn RT_Funcs\WindowsCreateString(@sString, Len(sString), *hString)
EndProcedure
Procedure DeleteHString(*hString)
ProcedureReturn RT_Funcs\WindowsDeleteString(*hString)
EndProcedure
Procedure CreateClass(sString.s, sGUID.s, *OutClass)
Protected hString, GUID.GUID, iReturn
CreateHString(sString, @hString)
CLSIDFromString_(@sGUID, @GUID)
iReturn = RT_Funcs\RoGetActivationFactory(hString, @GUID, *OutClass)
RT_Funcs\WindowsDeleteString(hString)
ProcedureReturn iReturn
EndProcedure
Procedure WaitForAsync(*InOut.Integer)
Protected *Object.IAsyncOperationWithProgress = *InOut\i
Protected IAsyncInfo.IAsyncInfo, status.l, ErrorCode.l, hr.l
hr = *Object\QueryInterface(?IID_IAsyncInfo, @IAsyncInfo)
;Debug "WaitForAsync QueryInterface = 0x" + Hex(hr)
If Not IAsyncInfo
Debug "ER QueryInterface IID_IAsyncInfo failed!"
ProcedureReturn 0
EndIf
While 1
hr = IAsyncInfo\Status(@status)
; Debug "IAsyncInfo::Status = 0x" + Hex(hr) + " - " + Hex(status)
If (status <> 0)
If (status <> 1)
IAsyncInfo\ErrorCode(@ErrorCode)
Debug "ER IAsyncInfo status error 0x" + Hex(ErrorCode, #PB_Long)
End
EndIf
IAsyncInfo\Release()
Break
EndIf
Sleep_(10)
Wend
Protected ObjectResult
*Object\GetResults(@ObjectResult)
If ObjectResult
*Object\Release()
*InOut\i = ObjectResult
EndIf
ProcedureReturn ObjectResult
EndProcedure
Procedure FileToRandomAccessStream(sFile.s)
If Not RT_INIT_DONE
RT_Init()
If Not RT_INIT_DONE
ProcedureReturn 0
EndIf
EndIf
Protected IRandomAccessStream.IRandomAccessStream
Protected hr.l = RT_Funcs\CreateRandomAccessStreamOnFile(@sFile, 0, ?IID_IRandomAccessStream, @IRandomAccessStream)
CompilerIf #MyRoDebug : Debug "CreateRandomAccessStreamOnFile = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
ProcedureReturn IRandomAccessStream
EndProcedure
Structure PICTDESC_bmp
hbitmap.i
hpal.i
EndStructure
Structure PICTDESC_wmf
hmete.i
xExt.l
yExt.l
EndStructure
Structure PICTDESC_icon
hicon.i
EndStructure
Structure PICTDESC_emf
hemf.i
EndStructure
Structure PICTDESC
cbSizeofstruct.l
picType.l
StructureUnion
bmp.PICTDESC_bmp
wmf.PICTDESC_wmf
icon.PICTDESC_icon
emf.PICTDESC_emf
EndStructureUnion
EndStructure
Procedure HBitmapToRandomAccessStream(hBitmap)
If Not RT_INIT_DONE
RT_Init()
If Not RT_INIT_DONE
ProcedureReturn 0
EndIf
EndIf
Protected pIStream.IStream, pIPicture.IPicture, hr.l
hr = CreateStreamOnHGlobal_(0, #True, @pIStream)
If pIStream
#PICTYPE_BITMAP = 1
Protected PD.PICTDESC
PD\cbSizeofstruct = SizeOf(PICTDESC)
PD\picType = #PICTYPE_BITMAP
PD\bmp\hbitmap = hBitmap
hr = OleCreatePictureIndirect_(@PD, ?IID_IPicture, #False, @pIPicture)
If pIPicture
Protected cbSize
hr = pIPicture\SaveAsFile(pIStream, #True, 0)
Protected pIRandomAccessStream.IRandomAccessStream
#BSOS_DEFAULT = 0
hr = RT_Funcs\CreateRandomAccessStreamOverStream(pIStream, #BSOS_DEFAULT, ?IID_IRandomAccessStream, @pIRandomAccessStream)
pIPicture\Release()
EndIf
pIStream\Release()
EndIf
ProcedureReturn pIRandomAccessStream
EndProcedure
Procedure HBitmapFromHWND(hWnd, x = 0, y = 0, w = 0, h = 0)
Protected HDC, rc.rect, HBM, PDC
HDC = GetDC_(hWnd)
If HDC
GetWindowRect_(hWnd, @rc)
If w = 0 : w = rc\right - rc\left : EndIf
If h = 0 : h = rc\bottom - rc\top : EndIf
HBM = CreateCompatibleBitmap_(HDC, W, H)
If HBM
PDC = CreateCompatibleDC_(HDC)
If PDC
SelectObject_(PDC, HBM)
BitBlt_(PDC, 0, 0, W, H, HDC, X, Y, #SRCCOPY)
DeleteDC_(PDC)
EndIf
EndIf
ReleaseDC_(hWnd, HDC)
EndIf
ProcedureReturn HBM
EndProcedure
;-
;- WorkerFuncs
;-
Procedure.s GetOCRFromImage(IRandomAccessStream.IRandomAccessStream, sLanguage.s = "", bReturnLanguages = 0)
If Not RT_INIT_DONE
RT_Init()
If Not RT_INIT_DONE
ProcedureReturn ""
EndIf
EndIf
Static ILanguageFactory.ILanguageFactory
Static IBitmapDecoderStatics.IBitmapDecoderStatics
Static IOcrEngineStatics.IOcrEngineStatics
Static IGlobalizationPreferencesStatics.IGlobalizationPreferencesStatics
Static MaxDimension
Protected hString, hr.l, bSupported, i, sOCRText.s
Protected hText, length, *p, count, hLanguage, iFrames, width, height, iUsedLanguage
Protected IOcrEngine.IOcrEngine
Protected ILanguageList.IReadOnlyList
Protected ILanguageTest.ILanguage
Protected IBitmapDecoder.IBitmapDecoder
Protected IBitmapFrame.IBitmapFrame
Protected IClosable.IClosable
Protected IOcrResult.IOcrResult
Protected ILinesList.IReadOnlyList
Protected IBitmapFrameWithSoftwareBitmap.IBitmapFrameWithSoftwareBitmap
Protected ISoftwareBitmap.ISoftwareBitmap
Protected IOCRLine.ILanguage
If ILanguageFactory = 0 Or
IBitmapDecoderStatics = 0 Or
IOcrEngineStatics = 0 Or
IGlobalizationPreferencesStatics = 0
hr = CreateClass("Windows.Globalization.Language", "{9B0252AC-0C27-44F8-B792-9793FB66C63E}", @ILanguageFactory)
CompilerIf #MyRoDebug : Debug "CreateClass Windows.Globalization.Language = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = CreateClass("Windows.Graphics.Imaging.BitmapDecoder", "{438CCB26-BCEF-4E95-BAD6-23A822E58D01}", @IBitmapDecoderStatics)
CompilerIf #MyRoDebug : Debug "CreateClass Windows.Graphics.Imaging.BitmapDecoder = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = CreateClass("Windows.Media.Ocr.OcrEngine", "{5BFFA85A-3384-3540-9940-699120D428A8}", @IOcrEngineStatics)
CompilerIf #MyRoDebug : Debug "CreateClass Windows.Media.Ocr.OcrEngine = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = CreateClass("Windows.System.UserProfile.GlobalizationPreferences", "{01BF4326-ED37-4E96-B0E9-C1340D1EA158}", @IGlobalizationPreferencesStatics)
CompilerIf #MyRoDebug : Debug "CreateClass Windows.System.UserProfile.GlobalizationPreferences = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
EndIf
If ILanguageFactory = 0 Or
IBitmapDecoderStatics = 0 Or
IOcrEngineStatics = 0 Or
IGlobalizationPreferencesStatics = 0
Goto Release
EndIf
If Not MaxDimension
IOcrEngineStatics\MaxDimensions(@MaxDimension)
EndIf
If sLanguage = ""
hr = IGlobalizationPreferencesStatics\get_Languages(@ILanguageList)
CompilerIf #MyRoDebug : Debug "IGlobalizationPreferencesStatics::get_Languages = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If ILanguageList
hr = ILanguageList\count(@count)
CompilerIf #MyRoDebug : Debug "ILanguageList::count = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
For i = 0 To count -1
hr = ILanguageList\get_Item(0, @hString)
CompilerIf #MyRoDebug : Debug "ILanguageList::get_Item = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = ILanguageFactory\createLanguage(hString, @ILanguageTest)
CompilerIf #MyRoDebug : Debug "ILanguageFactory::createLanguage = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If ILanguageTest
hr = IOcrEngineStatics\IsLanguageSupported(ILanguageTest, @bSupported)
CompilerIf #MyRoDebug : Debug "IOcrEngineStatics::IsLanguageSupported = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If bSupported
hText = 0
ILanguageTest\get_LanguageTag(@hText)
CompilerIf #MyRoDebug : Debug "ILanguageTest::get_LanguageTag = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If hText
*p = RT_Funcs\WindowsGetStringRawBuffer(hText, @length)
If *p
sLanguage = PeekS(*p)
If bReturnLanguages
sOCRText + sLanguage + #CRLF$
EndIf
;Debug sLanguage
EndIf
EndIf
EndIf
ILanguageTest\Release()
EndIf
Next
ILanguageList\Release()
EndIf
EndIf
If bReturnLanguages
Goto Release
EndIf
hString = 0
CreateHString(sLanguage, @hString)
If hString
hr = ILanguageFactory\createLanguage(hString, @iUsedLanguage)
CompilerIf #MyRoDebug : Debug "ILanguageFactory::createLanguage = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = RT_Funcs\WindowsDeleteString(hString)
CompilerIf #MyRoDebug : Debug "WindowsDeleteString = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IOcrEngineStatics\TryCreateFromLanguage(iUsedLanguage, @IOcrEngine)
CompilerIf #MyRoDebug : Debug "IOcrEngineStatics::TryCreateFromLanguage = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IOcrEngine
If IRandomAccessStream
hr = IBitmapDecoderStatics\CreateAsync(IRandomAccessStream, @IBitmapDecoder)
CompilerIf #MyRoDebug : Debug "IBitmapDecoderStatics::CreateAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IBitmapDecoder
WaitForAsync(@IBitmapDecoder)
hr = IBitmapDecoder\FrameCount(@iFrames)
CompilerIf #MyRoDebug : Debug "IBitmapDecoder::FrameCount = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IBitmapDecoder\QueryInterface(?IID_IBitmapFrame, @IBitmapFrame)
CompilerIf #MyRoDebug : Debug "IBitmapDecoder::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IBitmapFrame
hr = IBitmapFrame\PixelWidth(@width)
CompilerIf #MyRoDebug : Debug "IBitmapFrame::PixelWidth = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IBitmapFrame\PixelHeight(@height)
CompilerIf #MyRoDebug : Debug "IBitmapFrame::PixelHeight = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If width > MaxDimension Or height > MaxDimension
Debug "ER: Image is to big"
Else
hr = IBitmapDecoder\QueryInterface(?IID_IBitmapFrameWithSoftwareBitmap, @IBitmapFrameWithSoftwareBitmap)
CompilerIf #MyRoDebug : Debug "IBitmapDecoder::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IBitmapFrameWithSoftwareBitmap
hr = IBitmapFrameWithSoftwareBitmap\GetSoftwareBitmapAsync(@ISoftwareBitmap)
CompilerIf #MyRoDebug : Debug "IBitmapFrameWithSoftwareBitmap::GetSoftwareBitmapAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If ISoftwareBitmap
WaitForAsync(@ISoftwareBitmap)
IOcrEngine\RecognizeAsync(ISoftwareBitmap, @IOcrResult)
CompilerIf #MyRoDebug : Debug "IOcrEngine::RecognizeAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IOcrResult
WaitForAsync(@IOcrResult)
hr = IOcrResult\Lines(@ILinesList)
CompilerIf #MyRoDebug : Debug "IOcrResult::Lines = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If ILinesList
count = 0
hr = ILinesList\count(@count)
CompilerIf #MyRoDebug : Debug "ILinesList::count = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
For i = 0 To count -1
hText = 0
hr = ILinesList\get_Item(i, @IOCRLine)
CompilerIf #MyRoDebug : Debug "ILinesList::get_Item = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IOCRLine\get_DisplayName(@hText)
CompilerIf #MyRoDebug : Debug "IOCRLine::get_DisplayName = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If hText
*p = RT_Funcs\WindowsGetStringRawBuffer(hText, 0)
If *p
sOCRText + PeekS(*p) + #CRLF$
EndIf
EndIf
IOCRLine\Release()
Next
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
If ISoftwareBitmap
hr = ISoftwareBitmap\QueryInterface(?IID_IClosable, @IClosable)
CompilerIf #MyRoDebug : Debug "ISoftwareBitmap::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IClosable
IClosable\Close()
IClosable\Release()
IClosable = 0
EndIf
EndIf
EndIf
IOcrEngine\Release()
EndIf
EndIf
Release:
If IBitmapDecoder : IBitmapDecoder\Release() : EndIf
If IBitmapFrame : IBitmapFrame\Release() : EndIf
If IBitmapFrameWithSoftwareBitmap : IBitmapFrameWithSoftwareBitmap\Release() : EndIf
If ISoftwareBitmap : ISoftwareBitmap\Release() : EndIf
If IOcrResult : IOcrResult\Release() : EndIf
If ILinesList : ILinesList\Release() : EndIf
CompilerIf #MyRoDebug : Debug "### Func End ###" + #CRLF$ : CompilerEndIf
ProcedureReturn sOCRText
EndProcedure
Procedure FaceDetect(IRandomAccessStream, List rcList.rect(), maxheight = 2000)
Static IBitmapDecoderStatics.IBitmapDecoderStatics
Static IBitmapEncoderStatics.IBitmapEncoderStatics
Static ISoftwareBitmapStatics.ISoftwareBitmapStatics
Static IFaceDetectorStatics.IFaceDetectorStatics
Protected IFaceDetector.IFaceDetector
Protected IReadOnlyList.IReadOnlyList
Protected IBitmapDecoder.IBitmapDecoder
Protected IBitmapEncoder.IBitmapEncoder
Protected IBitmapFrame.IBitmapFrame
Protected IBitmapFrameWithSoftwareBitmap.IBitmapFrameWithSoftwareBitmap
Protected IBitmapTransform.IBitmapTransform
Protected ISoftwareBitmap.ISoftwareBitmap, ISoftwareBitmapTemp.ISoftwareBitmap
Protected IClosable.IClosable
Protected IDetectedFaceList.IReadOnlyList
Protected IDetectedFace.IDetectedFace
Protected hr.l, iCount, i, hString, *p
Protected BitmapPixelFormat
Protected sSupportedBitmapPixelFormats.s
Protected width, height, rc.rect
If Not RT_INIT_DONE
RT_Init()
If Not RT_INIT_DONE
ProcedureReturn 0
EndIf
EndIf
If IBitmapDecoderStatics = 0 Or
IBitmapEncoderStatics = 0 Or
ISoftwareBitmapStatics = 0 Or
IFaceDetectorStatics = 0
hr = CreateClass("Windows.Graphics.Imaging.BitmapDecoder", "{438CCB26-BCEF-4E95-BAD6-23A822E58D01}", @IBitmapDecoderStatics)
CompilerIf #MyRoDebug : Debug "CreateClass Windows.Graphics.Imaging.BitmapDecoder = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = CreateClass("Windows.Graphics.Imaging.BitmapEncoder", "{A74356A7-A4E4-4EB9-8E40-564DE7E1CCB2}", @IBitmapEncoderStatics)
CompilerIf #MyRoDebug : Debug "CreateClass Windows.Graphics.Imaging.BitmapEncoder = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = CreateClass("Windows.Graphics.Imaging.SoftwareBitmap", "{DF0385DB-672F-4A9D-806E-C2442F343E86}", @ISoftwareBitmapStatics)
CompilerIf #MyRoDebug : Debug "CreateClass Windows.Graphics.Imaging.SoftwareBitmap = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = CreateClass("Windows.Media.FaceAnalysis.FaceDetector", "{BC042D67-9047-33F6-881B-6746C1B218B8}", @IFaceDetectorStatics)
CompilerIf #MyRoDebug : Debug "CreateClass Windows.Media.FaceAnalysis.FaceDetector = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
EndIf
If IBitmapDecoderStatics = 0 Or
IBitmapEncoderStatics = 0 Or
ISoftwareBitmapStatics = 0 Or
IFaceDetectorStatics = 0
Goto Release
EndIf
hr = IFaceDetectorStatics\CreateAsync(@IFaceDetector)
CompilerIf #MyRoDebug : Debug "IFaceDetectorStatics::CreateAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IFaceDetector
WaitForAsync(@IFaceDetector)
hr = IFaceDetectorStatics\GetSupportedBitmapPixelFormats(@IReadOnlyList)
CompilerIf #MyRoDebug : Debug "IFaceDetectorStatics::GetSupportedBitmapPixelFormats = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IReadOnlyList
hr = IReadOnlyList\count(@iCount)
CompilerIf #MyRoDebug : Debug "IReadOnlyList::count = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
For i = 0 To iCount -1
hr = IReadOnlyList\get_Item(i, @BitmapPixelFormat)
CompilerIf #MyRoDebug : Debug "ILanguageList::get_Item = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
sSupportedBitmapPixelFormats + "|" + Str(BitmapPixelFormat) + "|"
Next
IReadOnlyList\Release()
EndIf
IFaceDetectorStatics\Release()
EndIf
hr = IBitmapDecoderStatics\CreateAsync(IRandomAccessStream, @IBitmapDecoder)
CompilerIf #MyRoDebug : Debug "IBitmapDecoderStatics::CreateAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IBitmapDecoder
WaitForAsync(@IBitmapDecoder)
hr = IBitmapDecoder\QueryInterface(?IID_IBitmapFrame, @IBitmapFrame)
CompilerIf #MyRoDebug : Debug "IBitmapDecoder::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IBitmapFrame
hr = IBitmapFrame\PixelWidth(@width)
CompilerIf #MyRoDebug : Debug "IBitmapFrame::PixelWidth = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IBitmapFrame\PixelHeight(@height)
CompilerIf #MyRoDebug : Debug "IBitmapFrame::PixelHeight = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IBitmapFrame\BitmapPixelFormat(@BitmapPixelFormat)
CompilerIf #MyRoDebug : Debug "IBitmapFrame::BitmapPixelFormat = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IBitmapDecoder\QueryInterface(?IID_IBitmapFrameWithSoftwareBitmap, @IBitmapFrameWithSoftwareBitmap)
CompilerIf #MyRoDebug : Debug "IBitmapDecoder::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IBitmapFrameWithSoftwareBitmap
If (height > maxheight)
hr = IBitmapEncoderStatics\CreateForTranscodingAsync(IRandomAccessStream, IBitmapDecoder, @IBitmapEncoder)
CompilerIf #MyRoDebug : Debug "IBitmapEncoderStatics::CreateForTranscodingAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IBitmapEncoder
WaitForAsync(@IBitmapEncoder)
hr = IBitmapEncoder\BitmapTransform(@IBitmapTransform)
CompilerIf #MyRoDebug : Debug "IBitmapEncoder::BitmapTransform = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IBitmapTransform
hr = IBitmapTransform\ScaledWidth((maxheight/height*width))
CompilerIf #MyRoDebug : Debug "IBitmapTransform::ScaledWidth = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IBitmapTransform\ScaledHeight(maxheight)
CompilerIf #MyRoDebug : Debug "IBitmapTransform::ScaledHeight = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IBitmapFrameWithSoftwareBitmap\GetSoftwareBitmapTransformedAsync(BitmapPixelFormat, 0, IBitmapTransform, 0, 0, @ISoftwareBitmap)
CompilerIf #MyRoDebug : Debug "IBitmapFrameWithSoftwareBitmap::GetSoftwareBitmapTransformedAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
EndIf
EndIf
Else
hr = IBitmapFrameWithSoftwareBitmap\GetSoftwareBitmapAsync(@ISoftwareBitmap)
CompilerIf #MyRoDebug : Debug "IBitmapFrameWithSoftwareBitmap::GetSoftwareBitmapTransformedAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
EndIf
If ISoftwareBitmap
WaitForAsync(@ISoftwareBitmap)
If Not FindString(sSupportedBitmapPixelFormats, "|" + BitmapPixelFormat + "|")
hr = ISoftwareBitmapStatics\Convert(ISoftwareBitmap, 62, @ISoftwareBitmapTemp)
CompilerIf #MyRoDebug : Debug "ISoftwareBitmapStatics::Convert = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = ISoftwareBitmap\QueryInterface(?IID_IClosable, @IClosable)
If IClosable
IClosable\Close()
IClosable\Release()
EndIf
ISoftwareBitmap\Release()
ISoftwareBitmap = ISoftwareBitmapTemp
EndIf
hr = IFaceDetector\DetectFacesAsync(ISoftwareBitmap, @IDetectedFaceList)
CompilerIf #MyRoDebug : Debug "IFaceDetector\DetectFacesAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IDetectedFaceList
WaitForAsync(@IDetectedFaceList)
hr = IDetectedFaceList\count(@iCount)
CompilerIf #MyRoDebug : Debug "IDetectedFaceList::count = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
For i = 0 To iCount -1
hr = IDetectedFaceList\get_Item(i, @IDetectedFace)
CompilerIf #MyRoDebug : Debug "IDetectedFaceList::get_Item = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IDetectedFace
AddElement(rcList())
hr = IDetectedFace\FaceBox(@rcList())
CompilerIf #MyRoDebug : Debug "IDetectedFace::FaceBox = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
IDetectedFace\Release()
IDetectedFace = 0
EndIf
Next
EndIf
hr = ISoftwareBitmap\QueryInterface(?IID_IClosable, @IClosable)
CompilerIf #MyRoDebug : Debug "ISoftwareBitmap::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IClosable
IClosable\Close()
IClosable\Release()
IClosable = 0
EndIf
EndIf
EndIf
EndIf
EndIf
Release:
If IBitmapDecoder : IBitmapDecoder\Release() : EndIf
If IBitmapFrame : IBitmapFrame\Release() : EndIf
If (height > maxheight)
If IBitmapEncoder : IBitmapEncoder\Release() : EndIf
If IBitmapTransform : IBitmapTransform\Release() : EndIf
EndIf
If IBitmapFrameWithSoftwareBitmap : IBitmapFrameWithSoftwareBitmap\Release() : EndIf
If IDetectedFaceList : IDetectedFaceList\Release() : EndIf
If IFaceDetector : IFaceDetector\Release() : EndIf
EndProcedure
;-
;- Module Exports
;-
Procedure.s get_Languages()
ProcedureReturn GetOCRFromImage(0, "", 1)
EndProcedure
Procedure.s get_TextFromFile(sFile.s, sLanguage.s = "")
Protected sOutPut.s
Protected IRandomAccessStream.IRandomAccessStream = FileToRandomAccessStream(sFile)
If IRandomAccessStream
sOutPut = GetOCRFromImage(IRandomAccessStream, sLanguage, 0)
Protected IClosable.IClosable
Protected hr.l = IRandomAccessStream\QueryInterface(?IID_IClosable, @IClosable)
CompilerIf #MyRoDebug : Debug "IRandomAccessStream::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IClosable
IClosable\Close()
IClosable\Release()
IClosable = 0
EndIf
IRandomAccessStream\Release()
EndIf
ProcedureReturn sOutPut
EndProcedure
Procedure.s get_TextFromImageID(ImageID, sLanguage.s = "")
Protected sOutPut.s
Protected IRandomAccessStream.IRandomAccessStream = HBitmapToRandomAccessStream(ImageID)
If IRandomAccessStream
sOutPut = GetOCRFromImage(IRandomAccessStream, sLanguage, 0)
Protected IClosable.IClosable
Protected hr.l = IRandomAccessStream\QueryInterface(?IID_IClosable, @IClosable)
CompilerIf #MyRoDebug : Debug "IRandomAccessStream::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IClosable
IClosable\Close()
IClosable\Release()
IClosable = 0
EndIf
IRandomAccessStream\Release()
EndIf
ProcedureReturn sOutPut
EndProcedure
Procedure.s get_TextFromHWND(hWND, sLanguage.s = "")
Protected sOutPut.s
Protected ImageID = HBitmapFromHWND(hWND)
If ImageID
Protected IRandomAccessStream.IRandomAccessStream = HBitmapToRandomAccessStream(ImageID)
If IRandomAccessStream
sOutPut = GetOCRFromImage(IRandomAccessStream, sLanguage, 0)
Protected IClosable.IClosable
Protected hr.l = IRandomAccessStream\QueryInterface(?IID_IClosable, @IClosable)
CompilerIf #MyRoDebug : Debug "IRandomAccessStream::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IClosable
IClosable\Close()
IClosable\Release()
IClosable = 0
EndIf
IRandomAccessStream\Release()
EndIf
DeleteObject_(ImageID)
EndIf
ProcedureReturn sOutPut
EndProcedure
;-
Procedure get_FacesFromFile(sFile.s, List rcList.rect())
Protected iCount
Protected IRandomAccessStream.IRandomAccessStream = FileToRandomAccessStream(sFile)
If IRandomAccessStream
iCount = facedetect(IRandomAccessStream, rcList())
Protected IClosable.IClosable
Protected hr = IRandomAccessStream\QueryInterface(?IID_IClosable, @IClosable)
CompilerIf #MyRoDebug : Debug "IRandomAccessStream::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IClosable
IClosable\Close()
IClosable\Release()
IClosable = 0
EndIf
IRandomAccessStream\Release()
EndIf
ProcedureReturn iCount
EndProcedure
Procedure get_FacesFromImageID(ImageID, List rcList.rect())
Protected iCount
Protected IRandomAccessStream.IRandomAccessStream = HBitmapToRandomAccessStream(ImageID)
If IRandomAccessStream
iCount = facedetect(IRandomAccessStream, rcList())
Protected IClosable.IClosable
Protected hr = IRandomAccessStream\QueryInterface(?IID_IClosable, @IClosable)
CompilerIf #MyRoDebug : Debug "IRandomAccessStream::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IClosable
IClosable\Close()
IClosable\Release()
IClosable = 0
EndIf
IRandomAccessStream\Release()
EndIf
ProcedureReturn iCount
EndProcedure
Procedure get_FacesFromHWND(hWND, List rcList.rect())
Protected iCount
Protected ImageID = HBitmapFromHWND(hWND)
If ImageID
Protected IRandomAccessStream.IRandomAccessStream = HBitmapToRandomAccessStream(ImageID)
If IRandomAccessStream
iCount = facedetect(IRandomAccessStream, rcList())
Protected IClosable.IClosable
Protected hr = IRandomAccessStream\QueryInterface(?IID_IClosable, @IClosable)
CompilerIf #MyRoDebug : Debug "IRandomAccessStream::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IClosable
IClosable\Close()
IClosable\Release()
IClosable = 0
EndIf
IRandomAccessStream\Release()
EndIf
DeleteObject_(ImageID)
EndIf
ProcedureReturn iCount
EndProcedure
EndModule
Code: Select all
; This module enables the user to use a mouse to select a region of the screen.
; The module must be initialised by calling InitDesktop() once. Then a region of the screen can be selected by calling GetScreenRegion()
; After calling GetScreenRegion(), a crosswire cursor is placed in the top-left corner of the screen. Use the mouse to
; move this cursor to the top-left corner of the region of the screen to be selected, then click the left mouse button and
; hold it down while dragging the mouse to select the required region of the screen. This will draw a border to show the
; selected region. When the mouse is released, details of the selected region is stored in the structure SCREEN_REGION
; that is declared in the global ScreenRegion.SCREEN_REGION.
; This module was derived from the code at https://www.purebasic.fr/german/viewtopic.php?f=8&t=3949&start=10
; - Thanks to DarkDragon and mk-soft
;To use this module in another module, use:
;XIncludeFile "GetScreenRegion.pbi"
;UseModule ModuleGetScreenRegion
DeclareModule ModuleGetScreenRegion
Structure SCREEN_REGION
X.l ; Left co-ordinate of the selected region
Y.l ; Top co-ordinate of the selected region
Width.l ; width of the selected region
Height.l ; height of the selected region
EndStructure
Global ScreenRegion.SCREEN_REGION
Declare GetScreenRegion()
Declare InitDesktop()
EndDeclareModule
Module ModuleGetScreenRegion
Procedure GetCurrentCursor(*pt.Point)
;Returns the handle of the current cursor
Protected hWindow
Protected dwThreadID
Protected dwCurrentThreadID
Protected hCursor, nil
If GetCursorPos_(*pt)
hWindow = WindowFromPoint_(*pt\x << 32 + *pt\y)
If IsWindow_(hWindow)
dwThreadID = GetWindowThreadProcessId_(hWindow, @nil)
dwCurrentThreadID = GetCurrentThreadId_()
If (dwCurrentThreadID <> dwThreadID)
If AttachThreadInput_(dwCurrentThreadID, dwThreadID, 1)
hCursor = GetCursor_() ; gets handle of current cursor
AttachThreadInput_(dwCurrentThreadID, dwThreadID, 0)
EndIf
Else
hCursor = GetCursor_() ; gets handle of current cursor
EndIf
EndIf
EndIf
ProcedureReturn hCursor
EndProcedure
Procedure MakeDesktopScreenshot(ImageNr,x, y, Width, Height)
Protected hImage, hDC, DeskDC, hCursor
Protected pt.point
hImage = CreateImage(ImageNr,Width,Height)
If hImage
hDC = StartDrawing(ImageOutput(ImageNr))
If hDC
DeskDC = GetDC_(GetDesktopWindow_())
If DeskDC
BitBlt_(hDC,0,0,Width,Height,DeskDC,x,y,#SRCCOPY)
EndIf
ReleaseDC_(GetDesktopWindow_(),DeskDC)
EndIf
hCursor = GetCurrentCursor(@pt.Point)
DrawImage(hCursor, pt\x, pt\y)
StopDrawing()
EndIf
ProcedureReturn hImage
EndProcedure
Procedure GetScreenRegion()
Protected Mousex, MouseY, capMouse=0, oMouseX, oMouseY
Protected v, Q
Protected img
MakeDesktopScreenshot(Img,0,0,DesktopWidth(0),DesktopHeight(0))
OpenScreen(DesktopWidth(0), DesktopHeight(0), 32, "Capture")
Repeat
If IsScreenActive()
ExamineMouse()
MouseX = MouseX()
MouseY = MouseY()
If MouseButton(#PB_MouseButton_Left)
If capMouse = 0
oMouseX = MouseX
oMouseY = MouseY
capMouse = 1
EndIf
Else
If capMouse = 1
If MouseX < oMouseX : v = oMouseX : oMouseX = MouseX : MouseX = v : EndIf
If MouseY < oMouseY : v = oMouseY : oMouseY = MouseY : MouseY = v : EndIf
ScreenRegion\X = oMouseX
ScreenRegion\Y = oMouseY
ScreenRegion\Width = MouseX-oMouseX
ScreenRegion\Height = MouseY-oMouseY
Q = 1
EndIf
EndIf
ClearScreen(0)
StartDrawing(ScreenOutput())
DrawImage(ImageID(0), 0, 0)
DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_XOr)
If capMouse <> 0
Box(oMouseX, oMouseY, MouseX-oMouseX, MouseY-oMouseY)
EndIf
DrawingMode(#PB_2DDrawing_XOr)
Box(MouseX-1 , MouseY-10, 2 , 20)
Box(MouseX-10, MouseY-1 , 20, 2 )
StopDrawing()
FlipBuffers()
EndIf
Delay(10)
Until Q = 1
CloseScreen()
FreeImage(Img)
EndProcedure
Procedure InitDesktop()
ExamineDesktops()
InitSprite()
InitMouse()
EndProcedure
EndModule
When the program runs, an icon appears in the icon tray. After displaying the PDF page on screen using an appropriate Reader (I use SumatraPDF), press CTRL-ALT-SHIFT-B [you can change this hotkey if required]. This places a cross-hair cursor in the top left corner of the screen. Use the mouse to move this cursor to the top-left corner of the text to be OCR'd, then click the left mouse button and while holding it down, drag the mouse to select the required text. This will draw a border around the selected text. When the mouse button is released, the text in the selected region is OCR'd and the results appended to the RTF control of the OCR window.
The tray icon has a menu with three options:
(1) Show OCR window - this opens the main OCR window containing the OCR'd text (clicking the tray icon will also open the main OCR window)
(2) Exit.
(3) Help - this shows a help file
The main OCR window includes a simple menu named Actions with three options:
(1) Save - this opens a file dialog box enabling the OCR'd text to be saved to a rtf file
(2) Copy - this copies selected text from the main OCR window to the clipboard
(3) Clear - this clears the text in the rtf editor. If text is not cleared then when another page is OCR'd then the result of the new OCR is appended to the previous one in the rtf control.
The tray image icon and help file for this program may be downloaded from:
https://www.mediafire.com/file/tswk927z ... r.ico/file
https://www.mediafire.com/file/wcz68oij ... r.chm/file
No OCR engine is perfect and - as with commercially available OCR programs - the text will need checking after it has been OCR'd [I've noticed that it sometimes omits words from the OCR process]. The more complex program at the following link includes a spelling checker. After OCRing a page any mispelt words are underlined with a red wavy line in the RTF control and these can be corrected manually or, if the mispelt word is selected, right-clicking it will bring up suggested spellings. Words can be added to the spell-checking dictionary.
https://www.mediafire.com/file/ruq0nt37 ... 2.zip/file