Attribute VB_Name = "IDAutomation_QRFE_VBA"
'*****************************************************************
' IDAutomation QR Code Font Encoder VBA 2017
' © Copyright, 2017 IDAutomation.com, Inc. All rights reserved.
' Redistribution and use of this code in source and/or binary
' forms, with or without modification, are permitted provided
' that: (1) all copies of the source code retain the above
' unmodified copyright notice and this entire unmodified
' section of text, (2) You or Your organization owns a
' valid License to this product from IDAutomation.com
' and, (3) when any portion of this code is bundled in any
' form with an application, a valid notice must be provided
' within the user documentation, start-up screen or in the
' help-about section of the application that specifies
' IDAutomation.com as the provider of the Software bundled
' with the application.
'*****************************************************************


Option Explicit

'' params:
''   DataToEncode                 text to encode
''   ProcessTilde = 0             If = 1 the Tilde will be processed | http://www.idautomation.com/barcode-faq/2d/qr-code/#Control_Characters
''   EncodingModes = 0            0=Binary | 1=0nly numbers and uppercase letters | 2=Numbers only
''   ErrorCorrectionLevels = 0    0=15% | 1=30% | 2=7% | 3-25% | http://www.idautomation.com/barcode-faq/2d/qr-code/#Encoding_Modes
''   Version = 0                  0=Automatic | http://www.idautomation.com/barcode-faq/2d/qr-code/#Symbol_Version
''   ProcessMask = 1              When =1 the mask will be processed and symbols will take more time to generate
''   NewLineCharacter = vbCrLf


Const BackgroundTransparent As Boolean = False

Private mvarMatrix() As Byte
Private mvarBitCount() As Variant
Private mvarEcw() As Variant
Private mvarEcb() As Variant
Private mvarEcc() As Variant
Private mvarLg() As Variant
Private mvarEx() As Variant
Private mvarCodeInfo(43) As Variant
Private mvarPattern() As Variant
Private mvarVersion As Integer
Private mvarTextData As String
Private mvarData() As Byte
Private mvarInit As Boolean
Private mvarFNC1 As Integer
Private mvarFNC1_AI As Integer
Private mvarTmpFolder As String
Private StringLength As Integer
Const MAX_PATH = 255


Public Function IDAutomation_QRCode_FontEncoder(DataToEncode As String, _
                                  Optional ProcessTilde As Integer = 1, _
                                  Optional EncodingModes As Integer = 0, _
                                  Optional ErrorCorrectionLevels As Integer = 0, _
                                  Optional Version As Integer = 0, _
                                  Optional ProcessMask As Integer = 1, _
                                  Optional NewLineCharacter As String = vbCrLf, _
                                  Optional QuietZone As Integer = 1) As String



  Dim EncMode As Byte, TextLen As Long, MaskNum As Integer, ErrLevel As Integer, ReturnImage As Integer
  
  ReturnImage = 0
  Call zzInit
  mvarFNC1 = 0
  mvarFNC1_AI = 0
  
  'Check for null data
  If IsNull(DataToEncode) Or DataToEncode = "" Then
    IDAutomation_QRCode_FontEncoder = ""
    'Call clearImage
    Exit Function
  End If
  
  'Check for data overload and if so,
  '1. Set the symbol to EC=L so more data may be encoded and
  '2. Truncate trailing data if necessary
  If ErrorCorrectionLevels = 2 Then 'L
    If EncodingModes = 0 And Len(DataToEncode) > 2950 Then DataToEncode = Left(DataToEncode, 2950)
    If EncodingModes = 1 And Len(DataToEncode) > 4290 Then DataToEncode = Left(DataToEncode, 4290)
    If EncodingModes = 2 And Len(DataToEncode) > 7080 Then DataToEncode = Left(DataToEncode, 7080)
  End If
  
  If ErrorCorrectionLevels = 0 Then 'M
    If EncodingModes = 0 And Len(DataToEncode) > 2325 Then DataToEncode = Left(DataToEncode, 2950): ErrorCorrectionLevels = 2
    If EncodingModes = 1 And Len(DataToEncode) > 3385 Then DataToEncode = Left(DataToEncode, 4290): ErrorCorrectionLevels = 2
    If EncodingModes = 2 And Len(DataToEncode) > 5590 Then DataToEncode = Left(DataToEncode, 7080): ErrorCorrectionLevels = 2
  End If

  If ErrorCorrectionLevels = 3 Then 'Q
    If EncodingModes = 0 And Len(DataToEncode) > 1660 Then DataToEncode = Left(DataToEncode, 2950): ErrorCorrectionLevels = 2
    If EncodingModes = 1 And Len(DataToEncode) > 2415 Then DataToEncode = Left(DataToEncode, 4290): ErrorCorrectionLevels = 2
    If EncodingModes = 2 And Len(DataToEncode) > 3985 Then DataToEncode = Left(DataToEncode, 7080): ErrorCorrectionLevels = 2
  End If
  
  If ErrorCorrectionLevels = 1 Then 'H
    If EncodingModes = 0 And Len(DataToEncode) > 1270 Then DataToEncode = Left(DataToEncode, 2950): ErrorCorrectionLevels = 2
    If EncodingModes = 1 And Len(DataToEncode) > 1850 Then DataToEncode = Left(DataToEncode, 4290): ErrorCorrectionLevels = 2
    If EncodingModes = 2 And Len(DataToEncode) > 3050 Then DataToEncode = Left(DataToEncode, 7080): ErrorCorrectionLevels = 2
  End If
  'To properly support FNC1 in both positions, zzApplyFNC must run before zzProcessTilde
  If ProcessTilde = 1 Then DataToEncode = zzApplyFNC(DataToEncode, EncodingModes)
  'Check for ~mNN (MOD10 for GS1) or ~fNN (MOD43 for HIBC) or ~iNN (MOD37 for ISBT)
  If ProcessTilde = 1 Then DataToEncode = zzProcessTilde(DataToEncode)
  'End of processing DataToEncode text
  EncMode = 0
  If EncodingModes = 0 Then
    EncMode = 2
  ElseIf EncodingModes = 1 Then
    EncMode = 1
    DataToEncode = zzFilterAlphaNum(DataToEncode)
  ElseIf EncodingModes = 2 Then
    EncMode = 0
    DataToEncode = zzFilterNum(DataToEncode)
  ElseIf EncodingModes = -1 Then
    EncMode = zzFindBestMode(DataToEncode)
  End If
  
  ErrLevel = 0
  If ErrorCorrectionLevels = 2 Then
    ErrLevel = 0
  ElseIf ErrorCorrectionLevels = 0 Then
    ErrLevel = 1
  ElseIf ErrorCorrectionLevels = 3 Then
    ErrLevel = 2
  ElseIf ErrorCorrectionLevels = 1 Then
    ErrLevel = 3
  End If
  
  If (Trim(DataToEncode) = "") Or _
     ((ErrorCorrectionLevels < 0) Or (ErrorCorrectionLevels > 3)) Or _
     ((EncodingModes < -1) Or (EncodingModes > 3)) Then Err.Raise 5, "IDAutomation_QRCode_FontEncoder", "Parameter error"
  
  If (Version < -4) Then Version = -4
  If (Version > 40) Then Version = 40
  If Val(Version) = 0 Then Version = 0
  
  mvarTextData = DataToEncode
  
  TextLen = Len(mvarTextData)

  mvarVersion = zzFinMinimunVersion(TextLen, Version, EncMode, ErrLevel)
  ReDim mvarMatrix(mvarCodeInfo(mvarVersion + 3)(0) - 1, mvarCodeInfo(mvarVersion + 3)(0) - 1) As Byte

  Call zzEncodeData(ErrLevel, EncMode, TextLen)
  Call zzMakePattern
  Call zzPutWords(ErrLevel, zzReedSolomon(ErrLevel))
  
  MaskNum = 2
  If ProcessMask = 1 Then MaskNum = zzGetBestMask()
  
  Call zzPutMask(ErrLevel, MaskNum)
  'Return Font Text
  IDAutomation_QRCode_FontEncoder = zzMatrix2Font(MaskNum, NewLineCharacter)

End Function

Private Function zzAlphaTable(c As String) As Integer
  Const table = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ $%*+-./:"
  zzAlphaTable = InStr(table, c)
End Function

Private Function zzApplyFNC(code As String, EncodingModes As Integer) As String
  Dim i As Integer
  Dim cTilde As Integer
  Dim longi As Integer
  Dim result As String
  Dim justTilde As Boolean
  Dim ascString As String
  Dim asc As Integer
  Dim nextc As Integer
  Dim nextd As String
  Dim ai As String
  
  result = ""
  longi = Len(code)
  cTilde = 0
  justTilde = True
 
  For i = 0 To longi - 1
    'Check for ~~,~1,~2 but not ~dnnn
    cTilde = AscW(Mid(code, i + 1, 1))
    justTilde = True
    If cTilde = 126 Then
      ' process special cases
      If i < longi - 3 Then
        nextc = AscW(Mid(code, i + 2, 1))
        If nextc = 126 Then
          ' ~~
          result = result + "~"
          justTilde = False
          i = i + 1
        ElseIf (nextc = 49) And (i = 0) Then
          ' ~1 as the first FNC1
          mvarFNC1 = 1
          justTilde = False
          i = i + 1
        ElseIf (nextc = 49) And (i > 1) Then
          ' ~1 as a second FNC1
          If EncodingModes = 0 Then result = result + ChrW(29)
          If EncodingModes = 1 Then result = result + "%"
          justTilde = False
          i = i + 1
        ElseIf (nextc = 50) And (i = 0) Then
          ' ~2
          mvarFNC1 = 2
          justTilde = False
          i = i + 1
          If i < longi Then
            If Mid(code, i + 2, 1) = "(" Then
              i = i + 2
              Do While Mid(code, i + 1, 1) <> ")"
                If i >= longi Then Exit Do
                nextd = Mid(code, i + 1, 1)
                If nextd >= "0" And nextd <= "9" Then
                  ai = ai & nextd
                End If
                i = i + 1
              Loop
              mvarFNC1_AI = Val(ai) And &HFF
            End If
          End If
        ElseIf (nextc = 50) And (i > 1) Then
          ' ~2 as a second FNC1
          If EncodingModes = 0 Then result = result + ChrW(29)
          If EncodingModes = 1 Then result = result + "%"
          justTilde = False
          i = i + 1
          '~dNNN from this section moved to zzProcessTilde
        Else
          'tilde character, followed by anthing other than the casses above is just a tilde character
          result = result + ChrW(cTilde)
        End If
        
        'tilde character, followed by anthing other than the casses above is just a tilde character
      End If
    Else
      ' no escape
      result = result + ChrW(cTilde)
    End If
    Next i
    zzApplyFNC = result
    'end applyTilde
End Function

Public Function zzProcessTilde(StringToProcess As String) As String
        zzProcessTilde = ""
        Dim OutString As String
        Dim CharsAdded As Integer
        Dim StringToCheck As String
        Dim WeightValue As Integer
        Dim WeightTotal As Integer
        Dim CharCode As Integer
        Dim CharValue As Integer
        Dim CheckDigit, CheckDigitValue, CurrentCharNum As String
        Dim Pos As Integer
        Const CharSet As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%"
        Dim i, j As Integer
        StringLength = Len(StringToProcess)
        For i = 1 To StringLength
            '' LM 2017
            '' changed for tilde string for ~mNN (MOD10 for GS1) or ~fNN (MOD43 for HIBC) or ~iNN (MOD37 for ISBT)
            If (i < StringLength - 2) And (Mid(StringToProcess, i, 2) = "~m" Or Mid(StringToProcess, i, 2) = "~f" Or Mid(StringToProcess, i, 2) = "~i" Or Mid(StringToProcess, i, 2) = "~k") And IsNumeric(Mid(StringToProcess, i + 2, 2)) Then
                WeightValue = Val(Mid(StringToProcess, i + 2, 2))
                
                If Mid(StringToProcess, i, 2) = "~m" Then
                  '' 0-9
                  For j = i - 1 To 1 Step -1
                      If IsNumeric(Mid(OutString, j, 1)) Then
                          StringToCheck = Mid(OutString, j, 1) & StringToCheck
                          CharsAdded = CharsAdded + 1
                      End If
                      'when the number of digits added to StringToCheck equals the weight value exit the for loop
                      If CharsAdded = WeightValue Then
                          Exit For
                      End If
                  Next
                  CheckDigitValue = zzMODU10(StringToCheck)
                  OutString = OutString & ChrW(CheckDigitValue + 48)
                ElseIf Mid(StringToProcess, i, 2) = "~f" Then
                  '' only correct chars
                  For j = i - 1 To 1 Step -1
                      Pos = InStr(CharSet, Mid(OutString, j, 1))
                      If Pos > 0 Then
                          StringToCheck = Mid(OutString, j, 1) & StringToCheck
                          CharsAdded = CharsAdded + 1
                      End If
                      'when the number of digits added to StringToCheck equals the weight value exit the for loop
                      If CharsAdded = WeightValue Then
                          Exit For
                      End If
                  Next
                
                  WeightTotal = 0
                  For j = 1 To WeightValue
                    WeightTotal = WeightTotal + InStr(CharSet, Mid(StringToCheck, j, 1)) - 1
                  Next
                  WeightTotal = WeightTotal Mod 43
                  OutString = OutString & Mid(CharSet, WeightTotal + 1, 1)
                  
                ElseIf Mid(StringToProcess, i, 2) = "~i" Then
                  '' only 0-9, A-Z characters
                  For j = i - 1 To 1 Step -1
                      Pos = InStr(CharSet, Mid(OutString, j, 1))
                      If (Pos > 0 And Pos < 37) Then
                          StringToCheck = Mid(OutString, j, 1) & StringToCheck
                          CharsAdded = CharsAdded + 1
                      End If
                      'when the number of digits added to StringToCheck equals the weight value exit the for loop
                      If CharsAdded = WeightValue Then
                          Exit For
                      End If
                  Next
                
                  For j = 1 To WeightValue
                    CharCode = asc(Mid(StringToCheck, j, 1))
                    If (CharCode > 47 And CharCode < 58) Then CharValue = CharCode - 48
                    If (CharCode > 64 And CharCode < 91) Then CharValue = CharCode - 55
                    WeightTotal = ((WeightTotal + CharValue) * 2) Mod 37
                  Next
                  WeightTotal = (38 - WeightTotal) Mod 37
                  If (WeightTotal < 10) Then CheckDigit = ChrW(WeightTotal + 48) '' 0-9
                  If (WeightTotal < 36 And WeightTotal > 9) Then CheckDigit = ChrW(WeightTotal + 55) '' A-Z
                  If (WeightTotal = 36) Then CheckDigit = ChrW(42)
                  OutString = OutString & CheckDigit
                  
                End If
                i = i + 3
            ElseIf (i < StringLength - 2) And Mid(StringToProcess, i, 1) = "~" And IsNumeric(Mid(StringToProcess, i + 1, 3)) Then
                CurrentCharNum = Val(Mid(StringToProcess, i + 1, 3))
                OutString = OutString & ChrW(CurrentCharNum)
                i = i + 3
            Else
               OutString = OutString & Mid(StringToProcess, i, 1)
            End If
        Next i
        zzProcessTilde = OutString
        StringToProcess = ""
End Function

Public Function zzMODU10(M10NumberData As String) As Integer
' This is a general MOD10 function like the one required
' for UCC, EAN and UPC barcodes
'********************************************************
     Dim M10StringLength As Integer
     Dim M10OnlyCorrectData As String
     Dim M10Factor As Integer
     Dim M10WeightedTotal As Integer
     Dim M10CheckDigit, CurrentCharNum As Integer
     Dim M10I As Integer
     M10OnlyCorrectData = ""
     M10StringLength = Len(M10NumberData)
     'Check to make sure data is numeric and remove dashes, etc.
     For M10I = 1 To M10StringLength
        'Add all numbers to OnlyCorrectData string
        '2006.2 BDA modified the next 2 lines for compatibility with different office versions
         CurrentCharNum = AscW(Mid(M10NumberData, M10I, 1))
         If CurrentCharNum > 47 And CurrentCharNum < 58 Then M10OnlyCorrectData = M10OnlyCorrectData & Mid(M10NumberData, M10I, 1)
     Next
    'Generate MOD 10 check digit
     M10Factor = 3
     M10WeightedTotal = 0
     M10StringLength = Len(M10NumberData)
     For M10I = M10StringLength To 1 Step -1
    'Get the value of each number starting at the end
    'CurrentCharNum = Mid(M10NumberData, I, 1)
    'Multiply by the weighting factor which is 3,1,3,1...
    'and add the sum together
          M10WeightedTotal = M10WeightedTotal + (Val(Mid(M10NumberData, M10I, 1)) * M10Factor)
          'Change factor for next calculation
          M10Factor = 4 - M10Factor
     Next
    'Find the CheckDigit by finding the smallest number that = a multiple of 10
     M10I = (M10WeightedTotal Mod 10)
     If M10I <> 0 Then
          M10CheckDigit = (10 - M10I)
     Else
          M10CheckDigit = 0
     End If
     zzMODU10 = Str(M10CheckDigit)
End Function

Private Function zzASCII256(code As String) As String
  Dim i As Integer
  Dim result As String
  result = "256TEST:"
  For i = 0 To 255
    result = result + Chr(i)
  Next i
  zzASCII256 = result
End Function


Private Sub zzEncodeData(Level As Integer, mode As Byte, l As Long)
  Dim f As Double
  Dim v As Double
  Dim c As Long
  Dim eb As Long
  Dim nCapacity As Long
  
  Dim k As Long
  Dim i As Long
  Dim j As Long
  
  nCapacity = mvarCodeInfo(mvarVersion + 3)(1) \ 8 - mvarEcw(Level)(mvarVersion + 3) * mvarEcb(Level)(mvarVersion + 3)
  
  ReDim mvarData(mvarCodeInfo(mvarVersion + 3)(1) + mvarEcw(Level)(mvarVersion + 3) * mvarEcb(Level)(mvarVersion + 3)) As Byte
  
  c = 0 ' encode head indicator bits
  eb = 0
  
  k = mvarCodeInfo(mvarVersion + 3)(3)(mode)
  
  If mvarVersion > 0 Then
    If mvarFNC1 = 1 Then
      ' FNC1 in first position; FNC Mode 1
      f = 5          ' FNC1 = 0101
      eb = 4
    ElseIf mvarFNC1 = 2 Then
      ' FNC1 in s'econd position; FNC Mode 2
      f = 9          ' FNC1 = 1001
      f = f * 2 ^ 8 + mvarFNC1_AI
      eb = 12
    End If
    
    v = f * (2 ^ 4) + Array(1, 2, 4)(mode)
    eb = eb + 4
  Else
    v = mode
    eb = mvarVersion + 3 ' mode indicator
  End If
  
  eb = eb + k
  v = v * 2 ^ k + l  ' character count indicator
  
  ' encode all data
  Select Case mode
    ' numeric mode
    Case 0:
      For i = 1 To l
        v = v * IIf(i + 1 < l, 1024, IIf(i < l, 128, 16)) + Val(Mid(mvarTextData, i, 3))
        eb = eb + IIf(i + 1 < l, 10, 4 + 3 * (l - i))
        i = i + 2

        ' add data to bit stream
        Call zzEncodeDataAddBit(eb, c, v)
      Next
      
    ' alphanumeric mode
    Case 1:
      For i = 1 To l
        j = zzAlphaTable(Mid(mvarTextData, i, 1)) - 1
        If i < l Then j = 45 * j + zzAlphaTable(Mid(mvarTextData, i + 1, 1)) - 1
        v = v * IIf(i < l, 2048, 64) + j
        eb = eb + IIf(i < l, 11, 6)
        i = i + 1

        ' add data to bit stream
        Call zzEncodeDataAddBit(eb, c, v)
      Next
    
    ' binary mode
    Case 2
      For i = 1 To l
        v = v * 256 + asc(Mid(mvarTextData, i, 1))
        eb = eb + 8

        ' add data to bit stream
        Call zzEncodeDataAddBit(eb, c, v)
      Next
      
  End Select
  
  If nCapacity > c Then
    i = IIf(mvarVersion > 0, 4, mvarVersion + 6)
    v = v * 2 ^ i
    eb = eb + i ' terminator
  End If
  
  mvarData(c) = (v * 256) \ 2 ^ eb
  c = c + 1
  mvarData(c) = ((v * 65536) \ 2 ^ eb) And 255
  If eb > 8 And nCapacity >= c Then c = c + 1 ' bit padding
  If (mvarVersion And -3) = -3 And nCapacity = c Then mvarData(c) = mvarData(c) \ 16 ' M1,M3: shift high bits to low nibble
  i = 236
  
  ' byte padding
  For c = c To nCapacity - 1
    mvarData(c) = IIf((mvarVersion And -3) = -3 And c = nCapacity - 1, 0, i)
    i = i Xor 236 Xor 17
  Next c

End Sub

Private Sub zzEncodeDataAddBit(ByRef eb As Long, ByRef c As Long, ByRef v As Double)
  Dim j As Long
  Dim d As Double
  
  ' add data to bit stream
  For eb = eb To 8 Step -8
    j = 2 ^ (eb - 8)
    d = Int(v / j)
    mvarData(c) = d
    v = v - d * j
    c = c + 1
  Next
  
End Sub

Private Function zzFilterNum(Text As String) As String
  Dim l As Long
  Dim temp As String
  Dim i As Long
  Dim c As String
    
  temp = ""
  l = Len(Text)
  If l > 0 Then
    For i = 1 To l
      c = Mid$(Text, i, 1)
      If c >= "0" And c <= "9" Then
        temp = temp & c
      End If
    Next
  End If
  zzFilterNum = temp
End Function

Private Function zzFilterAlphaNum(Text As String) As String
  Dim l As Long
  Dim temp As String
  Dim i As Long
  Dim c As String
    
  temp = ""
  l = Len(Text)
  If l > 0 Then
    For i = 1 To l
      c = UCase(Mid$(Text, i, 1))
      If zzAlphaTable(c) > 0 Then
        temp = temp & c
      End If
    Next
  End If
  zzFilterAlphaNum = temp
End Function

Private Function zzFindBestMode(ByRef Text As String) As Byte
  Dim i As Integer
  Dim mode As Byte
  Dim c As Byte
    
  '' look for a better encoding mode
  mode = 0 ' numeric
  For i = 1 To Len(Text)
    c = AscW(Mid(Text, i, 1))
    If c < 48 Or c > 57 Then
      If mode = 0 Then mode = 1 ' alphanumeric mode
      If zzAlphaTable(ChrW(c)) = 0 Then
        If mode = 1 Then
          mode = 2 ' binary
          zzFindBestMode = mode
          Exit Function
        End If
      End If
    End If
  Next i
  zzFindBestMode = mode
  
End Function

Private Function zzFinMinimunVersion(l As Long, Version As Integer, mode As Byte, ByRef Lev As Integer) As Integer
  Dim j As Integer
  Dim nCapacity As Long
  Dim i As Integer
  Dim k As Integer
  Dim NumBits As Long
  Dim f As Integer
  
  If (Version = 0) Then
    Version = 1
  Else
    If Version < 0 Then Version = Version + 1
  End If
  Version = IIf(Version < mode - 3, mode - 3, Version) - 1
  ' data width
  If mode = 0 Then
    NumBits = Int(l * (10 / 3) + 0.5) ' 3 digits in 10 bits
  ElseIf mode = 1 Then
    NumBits = Int(l * (11 / 2) + 0.5) ' 2 chars in 11 bits
  ElseIf mode = 2 Then
    NumBits = l * 8                   ' 1 byte
  ElseIf mode = 3 Then
    NumBits = l * 13                  ' 13 bits/byte
  End If
  
  Do ' look for QR minimun version
    Version = Version + 1
    If Version > 40 Then Err.Raise 6, "QRCode", "Message too long"
    f = IIf(Version > 0 And mvarFNC1 = 1, 4, IIf(Version > 0 And mvarFNC1 = 2, 12, 0)) ' FNC mode bit indicator
    j = mvarEcc(Lev)(Version + 3)
    nCapacity = mvarCodeInfo(Version + 3)(1)
    i = mvarCodeInfo(Version + 3)(2) ' mode indicator bits, M1+M3: +4 bits
    k = mvarCodeInfo(Version + 3)(3)(mode) ' count indcator bits
  Loop While NumBits > (nCapacity And -8) - j * 8 - i - k - f
 
  zzFinMinimunVersion = Version
End Function

Function zzGetBestMask() As Integer
  Dim MaskNum As Long
  Dim p As Long
  Dim l As Long
  Dim k As Byte
  Dim x As Integer
  Dim Y As Integer
  Dim i As Integer
  Dim j As Integer
  Dim W As Integer
  Dim c As Integer
  Dim k1 As String
  Dim k2 As String
  Dim s As Integer
  
  
  s = mvarCodeInfo(mvarVersion + 3)(0) ' symbol size
  MaskNum = 0
  p = 1000000 ' data masking
  
  '' lok for the best mask pattern
  If mvarVersion < 1 Then ' Micro-QRCode
    For k = 0 To 3
      x = 1
      Y = 1
      For i = 1 To s - 1
        x = x - zzPattern(i, s - 1, k)
        Y = Y - zzPattern(s - 1, i, k)
      Next i
      
      If x > Y Then
        j = 16 * x + Y
      Else
        j = x + 16 * Y
      End If
      
      If j < p Then
        p = j
        MaskNum = k ' take mask of lower penalty
      End If
    Next
  Else ' normal QRCode
    For k = 0 To 7
  
      l = 0
      k2 = ""
      j = 0
      For Y = 0 To s - 1 ' horizontal
        c = 0
        i = 0
        k1 = "0000"
        For x = 0 To s - 1
          W = zzPattern(x, Y, k)
          l = l + W
          k1 = k1 & W ' rule 4: count darks
          If c = W Then ' same as prev
            i = i + 1
            If x And Mid(k2, x + 4, 2) = c & c Then j = j + 3 ' rule 2: block 2x2
          Else
            If i > 5 Then j = j + i - 2 ' rule 1: >5 adjacent
            c = 1 - c: i = 1
          End If
        Next x
        If i > 5 Then j = j + i - 2 ' rule 1: >5 adjacent
        i = 0
        Do ' rule 3: like finder pattern
          i = InStr(i + 4, k1, "1011101")
          If i < 1 Then Exit Do
          If Mid(k1, i - 4, 4) = "0000" Or Mid(k1 & "0000", i + 7, 4) = "0000" Then j = j + 40
        Loop
        k2 = k1 ' rule 2: remember last line
      Next Y
      For x = 0 To s - 1 ' vertical
        c = 0
        i = 0
        k1 = "0000"
        For Y = 0 To s - 1
          W = zzPattern(x, Y, k)
          k1 = k1 & W ' vertical to string
          If c = W Then ' same as prev
            i = i + 1
          Else
            If i > 5 Then j = j + i - 2 ' rule 1: >5 adjacent
            c = 1 - c: i = 1
          End If
        Next Y
        If i > 5 Then j = j + i - 2 ' rule 1: >5 adjacent
        i = 0
        Do ' rule 3: like finder pattern
          i = InStr(i + 4, k1, "1011101")
          If i < 1 Then Exit Do
          If Mid(k1, i - 4, 4) = "0000" Or Mid(k1 & "0000", i + 7, 4) = "0000" Then j = j + 40
        Loop
      Next x
      j = j + Int(Abs(10 - 20 * l / (s * s))) * 10 ' rule 4: darks
  
      If j < p Then
        p = j
        MaskNum = k ' take mask of lower penalty
      End If
    Next
    
  End If
  
  zzGetBestMask = MaskNum
  
End Function

Private Sub zzInit()

  If Not mvarInit Then
    mvarInit = True
    
    '# of bits of count indicator
    mvarBitCount = Array( _
                    Array(10, 12, 14), _
                    Array(9, 11, 13), _
                    Array(8, 16, 16), _
                    Array(8, 10, 12) _
                   )
                   
    ' error correction words L,M,Q,H for all version sizes (99=N/A)
    mvarEcw = Array( _
                Array(2, 5, 6, 8, 7, 10, 15, 20, 26, 18, 20, 24, 30, 18, 20, 24, 26, 30, 22, 24, 28, 30, 28, 28, 28, 28, 30, 30, 26, 28, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30), _
                Array(99, 6, 8, 10, 10, 16, 26, 18, 24, 16, 18, 22, 22, 26, 30, 22, 22, 24, 24, 28, 28, 26, 26, 26, 26, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28), _
                Array(99, 99, 99, 14, 13, 22, 18, 26, 18, 24, 18, 22, 20, 24, 28, 26, 24, 20, 30, 24, 28, 28, 26, 30, 28, 30, 30, 30, 30, 28, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30), _
                Array(99, 99, 99, 99, 17, 28, 22, 16, 22, 28, 26, 26, 24, 28, 24, 28, 22, 24, 24, 30, 28, 28, 26, 28, 30, 24, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30) _
              )
  
    ' error correction blocks L,M,Q,H for all version sizes (99=N/A)
    mvarEcb = Array( _
                Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 4, 4, 4, 4, 4, 6, 6, 6, 6, 7, 8, 8, 9, 9, 10, 12, 12, 12, 13, 14, 15, 16, 17, 18, 19, 19, 20, 21, 22, 24, 25), _
                Array(1, 1, 1, 1, 1, 1, 1, 2, 2, 4, 4, 4, 5, 5, 5, 8, 9, 9, 10, 10, 11, 13, 14, 16, 17, 17, 18, 20, 21, 23, 25, 26, 28, 29, 31, 33, 35, 37, 38, 40, 43, 45, 47, 49), _
                Array(1, 1, 1, 1, 1, 1, 2, 2, 4, 4, 6, 6, 8, 8, 8, 10, 12, 16, 12, 17, 16, 18, 21, 20, 23, 23, 25, 27, 29, 34, 34, 35, 38, 40, 43, 45, 48, 51, 53, 56, 59, 62, 65, 68), _
                Array(1, 1, 1, 1, 1, 1, 2, 4, 4, 4, 5, 6, 8, 8, 11, 11, 16, 16, 18, 16, 19, 21, 25, 25, 25, 34, 30, 32, 35, 37, 40, 42, 45, 48, 51, 54, 57, 60, 63, 66, 70, 74, 77, 81) _
              )
              
    ' error correction
    mvarEcc = Array( _
                Array(2, 5, 6, 8, 7, 10, 15, 20, 26, 36, 40, 48, 60, 72, 80, 96, 104, 120, 132, 144, 168, 180, 196, 224, 224, 252, 270, 300, 312, 336, 360, 390, 420, 450, 480, 510, 540, 570, 570, 600, 630, 660, 720, 750), _
                Array(99, 6, 8, 10, 10, 16, 26, 36, 48, 64, 72, 88, 110, 130, 150, 176, 198, 216, 240, 280, 308, 338, 364, 416, 442, 476, 504, 560, 588, 644, 700, 728, 784, 812, 868, 924, 980, 1036, 1064, 1120, 1204, 1260, 1316, 1372), _
                Array(99, 99, 99, 14, 13, 22, 36, 52, 72, 96, 108, 132, 160, 192, 224, 260, 288, 320, 360, 408, 448, 504, 546, 600, 644, 690, 750, 810, 870, 952, 1020, 1050, 1140, 1200, 1290, 1350, 1440, 1530, 1590, 1680, 1770, 1860, 1950, 2040), _
                Array(99, 99, 99, 99, 17, 28, 44, 64, 88, 112, 130, 156, 192, 224, 264, 308, 352, 384, 432, 480, 532, 588, 650, 700, 750, 816, 900, 960, 1050, 1110, 1200, 1260, 1350, 1440, 1530, 1620, 1710, 1800, 1890, 1980, 2100, 2220, 2310, 2430) _
              )
              
              
    ' log/exp table
    mvarEx = Array(1, 2, 4, 8, 16, 32, 64, 128, 29, 58, 116, 232, 205, 135, 19, 38, 76, 152, 45, 90, 180, 117, 234, 201, 143, 3, 6, 12, 24, 48, 96, 192, 157, 39, 78, 156, 37, 74, 148, 53, 106, 212, 181, 119, 238, 193, 159, 35, 70, 140, 5, 10, 20, 40, 80, 160, 93, 186, 105, 210, 185, 111, 222, 161, 95, 190, 97, 194, 153, 47, 94, _
                  188, 101, 202, 137, 15, 30, 60, 120, 240, 253, 231, 211, 187, 107, 214, 177, 127, 254, 225, 223, 163, 91, 182, 113, 226, 217, 175, 67, 134, 17, 34, 68, 136, 13, 26, 52, 104, 208, 189, 103, 206, 129, 31, 62, 124, 248, 237, 199, 147, 59, 118, 236, 197, 151, 51, 102, 204, 133, 23, 46, 92, 184, 109, 218, 169, 79, 158, 33, 66, 132, 21, 42, 84, _
                  168, 77, 154, 41, 82, 164, 85, 170, 73, 146, 57, 114, 228, 213, 183, 115, 230, 209, 191, 99, 198, 145, 63, 126, 252, 229, 215, 179, 123, 246, 241, 255, 227, 219, 171, 75, 150, 49, 98, 196, 149, 55, 110, 220, 165, 87, 174, 65, 130, 25, 50, 100, 200, 141, 7, 14, 28, 56, 112, 224, 221, 167, 83, 166, 81, 162, 89, 178, 121, 242, 249, 239, 195, _
                  155, 43, 86, 172, 69, 138, 9, 18, 36, 72, 144, 61, 122, 244, 245, 247, 243, 251, 235, 203, 139, 11, 22, 44, 88, 176, 125, 250, 233, 207, 131, 27, 54, 108, 216, 173, 71, 142, 0)
    mvarLg = Array(0, 0, 1, 25, 2, 50, 26, 198, 3, 223, 51, 238, 27, 104, 199, 75, 4, 100, 224, 14, 52, 141, 239, 129, 28, 193, 105, 248, 200, 8, 76, 113, 5, 138, 101, 47, 225, 36, 15, 33, 53, 147, 142, 218, 240, 18, 130, 69, 29, 181, 194, 125, 106, 39, 249, 185, 201, 154, 9, 120, 77, 228, 114, 166, 6, 191, 139, 98, 102, 221, 48, _
                  253, 226, 152, 37, 179, 16, 145, 34, 136, 54, 208, 148, 206, 143, 150, 219, 189, 241, 210, 19, 92, 131, 56, 70, 64, 30, 66, 182, 163, 195, 72, 126, 110, 107, 58, 40, 84, 250, 133, 186, 61, 202, 94, 155, 159, 10, 21, 121, 43, 78, 212, 229, 172, 115, 243, 167, 87, 7, 112, 192, 247, 140, 128, 99, 13, 103, 74, 222, 237, 49, 197, 254, 24, _
                  227, 165, 153, 119, 38, 184, 180, 124, 17, 68, 146, 217, 35, 32, 137, 46, 55, 63, 209, 91, 149, 188, 207, 205, 144, 135, 151, 178, 220, 252, 190, 97, 242, 86, 211, 171, 20, 42, 93, 158, 132, 60, 57, 83, 71, 109, 65, 162, 31, 45, 67, 216, 183, 123, 164, 118, 196, 23, 73, 236, 127, 12, 111, 246, 108, 161, 59, 82, 41, 157, 85, 170, 251, _
                  96, 134, 177, 187, 204, 62, 90, 203, 89, 95, 176, 156, 169, 160, 81, 11, 245, 22, 235, 122, 117, 44, 215, 79, 174, 213, 233, 230, 231, 173, 232, 116, 214, 244, 234, 168, 80, 88, 175, 0)
  
  
    ' array of code info
    mvarCodeInfo(0) = Array(11, &H28, 4, Array(3, 2, 2, 1))
    mvarCodeInfo(1) = Array(13, &H54, 1, Array(4, 3, 3, 2))
    mvarCodeInfo(2) = Array(15, &H88, 6, Array(5, 4, 4, 3))
    mvarCodeInfo(3) = Array(17, &HC4, 3, Array(6, 5, 5, 4))
    mvarCodeInfo(4) = Array(21, &HD0, 4, Array(10, 9, 8, 8))
    mvarCodeInfo(5) = Array(25, &H167, 4, Array(10, 9, 8, 8))
    mvarCodeInfo(6) = Array(29, &H237, 4, Array(10, 9, 8, 8))
    mvarCodeInfo(7) = Array(33, &H327, 4, Array(10, 9, 8, 8))
    mvarCodeInfo(8) = Array(37, &H437, 4, Array(10, 9, 8, 8))
    mvarCodeInfo(9) = Array(41, &H567, 4, Array(10, 9, 8, 8))
    mvarCodeInfo(10) = Array(45, &H620, 4, Array(10, 9, 8, 8))
    mvarCodeInfo(11) = Array(49, &H790, 4, Array(10, 9, 8, 8))
    mvarCodeInfo(12) = Array(53, &H920, 4, Array(10, 9, 8, 8))
    mvarCodeInfo(13) = Array(57, &HAD0, 4, Array(12, 11, 16, 10))
    mvarCodeInfo(14) = Array(61, &HCA0, 4, Array(12, 11, 16, 10))
    mvarCodeInfo(15) = Array(65, &HE90, 4, Array(12, 11, 16, 10))
    mvarCodeInfo(16) = Array(69, &H10A0, 4, Array(12, 11, 16, 10))
    mvarCodeInfo(17) = Array(73, &H122B, 4, Array(12, 11, 16, 10))
    mvarCodeInfo(18) = Array(77, &H147B, 4, Array(12, 11, 16, 10))
    mvarCodeInfo(19) = Array(81, &H16EB, 4, Array(12, 11, 16, 10))
    mvarCodeInfo(20) = Array(85, &H197B, 4, Array(12, 11, 16, 10))
    mvarCodeInfo(21) = Array(89, &H1C2B, 4, Array(12, 11, 16, 10))
    mvarCodeInfo(22) = Array(93, &H1EFB, 4, Array(12, 11, 16, 10))
    mvarCodeInfo(23) = Array(97, &H21EB, 4, Array(12, 11, 16, 10))
    mvarCodeInfo(24) = Array(101, &H2424, 4, Array(12, 11, 16, 10))
    mvarCodeInfo(25) = Array(105, &H2754, 4, Array(12, 11, 16, 10))
    mvarCodeInfo(26) = Array(109, &H2AA4, 4, Array(12, 11, 16, 10))
    mvarCodeInfo(27) = Array(113, &H2E14, 4, Array(12, 11, 16, 10))
    mvarCodeInfo(28) = Array(117, &H31A4, 4, Array(12, 11, 16, 10))
    mvarCodeInfo(29) = Array(121, &H3554, 4, Array(12, 11, 16, 10))
    mvarCodeInfo(30) = Array(125, &H3924, 4, Array(14, 13, 16, 12))
    mvarCodeInfo(31) = Array(129, &H3C0B, 4, Array(14, 13, 16, 12))
    mvarCodeInfo(32) = Array(133, &H401B, 4, Array(14, 13, 16, 12))
    mvarCodeInfo(33) = Array(137, &H444B, 4, Array(14, 13, 16, 12))
    mvarCodeInfo(34) = Array(141, &H489B, 4, Array(14, 13, 16, 12))
    mvarCodeInfo(35) = Array(145, &H4D0B, 4, Array(14, 13, 16, 12))
    mvarCodeInfo(36) = Array(149, &H519B, 4, Array(14, 13, 16, 12))
    mvarCodeInfo(37) = Array(153, &H564B, 4, Array(14, 13, 16, 12))
    mvarCodeInfo(38) = Array(157, &H59E0, 4, Array(14, 13, 16, 12))
    mvarCodeInfo(39) = Array(161, &H5ED0, 4, Array(14, 13, 16, 12))
    mvarCodeInfo(40) = Array(165, &H63E0, 4, Array(14, 13, 16, 12))
    mvarCodeInfo(41) = Array(169, &H6910, 4, Array(14, 13, 16, 12))
    mvarCodeInfo(42) = Array(173, &H6E60, 4, Array(14, 13, 16, 12))
    mvarCodeInfo(43) = Array(177, &H73D0, 4, Array(14, 13, 16, 12))
  
  
    mvarPattern = Array(Array(383, 321, 349, 349, 349, 321, 383, 256, 511), _
                  Array(256, 383, 321, 349, 349, 349, 321, 383), _
                  Array(254, 130, 186, 186, 186, 130, 254, 0, 255), _
                  Array(31, 17, 21, 17, 31))
                  
    'mvarTmpFolder = zzGetTempDir()
                  
  End If
            
End Sub

Private Sub zzMakePattern()
  Dim x As Integer
  Dim Y As Integer
  Dim a As Integer
  Dim i As Integer
  Dim j As Integer
  Dim c As Integer
  Dim p As Byte
  Dim m As Integer
  Dim k As Integer
  
  ' fill QR matrix with pattern
  
  ' timing pattern
  If mvarVersion < 1 Then
    For i = 8 To mvarCodeInfo(mvarVersion + 3)(0) - 1
      mvarMatrix(i, 0) = i And 1 Xor 3
      mvarMatrix(0, i) = i And 1 Xor 3
    Next i
    
    a = 1

  Else
    For i = 8 To mvarCodeInfo(mvarVersion + 3)(0) - 1
      mvarMatrix(i, 6) = i And 1 Xor 3
      mvarMatrix(6, i) = i And 1 Xor 3
    Next i
    
    ' reserve version area
    If mvarVersion > 6 Then
      For i = 0 To 17
        mvarMatrix(i \ 3, mvarCodeInfo(mvarVersion + 3)(0) - 11 + i Mod 3) = 2
        mvarMatrix(mvarCodeInfo(mvarVersion + 3)(0) - 11 + i Mod 3, i \ 3) = 2
      Next i
    End If
    
    If mvarVersion < 2 Then
      a = 2
    Else
      a = mvarVersion \ 7 + 2
    End If
    
  End If
  
  ' layout finder/align pattern
  For x = 1 To a
    For Y = 1 To a
      If x = 1 And Y = 1 Then
        ' finder upper left
        i = 0
        j = 0
        p = 0
      ElseIf x = 1 And Y = a Then
        ' finder lower left
        i = 0
        j = mvarCodeInfo(mvarVersion + 3)(0) - 8
        p = 1
      ElseIf x = a And Y = 1 Then
        ' finder upper right
        i = mvarCodeInfo(mvarVersion + 3)(0) - 8
        j = 0
        p = 2
      Else
        ' alignment grid
        c = 2 * Int(2 * (mvarVersion + 1) / (1 - a)) ' pattern spacing
        i = IIf(x = 1, 4, mvarCodeInfo(mvarVersion + 3)(0) - 9 + c * (a - x))
        j = IIf(Y = 1, 4, mvarCodeInfo(mvarVersion + 3)(0) - 9 + c * (a - Y))
        p = 3 ' alignment pattern
      End If
      
      If mvarVersion <> 1 Or x + Y < 4 Then ' no align pattern for version 1
        For c = 0 To UBound(mvarPattern(p)) ' set fixed pattern, reserve space
          m = mvarPattern(p)(c)
          k = 0
          Do
            mvarMatrix(i + k, j + c) = (m And 1) Or 2
            m = m \ 2
            k = k + 1
          Loop While 2 ^ k <= mvarPattern(p)(0)
        Next c
      End If
    Next Y
  Next x

End Sub

Private Function zzMatrix2Font(MaskNum As Integer, NewLine As String) As String
  Dim j As Integer
  Dim i As Integer
  Dim size As Integer
  Dim temp() As Byte
  Dim fontText As String
  Dim strCaller As String
  Dim shp As Shape
  
  Call clearImage
  
  strCaller = Application.Caller.Address
  
  size = mvarCodeInfo(mvarVersion + 3)(0) ' symbol size
  ReDim temp(size, size) As Byte
  
  For i = 0 To size - 1
    For j = 0 To size - 1
      If zzPattern(j, i, MaskNum) Then ' apply mask
        temp(j, i) = 1
      End If
    Next
  Next
  
  For j = 0 To size Step 4
    For i = 0 To size
      ' ***************************************************
      ' ** if !=0 then it is a black (foreground) square **
      If temp(i, j) <> 0 Then
        If temp(i, (j + 1)) <> 0 Then
          'check for end of resultbitmap
          If j + 2 >= size Then
            fontText = fontText + "D"
          Else
            If temp(i, (j + 2)) <> 0 Then
              If temp(i, (j + 3)) <> 0 Then
                fontText = fontText + "A"
              Else
                fontText = fontText + "B"
              End If
            Else
              If temp(i, (j + 3)) <> 0 Then
                fontText = fontText + "C"
              Else
                fontText = fontText + "D"
              End If
            End If 'check for end
          End If
        Else
          'check for end of resultbitmap
          If j + 2 >= size Then
            fontText = fontText + "H"
          Else
            If temp(i, (j + 2)) <> 0 Then
              If temp(i, (j + 3)) <> 0 Then
                fontText = fontText + "E"
              Else
                fontText = fontText + "F"
              End If
            Else
              If temp(i, (j + 3)) <> 0 Then
                fontText = fontText + "G"
              Else
                fontText = fontText + "H"
              End If
            End If 'check for end
          End If
        End If
      Else
        If temp(i, (j + 1)) <> 0 Then
          'check for end of resultbitmap
          If j + 2 >= size Then
             fontText = fontText + "L"
          Else
           If temp(i, (j + 2)) <> 0 Then
             If temp(i, (j + 3)) <> 0 Then
               fontText = fontText + "I"
             Else
               fontText = fontText + "J"
             End If
           Else
             If temp(i, (j + 3)) <> 0 Then
               fontText = fontText + "K"
             Else
               fontText = fontText + "L"
             End If
           End If 'check for end
          End If
        Else
          'check for end of resultbitmap
          If j + 2 >= size Then
             fontText = fontText + "P"
          Else
            If temp(i, (j + 2)) <> 0 Then
              If temp(i, (j + 3)) <> 0 Then
                fontText = fontText + "M"
              Else
                fontText = fontText + "N"
              End If
            Else
              If temp(i, (j + 3)) <> 0 Then
                fontText = fontText + "O"
              Else
                fontText = fontText + "P"
              End If
            End If 'check for end
          End If
        End If
      End If
    Next i 'New Line
    fontText = fontText + NewLine
  Next j
  zzMatrix2Font = fontText
End Function


' get QR pattern mask
Private Function zzPattern(ByVal x As Long, ByVal Y As Long, ByVal MaskNum As Integer) As Integer
  Dim i As Integer
  Dim j As Long
  
  If mvarVersion < 1 Then
    ' mask pattern of micro QR
    MaskNum = Array(1, 4, 6, 7)(MaskNum)
  End If
  
  i = mvarMatrix(x, Y)
  If i < 2 Then
    Select Case MaskNum
      Case 0: j = (x + Y) And 1
      Case 1: j = Y And 1
      Case 2: j = x Mod 3
      Case 3: j = (x + Y) Mod 3
      Case 4: j = (x \ 3 + Y \ 2) And 1
      Case 5: j = ((x * Y) And 1) + (x * Y) Mod 3
      Case 6: j = (x * Y + (x * Y) Mod 3) And 1
      Case 7: j = (x + Y + (x * Y) Mod 3) And 1
    End Select
    If j = 0 Then i = i Xor 1 ' invert only data according mask
  End If
  zzPattern = i And 1
End Function

Private Sub zzPutMask(Lev As Integer, MaskNum As Integer)
  Dim j As Integer
  Dim k As Double
  Dim i As Integer
  Dim s As Integer
  
  ' add format information, code level and mask
  s = mvarCodeInfo(mvarVersion + 3)(0)
  
  If mvarVersion = -3 Then
    j = 1024 * MaskNum
  ElseIf mvarVersion < 1 Then
    j = 1024 * ((2 * mvarVersion + Lev + 5) * 4 + MaskNum)
  Else
    j = 1024 * (((5 - Lev) And 3) * 8 + MaskNum)
  End If
  
  k = j
  For i = 4 To 0 Step -1 ' BCH error correction: 5 data, 10 error bits
    If j >= 1024 * 2 ^ i Then j = j Xor 1335 * 2 ^ i
  Next i ' generator polynom: x^10+x^8+x^5+x^4+x^2+x+1 = 10100110111b = 1335
  k = k Xor j Xor IIf(mvarVersion < 1, 17477, 21522) ' XOR masking
  
  For j = 0 To 14 ' layout format information
    If mvarVersion < 1 Then
      mvarMatrix(IIf(j < 8, 8, 15 - j), IIf(j < 8, j + 1, 8)) = k And 1 Xor 2 ' micro QR
    Else
      mvarMatrix(IIf(j < 8, s - j - 1, IIf(j = 8, 7, 14 - j)), 8) = k And 1 Xor 2 ' QR horizontal
      mvarMatrix(8, IIf(j < 6, j, IIf(j < 8, j + 1, s + j - 15))) = k And 1 Xor 2 ' vertical
    End If
    k = k \ 2
  Next j
  
  If mvarVersion > 6 Then ' add version information
    k = mvarVersion * 4096&
    For i = 5 To 0 Step -1 ' BCH error correction: 6 data, 12 error bits
      If k >= 4096 * 2 ^ i Then k = k Xor 7973 * 2 ^ i
    Next i ' generator polynom: x^12+x^11+x^10+x^9+x^8+x^5+x^2+1 = 1111100100101b = 7973
    k = k Xor (mvarVersion * 4096&)
    For j = 0 To 17 ' layout version information
      mvarMatrix(j \ 3, s + j Mod 3 - 11) = k And 1 Xor 2
      mvarMatrix(s + j Mod 3 - 11, j \ 3) = k And 1 Xor 2
      k = k \ 2
    Next j
  End If
  

End Sub

Private Sub zzPutWords(Level As Integer, ReedSolomon As Long)
  Dim i As Long
  Dim j As Long
  Dim x As Long
  Dim Y As Long
  Dim c As Long
  Dim k As Long
  Dim nWords As Long
  Dim nCapacity As Long
  Dim nErrBytes As Long
  Dim nErrBlocks As Long
  Dim nBlocks As Long
  Dim s As Integer
  
  
  s = mvarCodeInfo(mvarVersion + 3)(0)
  nErrBlocks = mvarEcb(Level)(mvarVersion + 3) ' # of error correction blocks
  nCapacity = mvarCodeInfo(mvarVersion + 3)(1) \ 8 - mvarEcw(Level)(mvarVersion + 3) * nErrBlocks ' data capacity
  nWords = nCapacity \ nErrBlocks ' # of words in group 1
  nErrBytes = mvarEcw(Level)(mvarVersion + 3) ' # of error correction bytes
  nBlocks = nErrBlocks + nWords * nErrBlocks - nCapacity ' # of blocks in group 1


  ' layout codewords
  x = s
  Y = s - 1
  For i = 0 To ReedSolomon - 1
    c = 0
    k = 0
    j = nWords + 1 ' interleave data
    If i >= nCapacity Then
      ' interleave checkwords
      c = nCapacity
      k = nCapacity
      j = nErrBytes
    ElseIf i + nErrBlocks - nBlocks >= nCapacity Then
      ' interleave group 2 last bytes
      c = -nBlocks
      k = c
    ElseIf (i Mod nErrBlocks) >= nBlocks Then
      ' interleave group 2
      c = -nBlocks
    Else
      ' interleave group 1
      j = j - 1
    End If
    c = mvarData(c + ((i - k) Mod nErrBlocks) * j + (i - k) \ nErrBlocks) ' interleave data
    For j = IIf((-3 And mvarVersion) = -3 And i = nCapacity - 1, 3, 7) To 0 Step -1 ' M1,M3: 4 bit
      k = IIf(mvarVersion > 0 And x < 6, 1, 0) ' skip vertical timing pattern
      ' advance x,y
      Do
        x = x - 1
        If 1 And (x + 1) Xor k Then
          If s - x - k And 2 Then
            If Y > 0 Then
              ' up, top turn
              Y = Y - 1
              x = x + 2
            End If
          Else
            If Y < s - 1 Then
              ' down, bottom turn
              Y = Y + 1
              x = x + 2
            End If
          End If
        End If
      Loop While mvarMatrix(x, Y) And 2 ' skip reserved area
      If c And 2 ^ j Then mvarMatrix(x, Y) = 1
    Next j
  Next i


End Sub

Private Function zzReedSolomon(Level As Integer) As Long
  
  Dim nErrBytes As Long
  Dim j As Long
  Dim i As Long
  Dim k As Long
  Dim c As Long

  Dim nCapacity As Long
  Dim nBlocks As Long
  Dim nWords As Long
  Dim nErrBlocks As Long
  Dim x As Long
  
  
  
  nErrBytes = mvarEcw(Level)(mvarVersion + 3) ' # of error correction bytes
  nErrBlocks = mvarEcb(Level)(mvarVersion + 3) ' # of error correction blocks
  nCapacity = mvarCodeInfo(mvarVersion + 3)(1) \ 8 - mvarEcw(Level)(mvarVersion + 3) * nErrBlocks ' data capacity
  nWords = nCapacity \ nErrBlocks ' # of words in group 1
  nBlocks = nErrBlocks + nWords * nErrBlocks - nCapacity ' # of blocks in group 1
  
  ' compute Reed Solomon error detection and correction
  ReDim Rs(nErrBytes + 1) As Integer
  ' compute RS generator polynomial
  Rs(0) = 1
  For i = 0 To nErrBytes - 1
    Rs(i + 1) = 0
    For j = i + 1 To 1 Step -1
     Rs(j) = Rs(j) Xor mvarEx((mvarLg(Rs(j - 1)) + i) Mod 255)
    Next
  Next
  
  ' compute RS correction data for each block
  k = 0
  For c = 1 To nErrBlocks
    For i = IIf(c <= nBlocks, 1, 0) To nWords
      x = mvarData(nCapacity) Xor mvarData(k)
      For j = 1 To nErrBytes
        mvarData(nCapacity + j - 1) = mvarData(nCapacity + j) Xor IIf(x, mvarEx((mvarLg(Rs(j)) + mvarLg(x)) Mod 255), 0)
      Next
      k = k + 1
    Next
    nCapacity = nCapacity + nErrBytes
  Next

  zzReedSolomon = nCapacity
End Function

Private Sub clearImage()

  Dim strCaller As String
  Dim shp As Shape
  
  If Not TypeOf Application.Caller Is Range Then Err.Raise 513, "IDAutomation code", "Call only from sheet"
  
  strCaller = Application.Caller.Address
  
  ' delete previous shapes
  For Each shp In Application.Caller.Parent.Shapes
    If shp.Name = strCaller Then
      ' remember format
      shp.Delete
    End If
  Next shp
End Sub



