Private Const SET_B As Integer = 0
Private Const SET_A As Integer = 1
Private Const SET_C As Integer = 2

' A large value used to mark a state that has not been reached yet.
Private Const UNREACHABLE As Integer = 100000000


' Main function to call from an SSRS expression.
'
' Example:
' =Code.Code128Auto(Fields!OrderNr.Value)
'
' The returned string must be displayed with:
' Libre Barcode 128
Public Function Code128Auto(ByVal value As Object) As String

    Dim codes As System.Collections.ArrayList
    codes = BuildCompleteCodewords(value)

    If codes Is Nothing Then
        Return ""
    End If

    Dim result As New System.Text.StringBuilder()
    Dim i As Integer

    For i = 0 To codes.Count - 1
        result.Append( _
            LibreBarcodeCharacter( _
                System.Convert.ToInt32(codes(i)) _
            ) _
        )
    Next

    Return result.ToString()

End Function


' Optional diagnostic function.
'
' It returns the generated Code 128 codeword values, including:
' START, data/switch symbols, checksum and STOP.
'
' Example:
' =Code.Code128Debug("DZ00001538371")
Public Function Code128Debug(ByVal value As Object) As String

    Dim codes As System.Collections.ArrayList
    codes = BuildCompleteCodewords(value)

    If codes Is Nothing Then
        Return "INVALID OR UNSUPPORTED INPUT"
    End If

    Dim result As New System.Text.StringBuilder()
    Dim i As Integer

    For i = 0 To codes.Count - 1

        If i > 0 Then
            result.Append(",")
        End If

        result.Append(System.Convert.ToString(codes(i)))

    Next

    Return result.ToString()

End Function


' Builds the complete Code 128 symbol list:
' START + data/switch symbols + checksum + STOP.
Private Function BuildCompleteCodewords( _
    ByVal value As Object _
) As System.Collections.ArrayList

    If value Is Nothing Then
        Return Nothing
    End If

    If System.Convert.IsDBNull(value) Then
        Return Nothing
    End If

    Dim text As String
    text = System.Convert.ToString(value)

    If text Is Nothing OrElse text.Length = 0 Then
        Return Nothing
    End If

    Dim codes As System.Collections.ArrayList
    codes = FindShortestEncoding(text)

    If codes Is Nothing OrElse codes.Count = 0 Then
        Return Nothing
    End If

    ' Code 128 checksum:
    ' START value + each following codeword multiplied by its
    ' one-based position, all reduced modulo 103.
    Dim checksum As Integer
    checksum = System.Convert.ToInt32(codes(0))

    Dim i As Integer

    For i = 1 To codes.Count - 1
        checksum = checksum _
            + System.Convert.ToInt32(codes(i)) * i
    Next

    checksum = checksum Mod 103

    codes.Add(checksum)

    ' STOP symbol
    codes.Add(106)

    Return codes

End Function


' Finds a shortest valid encoding by dynamically selecting and switching
' between Code Sets A, B and C.
'
' Code Set A:
' ASCII 0-95, including control characters.
'
' Code Set B:
' ASCII 32-127, including upper/lower-case letters and printable symbols.
'
' Code Set C:
' Two decimal digits per Code 128 symbol.
'
' SHIFT is used for one character where that is shorter than permanently
' changing between Code Sets A and B.
Private Function FindShortestEncoding( _
    ByVal text As String _
) As System.Collections.ArrayList

    Dim textLength As Integer
    textLength = text.Length

    ' Each input position has three possible states:
    ' currently in Set B, Set A or Set C.
    Dim nodeCount As Integer
    nodeCount = (textLength + 1) * 3

    Dim distance() As Integer
    Dim visited() As Boolean
    Dim previousNode() As Integer
    Dim emittedCode1() As Integer
    Dim emittedCode2() As Integer
    Dim emittedCount() As Integer

    ReDim distance(nodeCount - 1)
    ReDim visited(nodeCount - 1)
    ReDim previousNode(nodeCount - 1)
    ReDim emittedCode1(nodeCount - 1)
    ReDim emittedCode2(nodeCount - 1)
    ReDim emittedCount(nodeCount - 1)

    Dim i As Integer

    For i = 0 To nodeCount - 1
        distance(i) = UNREACHABLE
        previousNode(i) = -2
    Next

    ' Create one possible starting state for each Code Set.
    ' Set B is intentionally the first state, so printable ASCII uses
    ' START B when two equally short encodings exist.
    Dim startB As Integer
    startB = GetNode(0, SET_B)
    distance(startB) = 1
    previousNode(startB) = -1
    emittedCode1(startB) = 104
    emittedCount(startB) = 1

    Dim startA As Integer
    startA = GetNode(0, SET_A)
    distance(startA) = 1
    previousNode(startA) = -1
    emittedCode1(startA) = 103
    emittedCount(startA) = 1

    Dim startC As Integer
    startC = GetNode(0, SET_C)
    distance(startC) = 1
    previousNode(startC) = -1
    emittedCode1(startC) = 105
    emittedCount(startC) = 1

    ' Dijkstra shortest-path search.
    ' Every emitted Code 128 symbol has a cost of one.
    Dim iteration As Integer

    For iteration = 0 To nodeCount - 1

        Dim currentNode As Integer
        currentNode = -1

        Dim lowestDistance As Integer
        lowestDistance = UNREACHABLE

        For i = 0 To nodeCount - 1

            If Not visited(i) Then

                If distance(i) < lowestDistance Then
                    lowestDistance = distance(i)
                    currentNode = i
                End If

            End If

        Next

        If currentNode = -1 Then
            Exit For
        End If

        visited(currentNode) = True

        Dim position As Integer
        position = currentNode \ 3

        Dim currentSet As Integer
        currentSet = currentNode Mod 3

        If position < textLength Then

            Dim currentCharacter As String
            currentCharacter = text.Substring(position, 1)

            Dim valueA As Integer
            Dim valueB As Integer
            Dim pairValue As Integer

            Select Case currentSet

                Case SET_A

                    ' Encode directly in Code Set A.
                    valueA = GetCodeAValue(currentCharacter)

                    If valueA >= 0 Then

                        RelaxNode( _
                            currentNode, _
                            GetNode(position + 1, SET_A), _
                            1, _
                            valueA, _
                            0, _
                            1, _
                            distance, _
                            previousNode, _
                            emittedCode1, _
                            emittedCode2, _
                            emittedCount _
                        )

                    End If

                    ' SHIFT temporarily to Set B for one character.
                    ' This is only useful when the character is unavailable
                    ' in Set A.
                    valueB = GetCodeBValue(currentCharacter)

                    If valueA < 0 AndAlso valueB >= 0 Then

                        RelaxNode( _
                            currentNode, _
                            GetNode(position + 1, SET_A), _
                            2, _
                            98, _
                            valueB, _
                            2, _
                            distance, _
                            previousNode, _
                            emittedCode1, _
                            emittedCode2, _
                            emittedCount _
                        )

                    End If

                    ' Permanently change A -> B.
                    RelaxNode( _
                        currentNode, _
                        GetNode(position, SET_B), _
                        1, _
                        100, _
                        0, _
                        1, _
                        distance, _
                        previousNode, _
                        emittedCode1, _
                        emittedCode2, _
                        emittedCount _
                    )

                    ' Permanently change A -> C.
                    RelaxNode( _
                        currentNode, _
                        GetNode(position, SET_C), _
                        1, _
                        99, _
                        0, _
                        1, _
                        distance, _
                        previousNode, _
                        emittedCode1, _
                        emittedCode2, _
                        emittedCount _
                    )


                Case SET_B

                    ' Encode directly in Code Set B.
                    valueB = GetCodeBValue(currentCharacter)

                    If valueB >= 0 Then

                        RelaxNode( _
                            currentNode, _
                            GetNode(position + 1, SET_B), _
                            1, _
                            valueB, _
                            0, _
                            1, _
                            distance, _
                            previousNode, _
                            emittedCode1, _
                            emittedCode2, _
                            emittedCount _
                        )

                    End If

                    ' SHIFT temporarily to Set A for one character.
                    ' This is only useful when the character is unavailable
                    ' in Set B.
                    valueA = GetCodeAValue(currentCharacter)

                    If valueB < 0 AndAlso valueA >= 0 Then

                        RelaxNode( _
                            currentNode, _
                            GetNode(position + 1, SET_B), _
                            2, _
                            98, _
                            valueA, _
                            2, _
                            distance, _
                            previousNode, _
                            emittedCode1, _
                            emittedCode2, _
                            emittedCount _
                        )

                    End If

                    ' Permanently change B -> A.
                    RelaxNode( _
                        currentNode, _
                        GetNode(position, SET_A), _
                        1, _
                        101, _
                        0, _
                        1, _
                        distance, _
                        previousNode, _
                        emittedCode1, _
                        emittedCode2, _
                        emittedCount _
                    )

                    ' Permanently change B -> C.
                    RelaxNode( _
                        currentNode, _
                        GetNode(position, SET_C), _
                        1, _
                        99, _
                        0, _
                        1, _
                        distance, _
                        previousNode, _
                        emittedCode1, _
                        emittedCode2, _
                        emittedCount _
                    )


                Case SET_C

                    ' Code Set C encodes two ASCII digits as one symbol.
                    If position + 1 < textLength Then

                        If IsAsciiDigitAt(text, position) AndAlso _
                           IsAsciiDigitAt(text, position + 1) Then

                            pairValue = _
                                (CharacterCode(text.Substring(position, 1)) - 48) * 10 _
                                + _
                                (CharacterCode(text.Substring(position + 1, 1)) - 48)

                            RelaxNode( _
                                currentNode, _
                                GetNode(position + 2, SET_C), _
                                1, _
                                pairValue, _
                                0, _
                                1, _
                                distance, _
                                previousNode, _
                                emittedCode1, _
                                emittedCode2, _
                                emittedCount _
                            )

                        End If

                    End If

                    ' Permanently change C -> A.
                    RelaxNode( _
                        currentNode, _
                        GetNode(position, SET_A), _
                        1, _
                        101, _
                        0, _
                        1, _
                        distance, _
                        previousNode, _
                        emittedCode1, _
                        emittedCode2, _
                        emittedCount _
                    )

                    ' Permanently change C -> B.
                    RelaxNode( _
                        currentNode, _
                        GetNode(position, SET_B), _
                        1, _
                        100, _
                        0, _
                        1, _
                        distance, _
                        previousNode, _
                        emittedCode1, _
                        emittedCode2, _
                        emittedCount _
                    )

            End Select

        End If

    Next

    ' Prefer Set B when multiple final states have equal length.
    Dim finalNode As Integer
    finalNode = GetNode(textLength, SET_B)

    If distance(GetNode(textLength, SET_A)) < distance(finalNode) Then
        finalNode = GetNode(textLength, SET_A)
    End If

    If distance(GetNode(textLength, SET_C)) < distance(finalNode) Then
        finalNode = GetNode(textLength, SET_C)
    End If

    If distance(finalNode) >= UNREACHABLE Then
        Return Nothing
    End If

    ' Reconstruct the selected route backwards.
    Dim reversedCodes As New System.Collections.ArrayList()

    Dim node As Integer
    node = finalNode

    Do While node >= 0

        If emittedCount(node) = 2 Then

            ' Add backwards because the entire list will be reversed later.
            reversedCodes.Add(emittedCode2(node))
            reversedCodes.Add(emittedCode1(node))

        ElseIf emittedCount(node) = 1 Then

            reversedCodes.Add(emittedCode1(node))

        End If

        node = previousNode(node)

    Loop

    Dim codes As New System.Collections.ArrayList()

    For i = reversedCodes.Count - 1 To 0 Step -1
        codes.Add(reversedCodes(i))
    Next

    Return codes

End Function


' Updates a destination state if this route is shorter.
Private Sub RelaxNode( _
    ByVal fromNode As Integer, _
    ByVal toNode As Integer, _
    ByVal addedDistance As Integer, _
    ByVal outputCode1 As Integer, _
    ByVal outputCode2 As Integer, _
    ByVal outputCount As Integer, _
    ByRef distance() As Integer, _
    ByRef previousNode() As Integer, _
    ByRef emittedCode1() As Integer, _
    ByRef emittedCode2() As Integer, _
    ByRef emittedCount() As Integer _
)

    Dim newDistance As Integer
    newDistance = distance(fromNode) + addedDistance

    If newDistance < distance(toNode) Then

        distance(toNode) = newDistance
        previousNode(toNode) = fromNode
        emittedCode1(toNode) = outputCode1
        emittedCode2(toNode) = outputCode2
        emittedCount(toNode) = outputCount

    End If

End Sub


Private Function GetNode( _
    ByVal position As Integer, _
    ByVal codeSet As Integer _
) As Integer

    Return position * 3 + codeSet

End Function


' Returns the Code 128 value for one character in Code Set A.
Private Function GetCodeAValue( _
    ByVal character As String _
) As Integer

    Dim asciiValue As Integer
    asciiValue = CharacterCode(character)

    ' ASCII 32-95 map to Code 128 values 0-63.
    If asciiValue >= 32 AndAlso asciiValue <= 95 Then
        Return asciiValue - 32
    End If

    ' ASCII control characters 0-31 map to values 64-95.
    If asciiValue >= 0 AndAlso asciiValue <= 31 Then
        Return asciiValue + 64
    End If

    Return -1

End Function


' Returns the Code 128 value for one character in Code Set B.
Private Function GetCodeBValue( _
    ByVal character As String _
) As Integer

    Dim asciiValue As Integer
    asciiValue = CharacterCode(character)

    ' ASCII 32-127 map to Code 128 values 0-95.
    If asciiValue >= 32 AndAlso asciiValue <= 127 Then
        Return asciiValue - 32
    End If

    Return -1

End Function


Private Function CharacterCode( _
    ByVal character As String _
) As Integer

    Dim result As Integer
    result = AscW(character)

    If result < 0 Then
        result = result + 65536
    End If

    Return result

End Function


Private Function IsAsciiDigitAt( _
    ByVal text As String, _
    ByVal position As Integer _
) As Boolean

    Dim value As Integer
    value = CharacterCode(text.Substring(position, 1))

    Return value >= 48 AndAlso value <= 57

End Function


' Converts a Code 128 symbol value into the Unicode character expected by
' the uploaded Libre Barcode 128 Regular font.
'
' Important:
' Codeword 0 is deliberately returned as U+00C2 ("Â"), not a normal space.
' The font also supports contextual substitution of a normal space, but using
' U+00C2 directly avoids depending on OpenType contextual-alternate support
' in the SSRS renderer. This also makes Code C value "00" and checksum 0
' reliable in preview, PDF and print output.
Private Function LibreBarcodeCharacter( _
    ByVal codeValue As Integer _
) As String

    If codeValue = 0 Then
        Return ChrW(194)       ' U+00C2, Code 128 value 0
    End If

    If codeValue >= 1 AndAlso codeValue <= 94 Then
        Return ChrW(codeValue + 32)
    End If

    If codeValue >= 95 AndAlso codeValue <= 106 Then
        Return ChrW(codeValue + 100)
    End If

    Return ""

End Function