frmbarmaker.frm

39规格条形码生成、读取程序 为尊重原作注释

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form FrmBarMaker 
   Caption         =   "39条形码生成程序  http://www.mndsoft.com"
   ClientHeight    =   3300
   ClientLeft      =   60
   ClientTop       =   375
   ClientWidth     =   6300
   Icon            =   "FrmBarMaker.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   ScaleHeight     =   3300
   ScaleWidth      =   6300
   StartUpPosition =   3  'Windows Default
   Begin MSComDlg.CommonDialog CD1 
      Left            =   3945
      Top             =   2820
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton Command3 
      Caption         =   "退出(&Q)"
      Height          =   345
      Left            =   5190
      TabIndex        =   11
      Top             =   2895
      Width           =   1065
   End
   Begin VB.CommandButton Command2 
      Caption         =   "打开条码图片"
      Height          =   360
      Left            =   2100
      TabIndex        =   10
      Top             =   2880
      Width           =   1365
   End
   Begin VB.Frame Frame1 
      Caption         =   "读取到的条形码的值:"
      Height          =   735
      Index           =   1
      Left            =   2115
      TabIndex        =   8
      Top             =   750
      Width           =   4095
      Begin VB.Label Label2 
         Height          =   240
         Left            =   225
         TabIndex        =   9
         Top             =   300
         Width           =   3420
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "设置"
      Height          =   1215
      Index           =   0
      Left            =   105
      TabIndex        =   3
      Top             =   495
      Width           =   1755
      Begin VB.CheckBox Check1 
         Caption         =   "添加标志"
         Height          =   195
         Index           =   1
         Left            =   120
         TabIndex        =   7
         ToolTipText     =   "Human readable"
         Top             =   600
         Value           =   1  'Checked
         Width           =   1545
      End
      Begin VB.CheckBox Check1 
         Caption         =   "添加校验字符"
         Height          =   195
         Index           =   2
         Left            =   120
         TabIndex        =   6
         ToolTipText     =   "Not commonly used"
         Top             =   840
         Width           =   1575
      End
      Begin VB.CheckBox Check1 
         Caption         =   "印刷优化"
         Height          =   195
         Index           =   0
         Left            =   120
         TabIndex        =   4
         ToolTipText     =   "Increases spacing"
         Top             =   360
         Value           =   1  'Checked
         Width           =   1515
      End
   End
   Begin VB.CommandButton Command1 
      Caption         =   "复制到剪切板"
      Height          =   375
      Left            =   90
      TabIndex        =   1
      Top             =   2880
      Width           =   1455
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   1320
      TabIndex        =   0
      Top             =   135
      Width           =   2415
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00FFFFFF&
      Height          =   1000
      Left            =   120
      ScaleHeight     =   63
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   405
      TabIndex        =   5
      Top             =   1770
      Width           =   6135
   End
   Begin VB.Label Label3 
      Caption         =   "识别条码时,请把鼠标移动到bmp图像的前面单击!"
      ForeColor       =   &H000000FF&
      Height          =   435
      Left            =   4020
      TabIndex        =   12
      Top             =   240
      Width           =   2235
   End
   Begin VB.Label Label1 
      Caption         =   "输入条码数据:"
      Height          =   255
      Index           =   0
      Left            =   60
      TabIndex        =   2
      Top             =   195
      Width           =   1455
   End
End
Attribute VB_Name = "FrmBarMaker"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Private Sub makeBC()
Dim X As Integer, Y As Integer, z As Integer, pos As Integer
Dim Bardata As String
Dim Cur As String
Dim CurVal As Long
Dim chksum As Long
Dim chkchr As String
Dim BC(43) As String
    '3 of the 9 bars are wide: 0=narrow, 1=wide
    BC(0) = "000110100" '0
    BC(1) = "100100001" '1
    BC(2) = "001100001" '2
    BC(3) = "101100000" '3
    BC(4) = "000110001" '4
    BC(5) = "100110000" '5
    BC(6) = "001110000" '6
    BC(7) = "000100101" '7
    BC(8) = "100100100" '8
    BC(9) = "001100100" '9
    BC(10) = "100001001" 'A
    BC(11) = "001001001" 'B
    BC(12) = "101001000" 'C
    BC(13) = "000011001" 'D
    BC(14) = "100011000" 'E
    BC(15) = "001011000" 'F
    BC(16) = "000001101" 'G
    BC(17) = "100001100" 'H
    BC(18) = "001001100" 'I
    BC(19) = "000011100" 'J
    BC(20) = "100000011" 'K
    BC(21) = "001000011" 'L
    BC(22) = "101000010" 'M
    BC(23) = "000010011" 'N
    BC(24) = "100010010" 'O
    BC(25) = "001010010" 'P
    BC(26) = "000000111" 'Q
    BC(27) = "100000110" 'R
    BC(28) = "001000110" 'S
    BC(29) = "000010110" 'T
    BC(30) = "110000001" 'U
    BC(31) = "011000001" 'V
    BC(32) = "111000000" 'W
    BC(33) = "010010001" 'X
    BC(34) = "110010000" 'Y
    BC(35) = "011010000" 'Z
    BC(36) = "010000101" '-
    BC(37) = "110000100" '.
    BC(38) = "011000100" '<spc>
    BC(39) = "010101000" '$
    BC(40) = "010100010" '/
    BC(41) = "010001010" '+
    BC(42) = "000101010" '%
    BC(43) = "010010100" '*  (used for start/stop character only)
    
Picture1.Cls
If Text1.Text = "" Then Exit Sub
pos = 20
Bardata = UCase(Text1.Text)

'Check for invalid characters and calculate check sum
For X = 1 To Len(Bardata)
    Cur = Mid$(Bardata, X, 1)
    Select Case Cur
        Case "0" To "9"
            CurVal = Val(Cur)
        Case "A" To "Z"
            CurVal = Asc(Cur) - 55
        Case "-"
            CurVal = 36
        Case "."
            CurVal = 37
        Case " "
            CurVal = 38
        Case "$"
            CurVal = 39
        Case "/"
            CurVal = 40
        Case "+"
            CurVal = 41
        Case "%"
            CurVal = 42
        Case Else 'oops!
            Picture1.Cls
            Picture1.Print Cur & " 字符无效"
            Exit Sub
    End Select
    chksum = chksum + CurVal
Next

'Add Label? (add it now so start & stop chrs dont show)
If Check1(1).Value Then
    Picture1.CurrentX = 35 + Len(Bardata) * (5 + Check1(0).Value * 2) 'kinda center
    Picture1.CurrentY = 50
    Picture1.Print Bardata;
End If

'Add Check Character? (rarely used, but i put it here anyway...)
If Check1(2).Value Then
    chksum = chksum Mod 43
    chkchr = Mid$("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%*", chksum + 1, 1)
    Picture1.Print "_" & chkchr
    Bardata = Bardata & chkchr
End If

'Add Start & Stop characters (must have 'em for valid barcodes)
Bardata = "*" & Bardata & "*"

'Generate Barcode
For X = 1 To Len(Bardata)
    Cur = Mid$(Bardata, X, 1)
    Select Case Cur
        Case "0" To "9"
            CurVal = Val(Cur)
        Case "A" To "Z"
            CurVal = Asc(Cur) - 55
        Case "-"
            CurVal = 36
        Case "."
            CurVal = 37
        Case " "
            CurVal = 38
        Case "$"
            CurVal = 39
        Case "/"
            CurVal = 40
        Case "+"
            CurVal = 41
        Case "%"
            CurVal = 42
        Case "*"
            CurVal = 43
    End Select
    
    For Y = 1 To 9
        If Y Mod 2 = 0 Then
            'SPACE
            pos = pos + 1 + (2 * Val(Mid$(BC(CurVal), Y, 1))) + Check1(0).Value
        Else
            'BAR
            For z = 1 To 1 + (2 * Val(Mid$(BC(CurVal), Y, 1)))
                Picture1.Line (pos, 1)-(pos, 58 - Check1(1) * 8)
                pos = pos + 1
            Next z
        End If
    Next
    pos = pos + 1 + Check1(0).Value 'make inter-character gap (ie: 1 narrow space)
Next
End Sub

Private Sub Command2_Click()
   CD1.DialogTitle = "请选择一个Bmp格式的图片"
   CD1.ShowOpen
   If CD1.FileName <> "" Then
      Picture1.Picture = LoadPicture(CD1.FileName)
      Picture1.ScaleMode = vbPixels
      Me.Width = Picture1.Width + 350
      Me.Height = Picture1.Height + Picture1.Top + 600
   End If
   
End Sub

Private Sub Form_Resize()
'Picture1.Width = Me.Width - 360
End Sub

Private Sub Text1_Change()
makeBC
End Sub

Private Sub Check1_Click(Index As Integer)
makeBC
End Sub

Private Sub Command1_Click()
Clipboard.Clear
Clipboard.SetData Picture1.Image
End Sub

'读取
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Label2.Caption = bcRead(Picture1, CLng(X), CLng(Y), 1, 3)
End Sub