home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / eMe_ID_Car2055213222007.psc / Code128.bas < prev    next >
BASIC Source File  |  2006-06-17  |  7KB  |  183 lines
  1. Attribute VB_Name = "Code128"
  2. Dim Code_A As String
  3. Dim Code_B() As Variant
  4. Private Const CodeC = 99
  5. Private Const CodeB = 100
  6. Private Const CodeA = 101
  7. Private Const FNC1 = 102
  8. Private Const StartA = 103
  9. Private Const StartB = 104
  10. Private Const StartC = 105
  11.  
  12. Dim BarH As Long
  13. Dim zBarText As String
  14. Dim xObj As Object
  15.  
  16. Dim xPos As Long, xtop As Long, mCnt As Integer, zHasCaption As Boolean
  17. Dim xStart As Integer, posCtr As Integer, xTotal As Long, chkSum As Long
  18. Sub Bar128(zObj As Object, zBarH As Integer, BarText As String, Optional ByVal HasCaption As Boolean = False)
  19.    Set xObj = zObj
  20.    Init_Table
  21.    zBarText = BarText
  22.    zHasCaption = HasCaption
  23.    xObj.Picture = Nothing
  24.    BarH = zBarH * 10
  25.    xtop = 10
  26.    
  27.    xObj.BackColor = vbWhite
  28.    xObj.AutoRedraw = True
  29.    xObj.ScaleMode = 3
  30.    If HasCaption Then
  31.       xObj.Height = (xObj.TextHeight(zBarText) + BarH + 25) * Screen.TwipsPerPixelY
  32.    Else
  33.       xObj.Height = (BarH + 20) * Screen.TwipsPerPixelY
  34.    End If
  35.    
  36.    'xObj.Height = (xObj.TextHeight(zBarText) + BarH + 25) * Screen.TwipsPerPixelY
  37.    xObj.Width = ((Test_String(zBarText) + 3) * 11 + 25) * Screen.TwipsPerPixelX
  38.    Paint_Code zBarText
  39.    zObj.Picture = zObj.Image
  40. End Sub
  41. Private Function Test_String(xstr As String)
  42.     Dim ii As Long, jj As Integer, ctr As Integer
  43.     ctr = 0
  44.     jj = 0
  45.     For ii = 1 To Len(xstr)
  46.         If InStr("0123456789", Mid(xstr, ii, 1)) > 0 Then
  47.            ctr = ctr + 1
  48.         Else
  49.            jj = jj + IIf(ctr = 0, 1, ctr)
  50.            ctr = 0
  51.         End If
  52.     Next
  53.     If (ctr >= 4 And ii >= Len(xstr)) Then
  54.         If jj <> 0 Then jj = jj + 1
  55.         If ctr Mod 2 <> 0 Then
  56.            ctr = ctr - 1
  57.            jj = jj + 2
  58.            
  59.         End If
  60.         jj = jj + (ctr / 2)
  61.     End If
  62.     Test_String = jj
  63. End Function
  64.  
  65. Private Sub Paint_Code(xstr As String)
  66.     Dim ii As Long, jj As Integer, ctr As Integer
  67.     xTotal = 0
  68.     xPos = 1
  69.     xStart = 0
  70.     ctr = 0
  71.     posCtr = 0
  72.     mCnt = 0
  73.     For ii = 1 To Len(xstr)
  74.         If InStr("0123456789", Mid(xstr, ii, 1)) > 0 Then
  75.            ctr = ctr + 1
  76.         Else
  77.            For jj = ii - ctr To ii
  78.                 PrintB Mid(xstr, jj, 1)
  79.                 mCnt = mCnt + 1
  80.            Next
  81.            ctr = 0
  82.         End If
  83.     Next
  84.     If (ctr >= 4 And ii >= Len(xstr)) Then
  85.         If ctr Mod 2 <> 0 Then
  86.            mCnt = mCnt + 1
  87.            PrintB Mid(xstr, ii - ctr, 1)
  88.            ctr = ctr - 1
  89.         End If
  90.         PrintC Mid(xstr, ii - ctr, ctr)
  91.     End If
  92.     chkSum = xTotal Mod 103
  93.     Draw_Bar CStr(Code_B(chkSum))
  94.     Draw_Bar "1100011101011"
  95.     
  96.    If zHasCaption Then
  97.         xObj.CurrentX = ((xPos + 20) / 2) - xObj.TextWidth(xstr) / 2   ' Horizontal position.
  98.         xObj.CurrentY = 15 + BarH    ' Vertical position.
  99.         xObj.Print xstr   ' Print message.
  100.     End If
  101.     'Picture = Me.Image
  102. End Sub
  103. Private Sub PrintB(xstr As String)
  104.         posCtr = posCtr + 1
  105.         xTotal = xTotal + ((InStr(Code_A, xstr) - 1) * posCtr)
  106.         If xStart <> StartB Then
  107.            
  108.            If xStart = 0 Then
  109.               xTotal = xTotal + StartB
  110.               xStart = StartB
  111.               Draw_Bar CStr(Code_B(StartB))
  112.             Else
  113.               xStart = CodeB
  114.               Draw_Bar CStr(Code_B(CodeB))
  115.               posCtr = posCtr + 1
  116.               xTotal = xTotal + (CodeB * posCtr)
  117.             End If
  118.         End If
  119.         Draw_Bar CStr(Code_B(InStr(Code_A, xstr) - 1))
  120. End Sub
  121. Private Sub PrintC(xstr As String)
  122. Dim jj As Integer
  123.     If xStart <> StartC Then
  124.        If xStart = 0 Then
  125.           xTotal = xTotal + StartC
  126.           xStart = StartC
  127.           Draw_Bar CStr(Code_B(StartC))
  128.         Else
  129.           xStart = CodeC
  130.           Draw_Bar CStr(Code_B(CodeC))
  131.           posCtr = posCtr + 1
  132.           xTotal = xTotal + (CodeC * posCtr)
  133.         End If
  134.     End If
  135.     SetC xstr
  136.     For jj = 1 To Len(xstr) Step 2
  137.        posCtr = posCtr + 1
  138.        xTotal = xTotal + CInt(Mid(xstr, jj, 2)) * posCtr
  139.     Next
  140.  
  141. End Sub
  142. Private Sub SetC(xstr As String)
  143.    For ii = 1 To Len(xstr) Step 2
  144.        Draw_Bar CStr(Code_B(CInt(Mid(xstr, ii, 2))))
  145.        mCnt = mCnt + 1
  146.    Next
  147. End Sub
  148. Private Sub Draw_Bar(Encoding As String)
  149.     Dim ii As Integer
  150.     For ii = 1 To Len(Encoding)
  151.         xPos = xPos + 1
  152.         xObj.Line (xPos + 10, xtop)-(xPos + 10, xtop + BarH), IIf(Mid(Encoding, ii, 1), vbBlack, vbWhite)
  153.     Next
  154.     ii = 0
  155. End Sub
  156. Private Sub Init_Table()
  157.     Code_A = " !""#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
  158.     Code_B = Array( _
  159.              "11011001100", "11001101100", "11001100110", "10010011000", "10010001100", "10001001100", _
  160.              "10011001000", "10011000100", "10001100100", "11001001000", "11001000100", "11000100100", _
  161.              "10110011100", "10011011100", "10011001110", "10111001100", "10011101100", "10011100110", _
  162.              "11001110010", "11001011100", "11001001110", "11011100100", "11001110100", "11101101110", _
  163.              "11101001100", "11100101100", "11100100110", "11101100100", "11100110100", "11100110010", _
  164.              "11011011000", "11011000110", "11000110110", "10100011000", "10001011000", "10001000110", _
  165.              "10110001000", "10001101000", "10001100010", "11010001000", "11000101000", "11000100010", _
  166.              "10110111000", "10110001110", "10001101110", "10111011000", "10111000110", "10001110110", _
  167.              "11101110110", "11010001110", "11000101110", "11011101000", "11011100010", "11011101110", _
  168.              "11101011000", "11101000110", "11100010110", "11101101000", "11101100010", "11100011010", _
  169.              "11101111010", "11001000010", "11110001010", "10100110000", "10100001100", "10010110000", _
  170.              "10010000110", "10000101100", "10000100110", "10110010000", "10110000100", "10011010000", _
  171.              "10011000010", "10000110100", "10000110010", "11000010010", "11001010000", "11110111010", _
  172.              "11000010100", "10001111010", "10100111100", "10010111100", "10010011110", "10111100100", _
  173.              "10011110100", "10011110010", "11110100100", "11110010100", "11110010010", "11011011110", _
  174.              "11011110110", "11110110110", "10101111000", "10100011110", "10001011110", "10111101000", _
  175.              "10111100010", "11110101000", "11110100010", "10111011110", "10111101110", "11101011110", _
  176.              "11110101110", "11010000100", "11010010000", "11010011100" _
  177.              )
  178. End Sub
  179.  
  180.  
  181.  
  182.  
  183.