frmmain.frm

一个可以直接调用的条码扫描仪VB源码

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form frmMain 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "条形码串口读取"
   ClientHeight    =   4110
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9045
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4110
   ScaleWidth      =   9045
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame fraFrames 
      Caption         =   "条形码读取选项"
      Height          =   3855
      Index           =   2
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   4350
      Begin MSCommLib.MSComm ComPort 
         Left            =   4920
         Top             =   120
         _ExtentX        =   1005
         _ExtentY        =   1005
         _Version        =   393216
         DTREnable       =   -1  'True
      End
      Begin VB.OptionButton optComPort 
         Caption         =   "COM4"
         Height          =   255
         Index           =   3
         Left            =   480
         TabIndex        =   14
         Top             =   1320
         Width           =   1335
      End
      Begin VB.OptionButton optComPort 
         Caption         =   "COM3"
         Height          =   255
         Index           =   2
         Left            =   480
         TabIndex        =   13
         Top             =   1080
         Width           =   1335
      End
      Begin VB.OptionButton optComPort 
         Caption         =   "COM2"
         Height          =   255
         Index           =   1
         Left            =   480
         TabIndex        =   12
         Top             =   840
         Width           =   1335
      End
      Begin VB.OptionButton optComPort 
         Caption         =   "COM1"
         Height          =   255
         Index           =   0
         Left            =   480
         TabIndex        =   11
         Top             =   600
         Value           =   -1  'True
         Width           =   1335
      End
      Begin VB.CommandButton cmdDisconnect 
         Caption         =   "断开"
         Enabled         =   0   'False
         Height          =   375
         Left            =   2280
         TabIndex        =   9
         Top             =   1065
         Width           =   1845
      End
      Begin VB.CommandButton cmdConnect 
         Caption         =   "连接"
         Height          =   375
         Left            =   2280
         TabIndex        =   8
         Top             =   600
         Width           =   1845
      End
      Begin VB.CheckBox chkWedge 
         Caption         =   "Enable Wedge Emulation"
         Height          =   255
         Left            =   1230
         TabIndex        =   7
         Top             =   1920
         Width           =   2535
      End
      Begin VB.CommandButton cmdExit 
         Caption         =   "退出"
         Height          =   375
         Left            =   2190
         TabIndex        =   6
         Top             =   2880
         Width           =   1845
      End
      Begin VB.CommandButton cmdClear 
         Caption         =   "清除全部条形码"
         Height          =   375
         Left            =   2190
         TabIndex        =   5
         Top             =   2400
         Width           =   1845
      End
      Begin VB.Label lblStatus 
         Alignment       =   2  'Center
         Caption         =   "空闲"
         Height          =   255
         Left            =   105
         TabIndex        =   10
         Top             =   3390
         Width           =   1470
      End
   End
   Begin VB.Frame frmFrames 
      Caption         =   "上一次条码"
      Height          =   2415
      Left            =   4575
      TabIndex        =   2
      Top             =   1575
      Width           =   4305
      Begin VB.ListBox lstBarcodes 
         Height          =   1680
         Left            =   240
         TabIndex        =   3
         Top             =   360
         Width           =   3795
      End
   End
   Begin VB.Frame fraFrames 
      Caption         =   "最近的条码"
      Height          =   1335
      Index           =   1
      Left            =   4560
      TabIndex        =   0
      Top             =   120
      Width           =   4305
      Begin VB.TextBox txtBarcode 
         Alignment       =   2  'Center
         Height          =   285
         Left            =   240
         Locked          =   -1  'True
         TabIndex        =   1
         Top             =   525
         Width           =   3735
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim sBarcodeTemp As String  '保存扫描后的条码
Dim sInTemp As String       '传给串口的条码

Private Sub cmdClear_Click()
    lstBarcodes.Clear
    txtBarcode.Text = ""
End Sub

Private Sub cmdConnect_Click()

    '查找指定端口
    Dim i As Integer
    For i = 1 To 4
        If optComPort(i - 1).Value = True Then
            ComPort.CommPort = i
            Exit For '跳出循环
        End If
    Next
    
    If ComPort.PortOpen = True Then ComPort.PortOpen = False  '如果端口打开则先关闭
    ComPort.PortOpen = True  '然后打开
    
    '状态信息
    lblStatus = "已连接..."
    
    cmdConnect.Enabled = False
    cmdDisconnect.Enabled = True
    
End Sub

Private Sub cmdDisconnect_Click()

    '断开连接
    If ComPort.PortOpen = True Then ComPort.PortOpen = False
    
    lblStatus = "已断开..."
    
    cmdDisconnect.Enabled = False
    cmdConnect.Enabled = True
    
End Sub

Private Sub cmdExit_Click()

    '先断开端口再退出程序
    If ComPort.PortOpen = True Then ComPort.PortOpen = False
        Unload Me
    End

End Sub

'串口时间
Private Sub ComPort_OnComm()
    '如果已经接收数据，则继续
    If ComPort.CommEvent <> comEvReceive Then Exit Sub
     
    '读取数据
    sInTemp = ComPort.Input

    '把读取的数据放到条形码缓冲区
    sBarcodeTemp = sBarcodeTemp & sInTemp

    '判断是否完成条码读取
    If Right$(sBarcodeTemp, 2) = vbNewLine Then
    
        If chkWedge Then SendKeys sBarcodeTemp
        
        sBarcodeTemp = Left$(sBarcodeTemp, Len(sBarcodeTemp) - 2)
        
        
        '把条码放到文本框
        txtBarcode = sBarcodeTemp

        '放到列表框
        lstBarcodes.AddItem sBarcodeTemp, 0
        
        '清空条码临时变量
        sBarcodeTemp = ""
        
        '状态
        lblStatus = "条码扫描完毕"

    End If
       
End Sub

Private Sub Form_Load()

    '端口循环计数器
    Dim iComPort As Integer

    '错误陷阱
    On Error GoTo CommErrorHandle
    
    '尝试列表存在端口
    For iComPort = 1 To 4
        ComPort.CommPort = iComPort '指定端口号
        If ComPort.PortOpen = True Then ComPort.PortOpen = False '如打开先关闭
        ComPort.PortOpen = True  '尝试打开
        ComPort.PortOpen = False '确认成功关闭
    Next
    
    '端口配置
    ComPort.InputLen = 1    '1 个字符产生接收事件
    ComPort.RThreshold = 1  '1 个字符产生接收事件
    
    '跳出错误
    Exit Sub
    
CommErrorHandle:

    '68   = 设备无效
    '8002 = 端口号无效
    '8012 = 端口无法打开
    If Err = 68 Or Err = 8002 Or Err = 8012 Then
        '端口无效时则禁止单击连接按钮
        optComPort(iComPort - 1).Enabled = False
    End If
    
    '继续错误
    Resume Next
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    '断开连接并退出
    If ComPort.PortOpen = True Then ComPort.PortOpen = False

End Sub