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 FunctionGoodBye !!