39条码生成及读取程序VB源代码 - vb源码程序

下载频道> 资源分类> 编程语言> VB源码> 39条码生成及读取程序VB源代码

标题：39条码生成及读取程序VB源代码
分享到：

所属分类: VB源码资源类型：文件大小: 14.29 KB 上传时间: 2016-01-20 22:46:57 下载次数: 15 资源积分：1分提供者: vb源码代做 39条码生成及读取程序VB源代码

内容：
39条码生成及读取程序VB源代码，程序员在编程的过程中可以参考学习使用，希望对IT程序员有用，此源码程序简单易懂、方便阅读，有很好的学习价值！部分

代码如下：

VERSION 5.00

Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"

Begin VB.Form FrmBarMaker

Caption = "39条形码生成程序VB版"

ClientHeight = 3300

ClientLeft = 60

ClientTop = 375

ClientWidth = 6300

Icon = "FrmBarMaker.frx":0000

KeyPreview = -1 'True

LinkTopic = "Form1"

ScaleHeight = 3300

ScaleWidth = 6300

StartUpPosition = 3 '窗口缺省

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

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

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

Attribute VB_Name = "FrmBarMaker"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = True

Attribute VB_Exposed = False

'''''''''''''''''''''''''''''''''''''''''''''

'' BARCODE 3 OF 9 GENERATOR ''

'' By Paul Bahlawan Aug 2003 ''

'' ''

'' Update Oct 2004: ''

'' -Add "Check Character" option ''

'' -Add "Optimize for Printing" option ''

'' -Add "Copy to clipboard" command ''

'' -Various minor changes ''

'' ''

'' Based on specs from: ''

'' www.adams1.com/pub/russadam/39code.html ''

'''''''''''''''''''''''''''''''''''''''''''''

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

'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

pos = pos + 1 + Check1(0).Value 'make inter-character gap (ie: 1 narrow space)

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

文件列表（点击上边下载按钮，如果是垃圾文件请在下面评价差评或者投诉）:

39条码生成及读取程序VB源代码/
39条码生成及读取程序VB源代码/code/
39条码生成及读取程序VB源代码/code/Barcode39Rm/
39条码生成及读取程序VB源代码/code/Barcode39Rm/FrmBarMaker.frm
39条码生成及读取程序VB源代码/code/Barcode39Rm/FrmBarMaker.frx
39条码生成及读取程序VB源代码/code/Barcode39Rm/FrmBarRead.frm
39条码生成及读取程序VB源代码/code/Barcode39Rm/FrmBarRead.frx
39条码生成及读取程序VB源代码/code/Barcode39Rm/MSSCCPRJ.SCC
39条码生成及读取程序VB源代码/code/Barcode39Rm/Mndsoft.bmp
39条码生成及读取程序VB源代码/code/Barcode39Rm/Project1.vbp
39条码生成及读取程序VB源代码/code/Barcode39Rm/Project1.vbw
39条码生成及读取程序VB源代码/code/Barcode39Rm/barcode.bmp
39条码生成及读取程序VB源代码/code/Barcode39Rm/basBCread.bas
39条码生成及读取程序VB源代码/谷速说明.txt