Guest User

Untitled

a guest
Jul 29th, 2016
70
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Public Function code128$(chaine$)
  2.   'This function is governed by the GNU Lesser General Public License (GNU LGPL)
  3.  'V 2.0.0
  4.  'Parameters : a string
  5.  'Return : * a string which give the bar code when it is dispayed with CODE128.TTF font
  6.  '         * an empty string if the supplied parameter is no good
  7.  Dim i%, checksum&, mini%, dummy%, tableB As Boolean
  8.   code128$ = ""
  9.   If Len(chaine$) > 0 Then
  10.   'Check for valid characters
  11.    For i% = 1 To Len(chaine$)
  12.       Select Case Asc(Mid$(chaine$, i%, 1))
  13.       Case 32 To 126, 203
  14.       Case Else
  15.         i% = 0
  16.         Exit For
  17.       End Select
  18.     Next
  19.     'Calculation of the code string with optimized use of tables B and C
  20.    code128$ = ""
  21.     tableB = True
  22.     If i% > 0 Then
  23.       i% = 1 'i% devient l'index sur la chaine / i% become the string index
  24.      Do While i% <= Len(chaine$)
  25.         If tableB Then
  26.           'See if interesting to switch to table C
  27.          'yes for 4 digits at start or end, else if 6 digits
  28.          mini% = IIf(i% = 1 Or i% + 3 = Len(chaine$), 4, 6)
  29.           GoSub testnum
  30.           If mini% < 0 Then 'Choice of table C
  31.            If i% = 1 Then 'Starting with table C
  32.              code128$ = Chr$(205)
  33.             Else 'Switch to table C
  34.              code128$ = code128$ & Chr$(199)
  35.             End If
  36.             tableB = False
  37.           Else
  38.             If i% = 1 Then code128$ = Chr$(204) 'Starting with table B
  39.          End If
  40.         End If
  41.         If Not tableB Then
  42.           'We are on table C, try to process 2 digits
  43.          mini% = 2
  44.           GoSub testnum
  45.           If mini% < 0 Then 'OK for 2 digits, process it
  46.            dummy% = Val(Mid$(chaine$, i%, 2))
  47.             dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 100)
  48.             code128$ = code128$ & Chr$(dummy%)
  49.             i% = i% + 2
  50.           Else 'We haven't 2 digits, switch to table B
  51.            code128$ = code128$ & Chr$(200)
  52.             tableB = True
  53.           End If
  54.         End If
  55.         If tableB Then
  56.           'Process 1 digit with table B
  57.          code128$ = code128$ & Mid$(chaine$, i%, 1)
  58.           i% = i% + 1
  59.         End If
  60.       Loop
  61.       'Calculation of the checksum
  62.      For i% = 1 To Len(code128$)
  63.         dummy% = Asc(Mid$(code128$, i%, 1))
  64.         dummy% = IIf(dummy% < 127, dummy% - 32, dummy% - 100)
  65.         If i% = 1 Then checksum& = dummy%
  66.         checksum& = (checksum& + (i% - 1) * dummy%) Mod 103
  67.       Next
  68.       'Calculation of the checksum ASCII code
  69.      checksum& = IIf(checksum& < 95, checksum& + 32, checksum& + 100)
  70.       'Add the checksum and the STOP
  71.      code128$ = code128$ & Chr$(checksum&) & Chr$(206)
  72.     End If
  73.   End If
  74.   Exit Function
  75. testnum:
  76.   'if the mini% characters from i% are numeric, then mini%=0
  77.  mini% = mini% - 1
  78.   If i% + mini% <= Len(chaine$) Then
  79.     Do While mini% >= 0
  80.       If Asc(Mid$(chaine$, i% + mini%, 1)) < 48 Or Asc(Mid$(chaine$, i% + mini%, 1)) > 57 Then Exit Do
  81.       mini% = mini% - 1
  82.     Loop
  83.   End If
  84. Return
  85. End Function
Add Comment
Please, Sign In to add comment