frmmain.frm

LCD SN 烧录 软件！可以烧录序列号

                'Text2.Text = MSComm1.RThreshold
                
                MsgBox "发送缓冲区中数据少于Sthreshold个"
                'Exit Sub
    
       Case comEvCTS
                'MsgBox "Clear To Send信号线状态发生变化"  'hide 060223
                'Exit Sub
       Case comEvDSR
                MsgBox "Data-Set Ready信号线状态从1变到0"
                Exit Sub
       Case comEvCD
                'MsgBox "Carrier Detect 线变化"          'hide 060223
                'Exit Sub
       Case comEvRing
                'MsgBox "检测到振铃信号!" 'Jack 2006-01-20
                'Exit Sub                'Jack 2006-01-20
       Case comEvEOF
                MsgBox "接受到文件结束符"
                Exit Sub
       
       
       Case ComEvntBreak
                MsgBox "接受到一个中断信号"
                Exit Sub
       Case ComEvntCTSTO
                MsgBox "ClearToSend信号超时"
                Exit Sub
       Case ComEvntDSRTO
                MsgBox "DataSetReady信号超时"
                Exit Sub
       Case ComEvntFrame
                MsgBox "帧错误"
                Exit Sub
       Case ComEvntOverrun
                MsgBox "串口超速"
                Exit Sub
       Case ComEvntCDTO
                MsgBox "载波检测超时"
                Exit Sub
       Case ComEvntRxOver
                MsgBox "接受缓冲区溢出，缓冲区中已没有空间"
                Exit Sub
       Case ComEvntRxParity
                MsgBox "奇偶校验错"
                Exit Sub
       Case ComEvntTxFull
                MsgBox "发送缓冲区溢出，缓冲区中已没有空间"
                Exit Sub
       Case ComEvntDCB
                MsgBox "检索串口的设备控制块时发生错误"
                Exit Sub
       Case Else
                'MsgBox "发生未知错误!"  'Jack 2005-12-15
                'Exit Sub                'Jack 2006-01-20
End Select
End Sub
Private Sub CmdSend_Click()    'Open Port; Get Barcode string;Barcode valid or not;message display;send Barcode;
Dim n As Integer
Dim BarcodeText As String

 BarcodeText = Mid(Trim(Text1.Text), BarcodeStart, BarcodeEnd - BarcodeStart + 1)
 BarcodeText = UCase(BarcodeText)
   
 If MSComm1.PortOpen = False Then  'Open Ser.Port
     On Error GoTo Err1
     With MSComm1
        .CommPort = CurrentPort ' 使用串行口
        .Settings = CurrentSettings
        .InputLen = 0 '读取整个接收缓冲区内码或消除
        .InBufferSize = 20
        .OutBufferSize = 40
        .InBufferCount = 0
        .OutBufferCount = 0
        .InputMode = comInputModeText
        .RThreshold = 0
        .SThreshold = 0
        .PortOpen = True ' 打开串行口
    On Error GoTo Err1
    End With
 End If
  
  
  
  
   If ValidBarcode(BarcodeText) = False Then 'Barcode Valid or not
          GoTo Err
   End If
   
   On Error GoTo ErrEnd
     
   If CboLanguage.ListIndex = 1 Then
        Label2.Caption = "串口已连接"
      Else
        Label2.Caption = "Connected"
   End If
   CmdSend.Enabled = False
   Text1.Enabled = False
   Label4.Caption = ""
   
   Select Case SendBarcode(BarcodeText)
          Case 0
               MsgBox "Com. Port unopen"
               Exit Sub
          Case 1
               MsgBox "Send 1/4 str Error!"
               Exit Sub
          Case 2
               MsgBox "Send 2/4 str Error!"
               Exit Sub
          Case 3
               MsgBox "Send 3/4 str Error!"
               Exit Sub
          Case 4
               MsgBox "Send 4/4 str Error!"
               Exit Sub
          Case 100
          Case Else
               MsgBox "Unkown Error!"
               Exit Sub
   End Select

   Exit Sub

ErrEnd:
    End
Err:
     Text1.Enabled = True
     Text1.SetFocus
     Text1.SelStart = Len(Text1.Text)
   MsgBox "INVALID CHARACTOR，NULL,OR LENGTH ERROR IN BARCODE!"
   Exit Sub
Err1:
   MsgBox "COM PORT NO OPEN OR COMMUNICATION ERROR!"
End Sub
Private Function SendBarcode(StrBar As String) As Integer   'Send Barcode
'0:Serial Port unopen
'1:Send 1/4  str Error
'2:Send 2/4 str error
'3:send 3/4 str error
'4: send 4/4 str error
'100: OK
Dim str(4) As String
Dim i, j As Integer


 If MSComm1.PortOpen = False Then                'if Serial Port is close ,then open it . by jack 060116
      If CboLanguage.ListIndex = 1 Then
           MsgBox "请先打开串口"
           SendBarcode = 0
           Exit Function
        Else
           MsgBox "Open Port First"
           SendBarcode = 0
           Exit Function
End If
End If

     str(0) = StrBar '& vbCr  "123456789012
'    Call CommandOut("WA0BS000")  'Test compare to Serial Number:  color temperature adjust
'    i = 0                                                      'Use for Recycle
    
    bRun = True
    Label4.ForeColor = &HFF0000
    Label4.Caption = Label4.Caption & "Ready to send ..." & vbCrLf
    
'    Do While i < 2000 'RecycleNum                               'Use for Recycle
'         Label4.Caption = ""                                    'Use for Recycle
'         Label4.Caption = Label4.Caption & "Ready to send ..."  'Use for Recycle
    
    str(1) = Trim("WS000" & Mid$(str(0), 1, 3))
    str(2) = Trim("WS001" & Mid$(str(0), 4, 3))
    str(3) = Trim("WS002" & Mid$(str(0), 7, 3))
    str(4) = Trim("WS003" & Mid$(str(0), 10, 3))
    
    If BarcodeStart = 1 Then
       Label4.Caption = Label4.Caption & "···" & "("
      Else
       Label4.Caption = Label4.Caption & "···" & Mid(Text1.Text, 1, BarcodeStart - 1) & "("
    End If
    
    Label4.Caption = Label4.Caption & Mid(Text1.Text, BarcodeStart, BarcodeEnd - BarcodeStart + 1)
    
    If BarcodeEnd = BarcodeLen Then
       Label4.Caption = Label4.Caption & ")" & "···" & vbCrLf
      Else
       Label4.Caption = Label4.Caption & ")" & Mid(Text1.Text, BarcodeEnd + 1, BarcodeLen - BarcodeEnd) & "···" & vbCrLf
    End If
    
        MSComm1.OutBufferCount = 0 '...清空输出寄存器
        For i = 1 To 3
            Delay (Delay_Time)
        Next
        If CommandOut(str(1)) = False Then
             SendBarcode = 1
             Exit Function
        End If
            If Not bRun Then
                Label4.ForeColor = &HFF&
                Label4.Caption = Label4.Caption & "Stop when sending 1%4 of barcode." & vbCrLf & "Sending Failed!!!"
                Text1.Enabled = True
                Exit Function
             End If
        
        MSComm1.InBufferCount = 0 '...清空输入寄存器
        For i = 1 To Delay_Times
                Delay (Delay_Time)
        Next
        If CommandOut(str(2)) = False Then
             SendBarcode = 2
             Exit Function
        End If
            If Not bRun Then
               Label4.ForeColor = &HFF&
               Label4.Caption = Label4.Caption & "Stop when sending 2%4 of barcode." & vbCrLf & "Sending Failed!!!"
               Text1.Enabled = True
               Exit Function
            End If
        
        MSComm1.InBufferCount = 0 '...清空输入寄存器
        For i = 1 To Delay_Times
                Delay (Delay_Time)
        Next
        If CommandOut(str(3)) = False Then
             SendBarcode = 3
             Exit Function
        End If
            If Not bRun Then
                Label4.ForeColor = &HFF&
                Label4.Caption = Label4.Caption & "Stop when sending 3%4 of barcode." & vbCrLf & "Sending Failed!!!"
                Text1.Enabled = True
                Exit Function
            End If
        
        MSComm1.InBufferCount = 0 '...清空输入寄存器
        For i = 1 To Delay_Times
                Delay (Delay_Time)
        Next
        If CommandOut(str(4)) = False Then
             SendBarcode = 4
             Exit Function
        End If
            If Not bRun Then
                Label4.ForeColor = &HFF&
                Label4.Caption = Label4.Caption & "Stop when sending 4%4 of barcode." & vbCrLf & "Sending Failed!!!"
                Text1.Enabled = True
                Exit Function
            End If
        
        MSComm1.InBufferCount = 0 '...清空输入寄存器
        Label4.Caption = Label4.Caption & "Sending completed!" & vbCrLf
        Label4.Caption = Label4.Caption & "OK!"
        For j = 1 To 5
            Delay (30000)
            Delay (20000) '40
        Next
      
      SendBarcode = 100
     'str(0) = Val(str(0)) + 1 '& vbCr　　 'Use for Recycle
     'Text1.Text = str(0)                  'Use for Recycle
     'i = i + 1                            'Use for Recycle
     
     On Error GoTo Err

     Text1.Text = ""    '循环测试,要屏蔽
     Text1.Enabled = True
     Text1.SetFocus
     Text1.SelStart = Len(Text1.Text)
     
     '发送条码完毕后，清空输入寄存器 2006-01-20
     MSComm1.InBufferCount = 0 '...清空输入寄存器
     Delay (Delay_Time)
     CmdSend.Enabled = True
  ' Loop                                  'Use for Recycle

  Exit Function
Err:
     End
 End Function
Private Function CommandOut(DT As String) As Boolean
'MsgBox "OK!" + DT + CStr(Len(DT))
Dim wait_time As Long
Dim End_time As Long
wait_time = 10
End_time = Timer + wait_time
'Dim DT As String
bRun = True

Dim i As Long
If MSComm1.PortOpen Then
       For i = 1 To Len(DT)
         DoEvents
         On Error GoTo Err
            If Not bRun Then     'bRun=false  中断后台执行程序，true 继续循环
              MsgBox "强行中断"
              CommandOut = False
              Exit Function
            End If
            
         MSComm1.Output = Mid(DT, i, 1) '在dephi中等价于copy
             If End_time < Timer Then
                MsgBox "Output date to lcd error，确认失败!!!!"
                Exit Function
             End If
         Delay (10) 'ivan 051009
      Next
      CommandOut = True
'  Else
'    If Not bRun Then   'PortOpen=false bRun=false：串口关闭，后台执行程序关闭
'          MsgBox "串口关闭，后台执行程序关闭,OK"
'           Exit Function
'     Else              'PortOpen=false bRun=true:串口关闭，后台执行程序继续
'          MsgBox "串口关闭，后台执行程序继续,ERROR!!"
'          Exit Function
'    End If
 End If
Exit Function
Err:
   End
End Function
Private Function ValidBarcode(ByVal StrBarcode As String) As Boolean   '条码字符有效性检验:Length,Include invalid character
Dim ASCII_iChar, i As Integer
     
      If BarcodeLen <> Len(StrBarcode) Then     '检查条码长度是否一致,15-1-15<->len(StrBarcode)
         'MsgBox "Barcode length invalid！"
         Text1.Text = ""
         ValidBarcode = False
         Exit Function
      End If
  
      For i = 1 To Len(StrBarcode)                   '检查条码有无非法字符
        ASCII_iChar = Asc(Mid(StrBarcode, i, 1))
         If (ASCII_iChar > 0 And ASCII_iChar < 48) Or (ASCII_iChar > 57 And ASCII_iChar < 65) Or (ASCII_iChar > 90 And ASCII_iChar < 97) Or (ASCII_iChar > 122) Then
           Text1.Text = ""
           ValidBarcode = False
           Exit Function
        End If
     Next
     ValidBarcode = True
End Function

Private Sub Option1_Click()   '12---01---12
If Option1.Value = True Then
   BarcodeLen = Val(Mid((Option1.Caption), 1, 2))
   BarcodeStart = Val(Mid((Option1.Caption), 6, 2))
   BarcodeEnd = Val(Mid((Option1.Caption), 11, 2))
End If
End Sub

Private Sub Option2_Click()
If Option2.Value = True Then
   BarcodeLen = Val(Mid(Option2.Caption, 1, 2))
   BarcodeStart = Val(Mid(Option2.Caption, 6, 2))
   BarcodeEnd = Val(Mid(Option2.Caption, 11, 2))
End If
End Sub

Private Sub Option3_Click()
If Option3.Value = True Then
   BarcodeLen = Val(Mid(Option3.Caption, 1, 2))
   BarcodeStart = Val(Mid(Option3.Caption, 6, 2))
   BarcodeEnd = Val(Mid(Option3.Caption, 11, 2))
End If
End Sub


Private Sub Slider_DelayTimes_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Delay_Times = Slider_DelayTimes.Value
 Txt_Show.Text = "(" & Delay_Times & "," & Delay_Time & ")"

End Sub
Private Sub Slider_DelayTime_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Delay_Time = Slider_DelayTime.Value
 Txt_Show.Text = "(" & Delay_Times & "," & Delay_Time & ")"

End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)  'TEXT1按ENTER后，开始发送条码
If KeyAscii = 13 Then
  Call CmdSend_Click
End If
End Sub