实例介绍
【实例简介】
【实例截图】
【核心代码】
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Frm_BarCode
Caption = "demo"
ClientHeight = 7290
ClientLeft = 60
ClientTop = 345
ClientWidth = 8760
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
ScaleHeight = 7290
ScaleWidth = 8760
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Cmd_ImgFileName
Caption = "图形文件"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 795
Left = 120
TabIndex = 14
Top = 1800
Width = 615
End
Begin VB.TextBox Edit_ConFileName
Height = 855
Left = 840
MultiLine = -1 'True
TabIndex = 13
Top = 2760
Width = 1935
End
Begin MSComDlg.CommonDialog CDlg_FileName
Left = 3120
Top = 240
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Frame Frame2
Height = 3375
Left = 120
TabIndex = 8
Top = 3720
Width = 2655
Begin VB.CommandButton Cmd_Exit
Caption = "退出系统"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 360
TabIndex = 17
Top = 2640
Width = 1935
End
Begin VB.CommandButton Cmd_Copy
Caption = "复制"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1320
TabIndex = 16
Top = 2160
Width = 975
End
Begin VB.CommandButton Cmd_Print
Caption = "打印"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 360
TabIndex = 15
Top = 2160
Width = 975
End
Begin VB.CommandButton Cmd_OpenComm
Caption = "连接串口"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 360
TabIndex = 12
Top = 1680
Width = 1935
End
Begin VB.CommandButton Cmd_SetComm
Caption = "设置串口"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 360
TabIndex = 11
Top = 1200
Width = 1935
End
Begin VB.CommandButton Cmd_SetConfig
Caption = "设置参数"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 360
TabIndex = 10
Top = 720
Width = 1935
End
Begin VB.CommandButton Cmd_Create
Caption = "生成条码"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 360
TabIndex = 9
Top = 240
Width = 1935
End
End
Begin VB.TextBox Edit_ImgFileName
Height = 855
Left = 840
MultiLine = -1 'True
TabIndex = 7
Top = 1800
Width = 1935
End
Begin VB.CommandButton Cmd_ConFileName
Caption = "配置文件"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 795
Left = 120
TabIndex = 6
Top = 2760
Width = 615
End
Begin VB.TextBox Edit_TxtFileName
Height = 855
Left = 840
MultiLine = -1 'True
TabIndex = 5
Top = 840
Width = 1935
End
Begin VB.CommandButton Cmd_TxtFileName
Caption = "编码文件"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Left = 120
TabIndex = 4
Top = 840
Width = 615
End
Begin VB.TextBox Edit_Source
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3495
Left = 3000
MultiLine = -1 'True
TabIndex = 3
Top = 120
Width = 5535
End
Begin VB.Frame Frame1
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 120
TabIndex = 0
Top = 0
Width = 2655
Begin VB.OptionButton Op_Qr
Caption = "Qr_Code"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1440
TabIndex = 2
Top = 240
Width = 975
End
Begin VB.OptionButton Op_Pdf
Caption = "PDF417"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 1
Top = 240
Width = 975
End
End
Begin VB.Image Image_Bar
Height = 3255
Left = 3000
Top = 3840
Width = 5535
End
End
Attribute VB_Name = "Frm_BarCode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'动态链接库引用
Private Declare Function InitRead Lib "EnCodePdf.dll" (ByVal hcallwnd As Long, ByVal pathname As String) As Long
Private Declare Function CloseRead Lib "EnCodePdf.dll" () As Long
Private Declare Function EnCodePdf Lib "EnCodePdf.dll" (ByVal txtFile As String) As String
Private Declare Function MakePdf417 Lib "EnCodePdf.dll" (ByVal txtFile As String, ByVal pictfile As String, ByVal otherfile As String) As String
Private Declare Function SetConFile Lib "EnCodePdf.dll" (ByVal Profile As String) As Long
Private Declare Function MakeQrCode Lib "EnCodeQr.dll" (ByVal txtFile As String, ByVal pictfile As String, ByVal otherfile As String) As String
Private Declare Function SetQrConFile Lib "EnCodeQr.dll" (ByVal Profile As String) As Long
Private Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
'exports from nlcomp.dll 图像压缩函数
Private Declare Function SizeDIB Lib "Wcomp.dll" (ByVal oldmap As String, ByVal BmpHeight As Integer, ByVal BmpWidth As Integer) As Long
Private Declare Function Wcompress Lib "Wcomp.dll" (ByVal infile As String, ByVal outfile As String, ByVal budget As Long) As Long
Private Declare Function Wdecompress Lib "Wcomp.dll" (ByVal infile As String, ByVal outfile As String) As Long
'变量定义
Dim m_bWorkMode As Boolean 'TRUE_PDF417 FALSE_QRCODE
'初始化
Private Sub Form_Load()
If Dir(App.Path & "\MakeBarCode.ini") <> "" Then
Edit_ConFileName.Text = App.Path & "\MakeBarCode.ini"
End If
Cmd_Print.Enabled = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Cmd_Exit_Click
End Sub
'选择PDF417操作
Private Sub Op_Pdf_Click()
m_bWorkMode = True
End Sub
'选择Qr_Code操作
'Download by http://www.NewXing.com
Private Sub Op_Qr_Click()
m_bWorkMode = False
End Sub
'选择文本文件
Private Sub Cmd_TxtFileName_Click()
Dim I As Integer
Dim strTmp As String
Dim FileNo As Integer
CDlg_FileName.Filter = "Text Files (*.txt)|*.txt"
CDlg_FileName.ShowOpen
Edit_TxtFileName.Text = CDlg_FileName.FileName
If (Edit_TxtFileName.Text <> "") Then
I = 0
FileNo = FreeFile()
Open Edit_TxtFileName.Text For Input As #FileNo
Do While Not EOF(FileNo)
Input #FileNo, strTmp
Edit_Source.Text = Edit_Source.Text & strTmp & Chr(13) & Chr(10)
Loop
Close #FileNo
End If
End Sub
'选择位图文件
Private Sub Cmd_ImgFileName_Click()
CDlg_FileName.Filter = "Bitmap Files (*.bmp,*.jpg,*jpe)|*.JPG;*.JPE;*.BMP"
CDlg_FileName.ShowOpen
Edit_ImgFileName.Text = CDlg_FileName.FileName
If (Edit_ImgFileName.Text <> "") Then
Image_Bar.Stretch = False
Image_Bar.Picture = LoadPicture(Edit_ImgFileName.Text)
End If
Cmd_Print.Enabled = False
End Sub
'选择参数文件
Private Sub Cmd_ConFileName_Click()
CDlg_FileName.Filter = "配置文件(*.ini)|*.ini"
CDlg_FileName.ShowOpen
Edit_ConFileName.Text = CDlg_FileName.FileName
End Sub
'生成条形码
Private Sub Cmd_Create_Click()
Dim FileNo As Integer
Dim txtFile As String
Dim strBmpFile As String
Dim binBmpFile As String
Dim xScale As Integer
Dim yScale As Integer
On Error GoTo ErrNote
'将文本写入文本文件
xScale = 1
yScale = 1
txtFile = ""
If (Edit_Source.Text <> "") Then
FileNo = FreeFile()
txtFile = App.Path "\TxtTemp.txt"
Open txtFile For Output As #FileNo
Print #FileNo, Edit_Source.Text
Close #FileNo
End If
'进行图形压缩
binBmpFile = ""
If (Edit_ImgFileName.Text <> "") Then
Image_Bar.Picture = LoadPicture(Edit_ImgFileName.Text)
strBmpFile = App.Path "\strbmpfile.bmp"
binBmpFile = App.Path "\binBmpFile.img"
SavePicture Image_Bar.Picture, strBmpFile
Call SizeDIB(binBmpFile, 100, 100)
Call Wcompress(strBmpFile, binBmpFile, 800)
Kill (strBmpFile)
End If
'设置制码参数
If (Edit_ConFileName.Text <> "") Then
If (m_bWorkMode) Then
SetConFile (Edit_ConFileName.Text)
Else
SetQrConFile (Edit_ConFileName.Text)
End If
End If
'进行条形码制作
If (txtFile <> "" Or binBmpFile <> "") Then
If (m_bWorkMode) Then
strBmpFile = MakePdf417(txtFile, binBmpFile, "")
xScale = GetPrivateProfileInt("PDF", "XScale", 1, Edit_ConFileName)
yScale = GetPrivateProfileInt("PDF", "YScale", 1, Edit_ConFileName)
Else
strBmpFile = MakeQrCode(txtFile, binBmpFile, "")
xScale = GetPrivateProfileInt("QR", "XScale", 1, Edit_ConFileName)
yScale = xScale
End If
If (strBmpFile <> "") Then '显示条码
Image_Bar.Stretch = False
Image_Bar.Picture = LoadPicture(strBmpFile)
Image_Bar.Height = yScale * Image_Bar.Height
Image_Bar.Width = xScale * Image_Bar.Width
Image_Bar.Stretch = True
Kill (strBmpFile)
Cmd_Print.Enabled = True
Cmd_Copy.Enabled = True
Else
MsgBox "编码失败!"
Image_Bar.Stretch = False
Image_Bar.Picture = LoadPicture("")
Clipboard.Clear
Cmd_Print.Enabled = False
Cmd_Copy.Enabled = False
End If
End If
Exit Sub
ErrNote:
MsgBox Err.Description
End Sub
'设置条码参数
Private Sub Cmd_SetConfig_Click()
If (Edit_ConFileName.Text <> "") Then
If (m_bWorkMode) Then
frmpdf.m_strProfile = Edit_ConFileName.Text
frmpdf.Show vbModal, Me
Else
frmQr.m_strProfile = Edit_ConFileName.Text
frmQr.Show vbModal, Me
End If
Else
MsgBox "未设置参数文件名"
End If
End Sub
'设置串口参数
Private Sub Cmd_SetComm_Click()
If (Edit_ConFileName.Text <> "") Then
frmComm.m_strProfile = Edit_ConFileName.Text
frmComm.Show vbModal, Me
Else
MsgBox "未设置参数文件名"
End If
End Sub
'打开/关闭串口
Private Sub Cmd_OpenComm_Click()
If Cmd_OpenComm.Caption = "连接串口" Then
Call SetConFile(Edit_ConFileName.Text)
If InitRead(Me.hwnd, App.Path "\") = 0 Then
Cmd_OpenComm.Caption = "断开串口"
End If
Else '关闭串口
If CloseRead() = 0 Then
Cmd_OpenComm.Caption = "连接串口"
End If
End If
End Sub
'打印条码
Private Sub Cmd_Print_Click()
frmPrint.Width = Image_Bar.Width
frmPrint.Height = Image_Bar.Height
frmPrint.Refresh
frmPrint.Image_Print.Stretch = False
frmPrint.Image_Print.Picture = Image_Bar.Picture
frmPrint.Image_Print.Width = Image_Bar.Width
frmPrint.Image_Print.Height = Image_Bar.Height
frmPrint.Image_Print.Stretch = True
frmPrint.PrintForm
End Sub
'拷贝
Private Sub Cmd_Copy_Click()
Clipboard.Clear
Clipboard.SetData Image_Bar.Picture, vbCFBitmap
Cmd_Copy.Enabled = False
End Sub
'退出系统
Private Sub Cmd_Exit_Click()
If Cmd_OpenComm.Caption = "断开串口" Then
Call Cmd_OpenComm_Click
End If
Unload frmPrint
Unload Me
End Sub
'接收串口信息
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim FileNo As Integer
Dim strTmp As String
Dim strBmpFile As String
strBmpFile = App.Path & "\temp.bmp"
If KeyCode = 255 Then
FileNo = FreeFile()
Open App.Path & "\temp.txt" For Input As #FileNo
Edit_Source.Text = ""
Do While Not EOF(FileNo)
strTmp = ""
Input #FileNo, strTmp
Edit_Source.Text = Edit_Source.Text & strTmp & Chr(13) & Chr(10)
Loop
Close #FileNo
If Dir(strBmpFile) <> "" Then
Kill (strBmpFile)
End If
If Dir(App.Path & "\temp.img") <> "" Then
If FileLen(App.Path & "\temp.img") > 10 Then
Call Wdecompress(App.Path & "\temp.img", strBmpFile)
End If
End If
If Dir(strBmpFile) <> "" Then
Image_Bar.Picture = LoadPicture(strBmpFile)
Else
Image_Bar.Picture = LoadPicture("")
End If
Cmd_Print.Enabled = False
End If
End Sub
好例子网口号：伸出你的我的手 — 分享！
网友评论
小贴士
感谢您为本站写下的评论，您的评论对其它用户来说具有重要的参考价值，所以请认真填写。
- 类似“顶”、“沙发”之类没有营养的文字，对勤劳贡献的楼主来说是令人沮丧的反馈信息。
- 相信您也不想看到一排文字/表情墙，所以请不要反馈意义不大的重复字符，也请尽量不要纯表情的回复。
- 提问之前请再仔细看一遍楼主的说明，或许是您遗漏了。
- 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦，又没人会搭理，于人于己都无利。
关于好例子网
本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享，对搜索内容的合法性不具有预见性、识别性、控制性，仅供学习研究，请务必在下载后24小时内给予删除，不得用于其他任何用途，否则后果自负。基于互联网的特殊性，平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查；无论平台是否已进行审查，用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场，基于网友分享，根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定，若资源存在侵权或相关问题请联系本站客服人员，点此联系我们。关于更多版权及免责申明参见 版权及免责申明
支持(0) 盖楼(回复)