FPDF ean8, ean13, code39

Hello to all.
My name is Massimiliano, from Italy.
I am disabled person, from a couple of years I’m realizing with xojo an erp software… (is not been finish).
Everything ok, the work is going well, I wrote my software without using plug-in and / or third-party software except for the FPDF library that I feel, as minimal, face to my case.
Lately I have found myself wanting to put a barcode on the sales and order confirmation documents prints …
Of course the fact that I do not want to use third-party libraries, I added everything I needed in the FPDF library to print the barcode ean8, ean13 and code39. Obviously not use any fonts !!! it was important to generate the barcode on your PC without worrying where my erp must work to install fonts for barcode.
So … it’s fair to share with you all my additions to the library fpdf sure make at you a good gift.

I also developed a barcode reader for Android smartphones that sends the code read to a particular IP address and a port UDP. If you need it you can contact me, and if I sent a text logo and I can customize it for you.

This is code for EAN8 or EAN13
(for Ean code creation, please enter only 12 digits and use ‘EAN13checkdigit’ function for calculate check digits code)


for use in FPDF :
[code]
'save x,y position : 
dim temp_x as double
dim temp_y as double
temp_x = pdf.getx()
temp_y = pdf.gety()
'set position for barcode 
pdf.setxy(20,42)
pdf.Ean13(code as string, widht as double, height as double, print code as boolean) eg :
pdf.Ean13("80725497",20,10,true)
'restore x,y position
pdf.setxy(temp_x,temp_y)
[/code]
[b]For perfect reading use widht 20 for ean8 and widht 30 for ean13[/b]
for code39 function send only code ( with number 0-9, capital letters A-Z, Sign. .,-,%,$,/ and space, the '*' character is used for start and end barcode ( these are insered in automatic if not found )

Function EAN2Bin(strEANCode As String) As string
  Dim K As Integer
  Dim strAux As String
  Dim strExit As String
  Dim strCode As String
  
  strEANCode = Trim(strEANCode)
  strAux = strEANCode
  
  ' verifico che sia un ean13 o un ean8 in base alla lunghezza della stringa strEANCode
  If (strAux.len <> 13) And (strAux.Len <> 8) Then
    msgbox("Errore, il codice non sembra essere un codice EAN13 o EAN8")
    Return ""
  End If
  
  For K = 1 To strEANCode.len
    Select Case mid(strAux,K,1)
    Case "0","1","2","3","4","5","6","7","8","9"
      ' ok il codice non contiene caratteri non validi
    case else
      MsgBox("Errore il codice EAN contiene caratteri non ammessi")
      Return ""
    End Select
  Next
  
  
  If (strAux.len = 13) Then
    ' verifico che sia un EAN 13
    ' per prima cosa scarto la prima cifra che  lo stato di emissione (fare riferimento ad INDICOD '
    strAux = Mid(strAux, 2)
    Select Case CInt(Left(strEANCode, 1))
    Case 0
      strCode = "000000"
    Case 1
      strCode = "001011"
    Case 2
      strCode = "001101"
    Case 3
      strCode = "001110"
    Case 4
      strCode = "010011"
    Case 5
      strCode = "011001"
    Case 6
      strCode = "011100"
    Case 7
      strCode = "010101"
    Case 8
      strCode = "010110"
    Case 9
      strCode = "011010"
    End Select
  Else
    strCode = "0000"
  End If
  
  '*
  '* Il codice EAN inizia con un carattere iniziale
  '*
  strExit = "000101"
  
  '*
  '* Prima met del codice
  '
  For K = 1 To Len(strAux) \\ 2
    Select Case CInt(Mid(strAux, K, 1))
    Case 0
      dim temptext as string
      if Mid(strCode, K, 1) = "0" then temptext = "0001101" else temptext = "0100111"
      strExit = strExit + temptext
    Case 1
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0011001" else temptext = "0110011"
      strExit = strExit + temptext
      
    Case 2
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0010011" else temptext = "0011011"
      strExit = strExit + temptext
      
    Case 3
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0111101" else temptext = "0100001"
      strExit = strExit + temptext
      
    Case 4
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0100011" else temptext = "0011101"
      strExit = strExit + temptext
      
    Case 5
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0110001" else temptext = "0111001"
      strExit = strExit + temptext
      
    Case 6
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0101111" else temptext = "0000101"
      strExit = strExit + temptext
      
    Case 7
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0111011" else temptext = "0010001"
      strExit = strExit + temptext
      
    Case 8
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0110111" else temptext = "0001001"
      strExit = strExit + temptext
      
    Case 9
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0001011" else temptext = "0010111"
      strExit = strExit + temptext
      
    End Select
  Next K
  
  '*
  '* Prosegue poi con un separatore di mezzo
  '*
  strExit = strExit + "01010"
  
  '*
  '* Seconda met del codice
  '*
  For K = Len(strAux) \\ 2 + 1 To Len(strAux)
    Select Case CInt(Mid(strAux, K, 1))
    Case 0
      strExit = strExit + "1110010"
    Case 1
      strExit = strExit + "1100110"
    Case 2
      strExit = strExit + "1101100"
    Case 3
      strExit = strExit + "1000010"
    Case 4
      strExit = strExit + "1011100"
    Case 5
      strExit = strExit + "1001110"
    Case 6
      strExit = strExit + "1010000"
    Case 7
      strExit = strExit + "1000100"
    Case 8
      strExit = strExit + "1001000"
    Case 9
      strExit = strExit + "1110100"
    End Select
  Next K
  
  
  ' Il Codice EAN finisce con un separatore finale
  
  strExit = strExit + "101000"
  
  return strExit
  
End Function


Sub Ean13(codice as string, larghezza as double = 30, altezza as double = 15, stampatesto as boolean = true)
  if codice.trim = "" then exit sub
  codice = EAN13checkdigit(codice) // valuto se il codice ean  completo o senza il carattere di controllo
  // di default larghezza = 20 e altezza = 15 (millimetri)
   
  Dim contatore As Integer
  Dim sngPosX As Double
  Dim sngPosY As Double
  dim sngX1, sngY1, sngX2, sngY2 as Double
  Dim sngScaleX As Double
  dim dimensione as Double
  Dim strEANBin As String
  dim strEANCode as string 
  
  strEANCode = codice
  sngX1 = getx()
  sngX2 = larghezza
  sngY1 = gety()
  sngY2 = altezza
  
  ' Converto il codice EAN nella sua rappresentazione binaria.
  
  strEANBin = EAN2Bin(strEANCode)
  
  If sngX1 = (-1) Then sngX1 = 0
  If sngY1 = (-1) Then sngY1 = 0
  If sngX2 = (-1) Then sngX2 = larghezza
  If sngY2 = (-1) Then sngY2 = altezza
  
  
  sngScaleX = sngX2 / strEANBin.Len
  
  ' definisco l'altezza del barcode tenendo conto del testo
  sngPosX = sngX1 ' spigolo a sinistra
  sngPosY = sngY2 ' spigolo in basso
  
  'disegno il barcode con il colore corrente
  
  For contatore = 1 To Len(strEANBin)
    If Mid(strEANBin, contatore, 1) = "1" Then
      Rect(sngPosX,sngY1,sngScaleX,sngY2,"F")
    End If
    sngPosX = sngX1 + (contatore * sngScaleX)
  Next contatore
  
  if stampatesto then
    SetFont("Helvetica","",5)
    SetXY(sngX1,sngY1 + sngY2 + 1 ) // posizione a sinistra in basso appena finito il codice
    MultiCell(sngX2,3,codice,0,"C",0) // testo del barcode senza bordo e testo normale
  end if
End Sub


Function EAN13checkdigit(stringpart as string) As string
  Dim strParts() As String
  Dim lngIndex As integer
  Dim intTotal As Integer
  Dim intCount As Integer
  Dim intUp As Integer
  
  select case len(stringpart)
  case 7,12
    // procedo
  case 8,13
    Return stringpart
  case else
    Return ""
  end select
  
  stringpart = stringpart + "C"
  strParts = Split(stringpart, "")
  
  For lngIndex = UBound(strParts) - 1 To 0 Step -2
    For intCount = 1 To 3
      intTotal = intTotal + cint(strParts(lngIndex))
    Next
  Next
  
  For lngIndex = UBound(strParts) To 0 Step -2
    intTotal = intTotal + cint(strParts(lngIndex))
  Next
  
  intUp = intTotal
  Do Until intUp Mod 10 = 0
    intUp = intUp + 1
  Loop
  
  strParts(UBound(strParts)) = str(intUp - intTotal)
  
  return join(strParts(),"")
End Function

GoodBye !!

This code is for print code39 barcode…

Sub Code39(codice as string, altezza as double = 15, stampatesto as boolean = true)
  if codice.trim = "" then exit sub
   
  Dim contatore As Integer
  Dim sngPosX As Double
  Dim sngPosY As Double
  dim sngX1, sngY1, sngX2, sngY2 as Double
  Dim sngScaleX As Double
  dim dimensione as Double
  Dim strEANBin As String
  dim strEANCode as string
  dim larghezza as Double
  
  if codice.left(1) <> "*" then codice = "*" + codice 
  if codice.Right(1) <> "*" then codice = codice + "*"
  
  sngScaleX = 0.25 // dimensione 0,21 mm per la barra singola;
  larghezza = sngScaleX * 16 * codice.Len
  
  strEANCode = codice
  sngX1 = getx()
  sngX2 = larghezza
  sngY1 = gety()
  sngY2 = altezza
  
  ' Converto il codice  nella sua rappresentazione binaria.
  
  strEANBin = code392bin(strEANCode)
  ' calcolo la larghezza del codice 
  
  If sngX1 = (-1) Then sngX1 = 0
  If sngY1 = (-1) Then sngY1 = 0
  If sngX2 = (-1) Then sngX2 = larghezza
  If sngY2 = (-1) Then sngY2 = altezza
  
  ' definisco l'altezza del barcode tenendo conto del testo
  sngPosX = sngX1 ' spigolo a sinistra
  sngPosY = sngY2 ' spigolo in basso
  
  'disegno il barcode con il colore corrente
  
  For contatore = 1 To Len(strEANBin)
    If Mid(strEANBin, contatore, 1) = "1" Then
      Rect(sngPosX,sngY1,sngScaleX,sngY2,"F")
    End If
    sngPosX = sngX1 + (contatore * sngScaleX)
  Next contatore
  
  if stampatesto then
    SetFont("Helvetica","",5)
    SetXY(sngX1,sngY1 + sngY2 + 1 ) // posizione a sinistra in basso appena finito il codice
    MultiCell(sngX2,3,codice,0,"C",0) // testo del barcode senza bordo e testo normale
  end if
End Sub


Function Code392Bin(strCode As String) As string
  Dim K As Integer
  Dim strAux As String
  Dim strExit As String
  
  strCode = Trim(strCode)
  strCode = Uppercase(strCode)
  strAux = strCode
  
  if strCode.trim = "" then return ""
  
  For K = 1 To strCode.len
    Select Case mid(strAux,K,1)
    Case "0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z","*","-","."," "
      ' ok il codice non contiene caratteri non validi
    case else
      MsgBox("Errore il codice 39 contiene caratteri non ammessi, sono ammessi caratteri 0-9, A-Z, *,-,., ")
      Return ""
    End Select
  Next
  
  // se il codice non comincia con '*' e finisce con '*' allora ce li mettiamo
  if strCode.left(1) <> "*" then strCode = "*" + strCode 
  if strCode.Right(1) <> "*" then strCode = strCode + "*"
  
  For K = 1 To strCode.len
    Select Case Mid(strCode, K, 1)
    Case "1"
      strExit = strExit + "1110100010101110"
    Case "2"
      strExit = strExit + "1011100010101110"
    Case "3"
      strExit = strExit + "1110111000101010"
    Case "4"
      strExit = strExit + "1010001110101110"
    Case "5"
      strExit = strExit + "1110100011101010"
    Case "6"
      strExit = strExit + "1011100011101010"
    Case "7"
      strExit = strExit + "1010001011101110"
    Case "8"
      strExit = strExit + "1110100010111010"
    Case "9"
      strExit = strExit + "1011100010111010"
    Case "0"
      strExit = strExit + "1010001110111010"
    Case "A"
      strExit = strExit + "1110101000101110"
    Case "B"
      strExit = strExit + "1011101000101110"
    Case "C"
      strExit = strExit + "1110111010001010"
    Case "D"
      strExit = strExit + "1010111000101110"
    Case "E"
      strExit = strExit + "1110101110001010"
    Case "F"
      strExit = strExit + "1011101110001010"
    Case "G"
      strExit = strExit + "1010100011101110"
    Case "H"
      strExit = strExit + "1110101000111010"
    Case "I"
      strExit = strExit + "1011101000111010"
    Case "J"
      strExit = strExit + "1010111000111010"
    Case "K"
      strExit = strExit + "1110101010001110"
    Case "L"
      strExit = strExit + "1011101010001110"
    Case "M"
      strExit = strExit + "1110111010100010"
    Case "N"
      strExit = strExit + "1010111010001110"
    Case "O"
      strExit = strExit + "1110101110100010"
    Case "P"
      strExit = strExit + "1011101110100010"
    Case "Q"
      strExit = strExit + "1010101110001110"
    Case "R"
      strExit = strExit + "1110101011100010"
    Case "S"
      strExit = strExit + "1011101011100010"
    Case "T"
      strExit = strExit + "1010111011100010"
    Case "U"
      strExit = strExit + "1110001010101110"
    Case "V"
      strExit = strExit + "1000111010101110"
    Case "W"
      strExit = strExit + "1110001110101010"
    Case "X"
      strExit = strExit + "1000101110101110"
    Case "Y"
      strExit = strExit + "1110001011101010"
    Case "Z"
      strExit = strExit + "1000111011101010"
    Case "*"
      strExit = strExit + "1000101110111010"
    Case "-"
      strExit = strExit + "1000101011101110"
    Case "."
      strExit = strExit + "1110001010111010"
    Case " "
      strExit = strExit + "1000111010111010"
    case else
      // salto
    End Select
  Next K
  
  
  ' Il Codice finisce con un separatore finale
  
  strExit = strExit
  
  return strExit
  
End Function

NB :
Fillerstring and cint function are here :

Function cint(s as string = "") As integer
  if s.trim <> "" then
    Return CType(Val(s), Integer)
  end if
End Function
Function Fillerstring(stringa as string, lunghezza as integer, filler as string = " ") As string
  dim lungostringa as integer
  dim lungofill as integer
  dim stringafiller as string = ""
  dim cursore as integer
  ' elimino gli spazi
  stringa = trim(stringa)
  ' determino la lunghezza di stringa
  lungostringa = len(stringa)
  ' se la lunghezza della stringa  maggiore o uguale alla lunghezza della stringa da ritornare allora invio la stringa lunga quanto mi serve senza proseguire
  if lungostringa >= lunghezza then 
    return left(stringa, lunghezza)
  end if
  lungofill = lunghezza - lungostringa
  ' riempio la parte che manca con il carattere di filler
  for cursore = 1 to lungofill
    stringafiller = stringafiller + filler
  next
  ' invio la stringa fillata
  return stringa + stringafiller
End Function