AMSSpecialist

function EAN8(chaine)
if String.Length(chaine) == 7 then
    checksum="";
    min = 7;
    max = 1; 
    step = -2; 
    for count = min, max, step do
        checksum=String.ToNumber(checksum)+String.ToNumber(String.Mid(chaine, count, 1));
    end
    checksum=checksum*3
    min = 6;
    max = 1;  
    step = -2; 
    for count = min, max, step do
        checksum=String.ToNumber(checksum)+String.Mid(String.ToNumber(chaine), count, 1);
    end
    k1=Math.Mod(checksum,10)
    chaine=chaine..Math.Mod(10-k1,10)
    codebarre=":"
    min = 1; 
    max = 4;   
    for count = min, max do
        codebarre=codebarre..String.Char(65+String.Mid(chaine, count, 1));
    end
    codebarre=codebarre.."*"
    min = 5; 
    max = 8; 
    for count = min, max do
        codebarre=codebarre..String.Char(97+String.Mid(chaine, count, 1));
    end
    codebarre=codebarre.."+"
    end
    return codebarre
end

  
function EAN13(chaine)
    if String.Length(chaine)==12 then
    min = 12; 
    max = 1;  
    step = -2;  
    checksum=""
    for count = min, max, step do
        checksum=String.ToNumber(checksum)+String.ToNumber(String.Mid(chaine, count, 1));
    end
    checksum=checksum*3
    min = 11;
    max = 1;  
    step = -2; 
    for count = min, max, step do
        checksum=String.ToNumber(checksum)+String.ToNumber(String.Mid(chaine, count, 1));
    end
    k1=Math.Mod(checksum,10)
    chaine=chaine..Math.Mod(10-k1,10)

    codebarre=String.Left(chaine, 1)..String.Char(65+String.Mid(chaine, 2, 1))
    
    end
    first= String.ToNumber(String.Left(chaine, 1));
    min = 3;
    max = 7; 
    for count = min, max do
        tablea=false
        
        if (count==3) then
            if (first==0 or first==1 or first==2 or first==3) then
            tablea=true
            end
        elseif (count==4) then
            if (first==0 or first==4 or first==7 or first==8) then
            tablea=true
            end
        elseif (count==5) then
            if (first==0 or first==1 or first==4 or first==5 or first==9) then
            tablea=true
            end
        elseif (count==6) then
            if (first==0 or first==2 or first==5 or first==6 or first==7) then
            tablea=true
            end
        elseif (count==7) then
            if (first==0 or first==3 or first==6 or first==9) then
            tablea=true
            end
        end
        
        if (tablea==true) then
            codebarre=codebarre..String.Char(65+String.Mid(chaine, count, 1));
        else
            codebarre=codebarre..String.Char(75+String.Mid(chaine, count, 1));
        end
        
    end
    codebarre=codebarre.."*"
    min = 8;  
    max = 13; 
    for count = min, max do
        codebarre=codebarre..String.Char(97+String.Mid(chaine, count, 1));
    end
    codebarre=codebarre.."+"
return codebarre
end

function ADDON(chaine)
    if String.Length(chaine)==2 or String.Length(chaine)==5 then
        checksum=""
        if String.Length(chaine)==2 then
            checksum=10+Math.Mod(chaine,4);
        else
            min = 1; 
            max = 5;  
            step = 2; 
            for count = min, max, step do
                checksum=String.ToNumber(checksum)+String.ToNumber(String.Mid(chaine, count, 1));
            end
            checksum=Math.Mod(checksum*3+(String.Mid(chaine, 2, 1)*9)+(String.Mid(chaine, 4, 1)*9),10)
        end
        addon="["
        min = 1; 
        max = String.Length(chaine); 
        for count = min, max do
            tablea=false;
            if (count==1) then
                if (checksum==4 or checksum==5 or checksum==6 or checksum==7 or checksum==8 or checksum==9 or checksum==10 or checksum==11) then
                tablea=true
                end
            elseif (count==2) then
                if (checksum==1 or checksum==2 or checksum==3 or checksum==5 or checksum==6 or checksum==9 or checksum==10 or checksum==12) then
                tablea=true
                end
            elseif (count==3) then
                if (checksum==0 or checksum==2 or checksum==3 or checksum==6 or checksum==7 or checksum==8) then
                tablea=true
                end
            elseif (count==4) then
                if (checksum==0 or checksum==1 or checksum==3 or checksum==4 or checksum==8 or checksum==9) then
                tablea=true
                end
            elseif (count==5) then
                if (checksum==0 or checksum==1 or checksum==2 or checksum==4 or checksum==5 or checksum==7) then
                tablea=true
                end
            end
            if (tablea==true) then
                addon=addon..String.Char(65+String.Mid(chaine,count,1))
            else
                addon=addon..String.Char(75+String.Mid(chaine,count,1))
            end
            
            if (String.Length(chaine)==2 and count==1) or (String.Length(chaine)==5 and count<5) then
            addon=addon..String.Char(92)
            end
        end
        
    end
    return addon
end 

Código: Seleccionar todo

Public Function EAN8$(chaine$)
  'Cette fonction est régie par la Licence Générale Publique Amoindrie GNU (GNU LGPL)
  'This function is governed by the GNU Lesser General Public License (GNU LGPL)
  'V 1.0.0
  'Paramètres : une chaine de 7 chiffres
  'Parameters : a 7 digits length string
  'Retour : * une chaine qui, affichée avec la police EAN13.TTF, donne le code barre
  '         * une chaine vide si paramètre fourni incorrect
  'Return : * a string which give the bar code when it is dispayed with EAN13.TTF font
  '         * an empty string if the supplied parameter is no good
  Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean
  EAN8$ = ""
  'Vérifier qu'il y a 7 caractères
  'Check for 7 characters
  If Len(chaine$) = 7 Then
    'Et que ce sont bien des chiffres
    'And they are really digits
    For i% = 1 To 7
      If Asc(Mid$(chaine$, i%, 1)) < 48 Or Asc(Mid$(chaine$, i%, 1)) > 57 Then
        i% = 0
        Exit For
      End If
    Next
    If i% = 8 Then
      'Calcul de la clé de contrôle
      'Calculation of the checksum
      For i% = 7 To 1 Step -2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
      Next
      checksum% = checksum% * 3
      For i% = 6 To 1 Step -2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
      Next
      chaine$ = chaine$ & (10 - checksum% Mod 10) Mod 10
      'Les 4 premier chiffre viennent de la table A
      'The first 4 digits come from table A
      CodeBarre$ = ":"   'Ajout marque de début / Add start mark
      For i% = 1 To 4
         CodeBarre$ = CodeBarre$ & Chr$(65 + Val(Mid$(chaine$, i%, 1)))
      Next
      CodeBarre$ = CodeBarre$ & "*"   'Ajout séparateur central / Add middle separator
      For i% = 5 To 8
        CodeBarre$ = CodeBarre$ & Chr$(97 + Val(Mid$(chaine$, i%, 1)))
      Next
      CodeBarre$ = CodeBarre$ & "+"   'Ajout de la marque de fin / Add end mark
      EAN8$ = CodeBarre$
    End If
  End If
End Function

Public Function EAN13$(chaine$)
  'Cette fonction est régie par la Licence Générale Publique Amoindrie GNU (GNU LGPL)
  'This function is governed by the GNU Lesser General Public License (GNU LGPL)
  'V 1.1.1
  'Paramètres : une chaine de 12 chiffres
  'Parameters : a 12 digits length string
  'Retour : * une chaine qui, affichée avec la police EAN13.TTF, donne le code barre
  '         * une chaine vide si paramètre fourni incorrect
  'Return : * a string which give the bar code when it is dispayed with EAN13.TTF font
  '         * an empty string if the supplied parameter is no good
  Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean
  EAN13$ = ""
  'Vérifier qu'il y a 12 caractères
  'Check for 12 characters
  If Len(chaine$) = 12 Then
    'Et que ce sont bien des chiffres
    'And they are really digits
    For i% = 1 To 12
      If Asc(Mid$(chaine$, i%, 1)) < 48 Or Asc(Mid$(chaine$, i%, 1)) > 57 Then
        i% = 0
        Exit For
      End If
    Next
    If i% = 13 Then
      'Calcul de la clé de contrôle
      'Calculation of the checksum
      For i% = 12 To 1 Step -2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
      Next
      checksum% = checksum% * 3
      For i% = 11 To 1 Step -2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
      Next
      chaine$ = chaine$ & (10 - checksum% Mod 10) Mod 10
      'Le premier chiffre est pris tel quel, le deuxième vient de la table A
      'The first digit is taken just as it is, the second one come from table A
      CodeBarre$ = Left$(chaine$, 1) & Chr$(65 + Val(Mid$(chaine$, 2, 1)))
      first% = Val(Left$(chaine$, 1))
      For i% = 3 To 7
        tableA = False
         Select Case i%
         Case 3
           Select Case first%
           Case 0 To 3
             tableA = True
           End Select
         Case 4
           Select Case first%
           Case 0, 4, 7, 8
             tableA = True
           End Select
         Case 5
           Select Case first%
           Case 0, 1, 4, 5, 9
             tableA = True
           End Select
         Case 6
           Select Case first%
           Case 0, 2, 5, 6, 7
             tableA = True
           End Select
         Case 7
           Select Case first%
           Case 0, 3, 6, 8, 9
             tableA = True
           End Select
         End Select
       If tableA Then
         CodeBarre$ = CodeBarre$ & Chr$(65 + Val(Mid$(chaine$, i%, 1)))
       Else
         CodeBarre$ = CodeBarre$ & Chr$(75 + Val(Mid$(chaine$, i%, 1)))
       End If
     Next
      CodeBarre$ = CodeBarre$ & "*"   'Ajout séparateur central / Add middle separator
      For i% = 8 To 13
        CodeBarre$ = CodeBarre$ & Chr$(97 + Val(Mid$(chaine$, i%, 1)))
      Next
      CodeBarre$ = CodeBarre$ & "+"   'Ajout de la marque de fin / Add end mark
      EAN13$ = CodeBarre$
    End If
  End If
End Function

Public Function AddOn$(chaine$)
  'Cette fonction est régie par la Licence Générale Publique Amoindrie GNU (GNU LGPL)
  'This function is governed by the GNU Lesser General Public License (GNU LGPL)
  'V 1.0
  'Paramètres : une chaine de 2 ou 5 chiffres
  'Parameters : A 2 or 5 digits length string
  'Retour : * une chaine qui, affichée avec la police EAN13.TTF, donne le code barre supplementaire
  '         * une chaine vide si paramètre fourni incorrect
  'Return : * a string which give the add-on bar code when it is dispayed with EAN13.TTF font
  '         * an empty string if the supplied parameter is no good
  Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean
  AddOn$ = ""
  'Vérifier qu'il y a 2 ou 5 caractères
  'Check for 2 or 5 characters
  If Len(chaine$) = 2 Or Len(chaine$) = 5 Then
    'Et que ce sont bien des chiffres
    'And it is digits
    For i% = 1 To Len(chaine$)
      If Asc(Mid$(chaine$, i%, 1)) < 48 Or Asc(Mid$(chaine$, i%, 1)) > 57 Then
        Exit Function
      End If
    Next
    'Calcul de la clé de contrôle
    'Checksum calculation
    If Len(chaine$) = 2 Then
      checksum% = 10 + chaine$ Mod 4 'On augmente la checksum de 10 pour faciliter les tests plus bas / We add 10 to the checksum for make easier the below tests
    Else
      For i% = 1 To 5 Step 2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
      Next
      checksum% = (checksum% * 3 + Val(Mid$(chaine$, 2, 1)) * 9 + Val(Mid$(chaine$, 4, 1)) * 9) Mod 10
    End If
    AddOn$ = "["
    For i% = 1 To Len(chaine$)
      tableA = False
      Select Case i%
      Case 1
        Select Case checksum%
        Case 4 To 9, 10, 11
          tableA = True
        End Select
      Case 2
        Select Case checksum%
        Case 1, 2, 3, 5, 6, 9, 10, 12
          tableA = True
        End Select
      Case 3
        Select Case checksum%
        Case 0, 2, 3, 6, 7, 8
          tableA = True
        End Select
      Case 4
        Select Case checksum%
        Case 0, 1, 3, 4, 8, 9
          tableA = True
        End Select
      Case 5
        Select Case checksum%
        Case 0, 1, 2, 4, 5, 7
          tableA = True
        End Select
      End Select
      If tableA Then
        AddOn$ = AddOn$ & Chr$(65 + Val(Mid$(chaine$, i%, 1)))
      Else
        AddOn$ = AddOn$ & Chr$(75 + Val(Mid$(chaine$, i%, 1)))
      End If
      If (Len(chaine$) = 2 And i% = 1) Or (Len(chaine$) = 5 And i% < 5) Then AddOn$ = AddOn$ & Chr$(92) 'Ajout du séparateur de caractère / Add character separator
    Next
  End If
End Function