Public Function BrCodeEAN13()

    Dim Str

    Dim Bar

    Dim Result

    Result = ""

        If Not IsNull(TCSRpt.RptFunc.MainRptRecordSet.FieldByAlias("BARCODE_ALIAS")) Then

        Str = TCSRpt.RptFunc.MainRptRecordSet.FieldByAlias("BARCODE_ALIAS").AsString

            If Len(Str) > 0 Then

                Call EAN13CODE(Str, Bar)

                Result = Bar

            End If

        End If

    BrCodeEAN13 = Result

End Function

 

Public Sub EAN13CODE(Code, BarCode)

'П/программа кодирования кодом EAN13

Dim R

Dim A, B, C, ISP

A = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9")

B = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")

C = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j")

ISP = Array(Array("A", "A", "A", "A", "A", "A"), _

            Array("A", "A", "B", "A", "B", "B"), _

            Array("A", "A", "B", "B", "A", "B"), _

            Array("A", "A", "B", "B", "B", "A"), _

            Array("A", "B", "A", "A", "B", "B"), _

            Array("A", "B", "B", "A", "A", "B"), _

            Array("A", "B", "B", "B", "A", "A"), _

            Array("A", "B", "A", "B", "A", "B"), _

            Array("A", "B", "A", "B", "B", "A"), _

            Array("A", "B", "B", "A", "B", "A"))

' Проверки

    I = Len(Code)

If I = 12 Then

'Расчет контрольной цифры

      CountParity = 0                                         '

    For I = 2 To 12 Step 2                                    'складываем

      CountParity = CountParity + Int(Mid(Code, I, 1))        'четные цифры

    Next                                                    '

      CountNotParity = 0                                      '

    For I = 1 To 11 Step 2                                    'складываем

      CountNotParity = CountNotParity + CInt(Mid(Code, I, 1)) 'нечетные цифры

    Next                                                    '

        ControlData = CountParity * 3 + CountNotParity        'Сумма цифр на четных и нечетных позициях

        R = ControlData / 10        'Результат деления четных и нечетных цифр на 10

                                    '

        If R - Int(R) = 0 Then      'Если число кратно 10

            ControlData = 0         'то контрольное число найдено

        Else                        'если нет, то

            I = 0

            Do                             'дополняем

             I = I + 1                     'число,

             ControlData = ControlData + 1 'до ближайшего

             R = ControlData / 10          'кратного 10

             If R - Int(R) = 0 Then        '

                ControlData = I

             Exit Do

             End If

            Loop                           '

        End If

     ControlData = ControlData

'Сборка штрих-кода

    j = CInt(Mid(Code, 1, 1))              '(13эл) Исполнение цифровых знаков

    BarCode = Chr(Asc(Mid(Code, 1, 1)) - 13)        'Флаг кода, цифра без штриха

    BarCode = BarCode & "!"                         'Краевой знак

    BarCode = BarCode & (A(CInt(Mid(Code, 2, 1))))  '(12эл) всегда А

  For I = 1 To 5                                    'Кодируем следующие 5 элементов

    If ISP(j)(I) = "A" Then

       BarCode = BarCode & (A(CInt(Mid(Code, I + 2, 1)))) 'элемент А

    Else

       BarCode = BarCode & (B(CInt(Mid(Code, I + 2, 1)))) 'элемент B

    End If

  Next

    BarCode = BarCode & "-"                         'Разделительный знак

  For I = 8 To 12                                   'Кодируем следующие 6 элементов

    BarCode = BarCode & (C(CInt(Mid(Code, I, 1))))  '

  Next

    BarCode = BarCode & C(ControlData)           'Контрольная цифра

    BarCode = BarCode & "!"                         'Краевой знак

Else

' если число позиций в коде не 12

End If

End Sub