https://foro.gambas-es.org/viewtopic.php?f=5&t=7787&p=46864#p46864
-----------------------------------
vuott
Lunes, 14 Octobre 2019, 19:59

Re: Simple Programa Para Usar El Scanner Con Las Funciones Externas De Libsane
-----------------------------------
[quote user="gambafeliz" post="46858"]... para crear un OCR ...[/quote]

Está bien: propongo este codigo.
[color=#BF0000]Si deseáis activar el OCR, tenéis que cambiar el valor de la constante "OCR_BOOL" a [i]True[/i], y sugiero que establezcáis el valor de la variable "RISOLUZIONE" al menos a 300 dpi.[/color]

[code linenumbers=false syntax=gambas]'' http://www.sane-project.org/html/doc009.html

Private Const BUFFER As Integer = 65536
Private Const MODUS As String = "Color"      ''  Color  -  Gray  -  Lineart
Private RISOLUZIONE As Integer = 300        '' dpi
Private Const OCR_BOOL As Boolean = False

Library "libsane:1.0.27"

Public Struct SANE_Option_Descriptor
  name As Pointer
  title As Pointer
  desc As Pointer
  type As Integer
  unit As Integer
  size As Integer
  cap As Integer
  constraint_type As Integer
  union As Pointer
End Struct

Public Struct SANE_Parameters
  sformat As Byte
  last_frame As Byte
  bytes_per_line As Integer
  pixels_per_line As Integer
  lines As Integer
  depth As Integer
End Struct

Private Enum SANE_ACTION_GET_VALUE = 0, SANE_ACTION_SET_VALUE, SANE_ACTION_SET_AUTO

' SANE_Status sane_init (SANE_Int * version_code, SANE_Auth_Callback authorize)
' This function must be called before any other SANE function can be called.
Private Extern sane_init(version_code As Pointer, authorize As Pointer) As Integer

' SANE_Status sane_get_devices (const SANE_Device *** device_list, SANE_Bool local_only)
' To query the list of devices that are available.
Private Extern sane_get_devices(device_list As Pointer, local_only As Boolean) As Integer

' SANE_Status sane_open (SANE_String_Const devicename, SANE_Handle * handle)
' To establish a connection to a particular device.
Private Extern sane_open(devicename As String, handle As Pointer) As Integer

' SANE_Status sane_control_option (SANE_Handle handle, SANE_Int option, SANE_Action action, void *value, SANE_Int * info)
' To set or inquire the current value of option number n of the device represented by handle h.
Private Extern sane_control_option(handle As Pointer, option As Integer, action As Integer, value As Pointer, info As Pointer) As Integer

' const SANE_Option_Descriptor * sane_get_option_descriptor (SANE_Handle handle, SANE_Int option)
' To access option descriptors.
Private Extern sane_get_option_descriptor(handle As Pointer, option As Integer) As Pointer

' SANE_Status sane_get_parameters (SANE_Handle handle, SANE_Parameters * params)
' To obtain the current scan parameters.
Private Extern sane_get_parameters(handle As Pointer, params As SANE_Parameters) As Integer

' SANE_Status sane_start (SANE_Handle handle)
' Initiates aquisition of an image from the device represented by handle h.
Private Extern sane_start(handle As Pointer) As Integer

' SANE_Status sane_read (SANE_Handle handle, SANE_Byte * data, SANE_Int max_length, SANE_Int * length)
' To read image data from the device represented by handle h.
Private Extern sane_read(handle As Pointer, data As Pointer, max_length As Integer, length As Pointer) As Integer

' void sane_cancel (SANE_Handle handle)
' To immediately or as quickly as possible cancel the currently pending operation of the device.
Private Extern sane_cancel(handle As Pointer)

' void sane_close (SANE_Handle handle)
' Terminates the association between the device handle and the device it represents.
Private Extern sane_close(handle As Pointer)

' void sane_exit (void)
' To terminate use of a backend.
Private Extern sane_exit()


Public Sub Main()

  Dim err, j, maxlun, lun As Integer
  Dim p, dev, hnd, vl, md, buf, plun As Pointer
  Dim nom As String
  Dim sod As SANE_Option_Descriptor
  Dim par As New SANE_Parameters
  Dim fl As File

  Write "\e[5mRestare in attesa...\e[0m"
  Flush

  err = sane_init(0, 0)
  If err > 0 Then GestErrore()
  
  dev = VarPtr(p)
  
  err = sane_get_devices(VarPtr(dev), False)
  If err > 0 Then GestErrore()

  nom = String@(Pointer@(Pointer@(dev)))
  Write "\rDispositivo:     " & nom
  
  hnd = Alloc(SizeOf(gb.Pointer), 8)
  
  err = sane_open(nom, VarPtr(hnd))
  If err > 0 Then GestErrore()
  
  vl = Alloc(SizeOf(gb.Integer), 1)
    
  err = sane_control_option(hnd, 0, SANE_ACTION_GET_VALUE, vl, 0)
  If err > 0 Then GestErrore()
  
  For j = 0 To Int@(vl) - 1
    sod = sane_get_option_descriptor(hnd, j)
    If IsNull(String@(sod.name)) Then Continue
    Select Case String@(sod.name)
      Case "mode"                   '' Color  -  Gray  -  Lineart
        md = Alloc(MODUS)
        sane_control_option(hnd, j, SANE_ACTION_SET_VALUE, md, 0)
      Case "resolution"
        sane_control_option(hnd, j, SANE_ACTION_SET_VALUE, VarPtr(RISOLUZIONE), 0)
    End Select
  Next
  
  err = sane_get_parameters(hnd, par)
  If err > 0 Then GestErrore()
  With par
    Print "\nPixels per line: "; .pixels_per_line
    Print "Colonne:         "; .lines
    Print "Righe:           "; .depth
    Print "Bytes per line:  "; .bytes_per_line
    Print "Modalità:        "; MODUS
    Print "Risoluzione:     "; RISOLUZIONE; " dpi\n"
  End With
  Wait 1
  err = sane_start(hnd)
  If err > 0 Then GestErrore()
  
  buf = Alloc(SizeOf(gb.Byte), BUFFER)
  plun = Alloc(SizeOf(gb.Integer), 1)
  maxlun = BUFFER

  If Exist("/tmp/imm") Then Kill "/tmp/imm"
  fl = Open "/tmp/imm" For Write Append
  
  Repeat
    err = sane_read(hnd, buf, maxlun, plun)
    Select Case err
      Case 1
        GestErrore()
      Case 3 To 4
        GestErrore()
      Case 6 To 11
        GestErrore()
    End Select
    lun = Int@(plun)
    Write #fl, buf, lun
  Until lun = 0
  
  sane_cancel(hnd)
  
  CreaFileImmagine(par)
  
' Libera la memoria precedentemente allocata:
  fl.Close
  Free(md)
  Free(vl)
  Free(plun)
  Free(buf)
  sane_close(hnd)
  Free(hnd + (SizeOf(gb.Pointer) * 3))
  hnd = 0
  saneUscita()
  
' Chiama la funzione per il riconoscimento OCR:
  If OCR_BOOL = True Then Ocr()
  
End

Private Procedure GestErrore()
  
  saneUscita()
  Error.Raise("Errore !")
  
End


Private Procedure saneUscita()
  
  sane_exit()
  
End

Private Procedure CreaFileImmagine(prmt As SANE_Parameters)
  
  Dim s, finale, mg As String
  Dim pro, p4, lns, dep As Integer
  Dim aBN As Byte
  
  pro = prmt.lines * prmt.depth
  s = File.Load("/tmp/imm")
  
  Print "\nDati grezzi:     "; Len(s); " byte"
  Print "Colonne x Righe: "; pro; " pixel\n"
  
  lns = prmt.lines
  dep = prmt.depth
  
  Select Case MODUS
    Case "Color"
      mg = "P6 "
' Se il numero dei dati grezzi è inferiore a (Colonne x Righe) x 3, allora colma la differenza:
      If Len(s) < ((pro / 8) * 3) Then s = s & String(((pro) * 3) - Len(s), Chr(255))
' Se invece il numero dei dati grezzi è maggiore di (Colonne x Righe) x 3, allora colma la differenza, ma tagliando i dati grezzi dalla fine:
      If Len(s) > ((pro) * 3) Then s = Left(s, pro * 3)
    Case "Gray"
      mg = "P5 "
' Se il numero dei dati grezzi è inferiore a Colonne x Righe, allora colma la differenza:
      If Len(s) < (pro) Then s = s & String((pro) - Len(s), Chr(255))
' Se invece il numero dei dati grezzi è maggiore di Colonne x Righe, allora colma la differenza, ma tagliando i dati grezzi dalla fine:
      If Len(s) > (pro) Then s = Left(s, pro)
    Case "Lineart"
      mg = "P4 "
' Se il numero dei dati grezzi è inferiore a (Colonne x Righe) / 8, allora colma la differenza:
      If Len(s) < (pro / 8) Then
        p4 = pro \ 8
        s = s & String(p4 - Len(s), Chr(255))
      Endif
' Se il numero dei dati grezzi è maggiore di (Colonne x Righe) / 8, allora colma la differenza:
      If Len(s) > (pro / 8) Then
        For aBN = 1 To 8
          If (Len(s) * 8) Mod (prmt.lines + aBN) == 0
            lns = prmt.lines + aBN
            dep = Len(s) * 8 / prmt.lines
          Endif
        Next
      Endif
  End Select
' Quindi, crea l'intero file .PNM finale, costituito da:
' l'header:
'   - numero Magico + spazio;
'   - numero colonne;
'   - spazio;
'   - numero righe;
'   - spazio;
'   - profondità colore;
'   - chiusura con "salto di riga";
' i dati grezzi dell'immagine scansita;
' le informazioni e commento finale:
  finale = mg & lns & Chr(&20) & dep & " 255" & Chr(10) & s & Chr(10) &
           "# file creato da " & Application.Name & " - " & CStr(Now)
'...e lo salva:
  File.Save("/tmp/scansione.pnm", finale)
  
End


Public Struct Pix
  w As Integer
  h As Integer
  d As Integer
  wpl As Integer
  refcount As Integer
  xres As Integer
  yres As Integer
  informat As Integer
  text As Pointer
  colormap As Pointer
  data As Pointer
End Struct

Library "libtesseract:4.0.0"

' TessBaseAPI* TessBaseAPICreate()
Private Extern TessBaseAPICreate() As Pointer

' int TessBaseAPIInit3(TessBaseAPI* handle, const char* datapath, const char* language)
Private Extern TessBaseAPIInit3(handle As Pointer, datapath As String, language As String) As Integer

' void TessBaseAPISetImage2(TessBaseAPI* handle, struct Pix* pix)
Private Extern TessBaseAPISetImage2(handle As Pointer, pix As Pix)

' void TessBaseAPISetSourceResolution(TessBaseAPI* handle, int ppi)
Private Extern TessBaseAPISetSourceResolution(handle As Pointer, ppi As Integer)

' int TessBaseAPIRecognize(TessBaseAPI* handle, ETEXT_DESC* monitor)
Private Extern TessBaseAPIRecognize(handle As Pointer, monitor As Pointer) As Integer

' char* TessBaseAPIGetUTF8Text(TessBaseAPI* handle)
Private Extern TessBaseAPIGetUTF8Text(handle As Pointer) As String

' void TessBaseAPIEnd(TessBaseAPI* handle)
Private Extern TessBaseAPIEnd(handle As Pointer)

' void TessBaseAPIDelete(TessBaseAPI* handle)
Private Extern TessBaseAPIDelete(handle As Pointer)


Library "liblept:5.0.2"

' PIX * pixRead (const char *filename)
Private Extern pixRead(filename As String) As Pix

' void pixDestroy (PIX **ppix)
Private Extern pixDestroy(ppix As Pointer)


Public Sub Ocr()

  Dim err As Integer
  Dim tes As Pointer 
  Dim pis As Pix
  Dim s As String
  
  pis = pixRead("/tmp/scansione.pnm")
  
  tes = TessBaseAPICreate()
  If tes == 0 Then Error.Raise("Errore !")

  err = TessBaseAPIInit3(tes, Null, "eng")
  If err <> 0 Then Error.Raise("Errore !")
  
  TessBaseAPISetImage2(tes, pis)
  Write "Riconoscimento caratteri.\n\e[5mRestare in attesa...\e[0m\r"
  Flush

  TessBaseAPISetSourceResolution(tes, RISOLUZIONE)

  err = TessBaseAPIRecognize(tes, 0)
  If err <> 0 Then Error.Raise("Errore !")
  
' Scansione OCR:
  s = TessBaseAPIGetUTF8Text(tes)
  Print Space(Len("Restare in attesa..."))
  Print
  Print s
  
  TessBaseAPIEnd(tes)
  TessBaseAPIDelete(tes)
  pixDestroy(Object.Address(pis) + (SizeOf(gb.Pointer) * 3))

End[/code]


