Function to return barcodes strings for ean13,cod39,128 etc

[AHF]

Hi,

Is there available funtions to return barcode encoded strings with the supplied number code?

Antonio

[MdaSolution]

SEARCH BARLIB PLEASE IN THIS FORUM

[AHF]

I've adapt some VB code to return barcodes strings.It can be send to any printing program such a Crystall Reports with the corresponding fonts installed to work. I didnt test it all but it seems to work. It returns an empty string if the code is not valid.

Here is the code.

Code: Select all  Expand view

FUNCTION Ean13(Codigo)
  LOCAL cEan13 :=""
  LOCAL i, checksum:=0, first, CodeBar:="", tableA:= .F.
  //check 12 charaters
  Codigo := alltrim(Codigo)
  If Len(Codigo) = 12
    //And they are really digits
    For i = 1 To 12
      If Asc(substr(Codigo, i, 1)) < 48 .Or. Asc(substr(Codigo, i, 1)) > 57
        i := 0
        Exit
      EndIf
    Next
    If i = 13
      //Calculation of the checksum
      For i = 12 To 1 Step -2
        checksum := checksum + Val(substr(Codigo, i, 1))
      Next
      checksum := checksum * 3
      For i = 11 To 1 Step -2
        checksum := checksum + Val(substr(Codigo, i, 1))
      Next
      Codigo := alltrim(str(val(Codigo) + mod(mod(10 - checksum, 10),10)))
      //The first digit is taken just as it is, the second one come from table A
      CodeBar := Left(Codigo, 1) + Chr(65 + Val(substr(Codigo, 2, 1)))
      first := Val(Left(Codigo, 1))
      For i = 3 To 7
        tableA := .f.
         do case
         Case i = 3
           if first =0 .and. first < 4
             tableA := .t.
           Endif
         Case i = 4
           if first = 0 .or. first = 4 .or. first = 7 .or. first = 8
             tableA := .t.
           Endif
         Case i = 5
           if first = 0 .or. first = 1 .or. first = 4 .or. first = 5 .or. first = 9
             tableA := .t.
           Endif
         Case i = 6
           if first = 0 .or. first = 2 .or. first = 5 .or. first = 6 .or. first = 7
             tableA := .t.
           Endif
         Case i = 7
           if first = 0 .or. first = 3 .or. first = 6 .or. first = 8 .or. first = 9
             tableA := .t.
           Endif
         Endcase
       If tableA
         CodeBar := CodeBar + Chr(65 + Val(substr(Codigo, i, 1)))
       Else
         CodeBar := CodeBar + Chr(75 + Val(substr(Codigo, i, 1)))
       EndIf
     Next
      CodeBar := CodeBar + "*"   // Add middle separator
      For i = 8 To 13
        CodeBar := CodeBar + Chr(97 + Val(substr(Codigo, i, 1)))
      Next
      CodeBar := CodeBar + "+"   // Add end mark
      cEan13 := CodeBar
    EndIf
  EndIf
RETURN cEan13


FUNCTION Code39(Codigo)
 LOCAL i, cCode39 :="", x
  codigo := alltrim(codigo)
  If Len(codigo) > 0
    //Check for valid characters
    For i = 1 To Len(codigo)
      x := Asc(substr(codigo, i, 1))
      do Case
         Case x = 32 .or. x = 36 .or. x =37 .or. x = 43 .or. (x >= 45 .and. x <= 57) .or. (x >= 65 .and. x <= 90)
         Otherwise
           i = 0
           Exit
      Endcase
    Next
    If i > 0
      cCode39 := "*" + codigo + "*"
    EndIf
  EndIf
RETURN cCode39


FUNCTION Code128(Codigo)
 LOCAL i, checksum, mini, dummy, tableB := .F.
 LOCAL cCode128 := "",x

 codigo := alltrim(codigo)

 If Len(codigo) > 0
   //Check for valid characters
    For i = 1 To Len(codigo)
        x:= Asc(Substr(codigo, i, 1))
      do case
        Case (x >= 32 .and. x <= 126) .or. x = 203
        Otherwise
             i := 0
             Exit
      Endcase
    Next
    //Calculation of the code string with optimized use of tables B and C
    cCode128 = ""
    tableB = .t.
    If i > 0
      i := 1 //i become the string index
      Do While i <= Len(codigo)
        If tableB
          // See if interesting to switch to table C
          // yes for 4 digits at start or end, else if 6 digits
          mini := IIf(i = 1 .or. i + 3 = Len(codigo), 4, 6)
          Testnum(@mini,@codigo,@i)
          If mini < 0 // Choice of table C
            If i = 1 // Starting with table C
              cCode128 := Chr(210)
            Else // Switch to table C
              cCode128 := cCode128 + Chr(204)
            EndIf
            tableB = .f.
          Else
            If i = 1
               cCode128 := Chr(209) // Starting with table B
            EndIf
          EndIf
        endif
       If !tableB
          // We are on table C, try to process 2 digits
          mini := 2
          Testnum(@mini,@codigo,@i)
          If mini < 0 // OK for 2 digits, process it
            dummy := Val(Substr(codigo, i, 2))
            dummy := IIf(dummy < 95, dummy + 32, dummy + 105)
            cCode128 := cCode128 + Chr(dummy)
            i := i + 2
          Else // We haven't 2 digits, switch to table B
            cCode128 := cCode128 + Chr(205)
            tableB = .t.
          EndIf
        EndIf
        If tableB
          // Process 1 digit with table B
          cCode128 := cCode128 + Substr(codigo, i, 1)
          i := i + 1
        EndIf
      enddo
      // Calculation of the checksum
      For i = 1 To Len(cCode128)
        dummy := Asc(Substr(cCode128, i, 1))
        dummy := IIf(dummy < 127, dummy - 32, dummy - 105)
        If i = 1
           checksum := dummy
        endif
        checksum := mod(checksum + (i - 1) * dummy,103)
        checksum := val(alltrim(str(checksum,0)))
      Next

      // Calculation of the checksum ASCII code
      checksum := IIf(checksum < 95, checksum + 32, checksum + 105)
      // Add the checksum and the STOP
      cCode128 := cCode128 + Chr(checksum) + Chr(211)
    End If
  End If
RETURN cCode128

STATIC FUNCTION Testnum(mini,codigo,i)
  //if the mini% characters from i% are numeric, then mini%=0
  mini := mini - 1
  If i + mini <= Len(codigo)
    Do While mini >= 0
      If Asc(Substr(codigo, i + mini, 1)) < 48 .or. Asc(Substr(codigo, i + mini, 1)) > 57
         Exit
      endif
      mini --
    enddo
  EndIf
RETURN nil


FUNCTION Code25I(Codigo,lKey)
 LOCAL cCode25I := ""
 LOCAL i, checksum:=0, dummy

   default lKey := .f.
   codigo := alltrim(codigo)

   If Len(codigo) > 0
      //Check for valid characters
      For i = 1 To Len(codigo)
          If Asc(Substr(codigo, i, 1)) < 48 .or. Asc(Substr(codigo, i, 1)) > 57
             Exit
          endif
      Next
      //Add if necessary the checksum
      If lkey
         For i = Len(codigo) To 1 Step -2
             checksum := checksum + Val(Substr(codigo, i, 1))
         Next
         checksum := checksum * 3
         For i = Len(codigo) - 1 To 1 Step -2
             checksum := checksum + Val(Substr(codigo, i, 1))
         Next
         Codigo := alltrim(str(val(Codigo) + mod(mod(10 - checksum, 10),10)))
      EndIf
      //Check if the length is odd
      If mod(Len(codigo),2) <> 0
         msginfo(str(mod(Len(codigo),2)))
         return ""
      endif
      //Calculation of the code string
      For i = 1 To Len(codigo) Step 2
          dummy := Val(Substr(codigo, i, 2))
          dummy := IIf(dummy < 94, dummy + 33, dummy + 101)
          cCode25I := cCode25I + Chr(dummy)
      Next
      // Add START and STOP
      cCode25I = Chr(201) + cCode25I + Chr(202)
   EndIf
RETURN cCode25I