form1.frm

16进制发送指令的源程序

  send(2) = &H3

  send(3) = &H25

  send(4) = &H3

  send(5) = &H0
  
  
ElseIf Combo1.Text = 4 Then                       '遥控4#门

  send(0) = &HFF

  send(1) = &HAA

  send(2) = &H3

  send(3) = &H25

  send(4) = &H4

  send(5) = &H0


 End If
                           'ff aa 03 25 01 00
                                       
  MSComm1.Output = send()




End Sub





Private Sub Combo2_Click()   '设置通讯端口

On Error GoTo combo



MSComm1.PortOpen = True

If Combo2.Text = COM1 Then

           MSComm1.CommPort = 1
           'MSComm1.PortOpen = True

  
          
          
            ' ElseIf Combo2.Text = COM2 Then
         ' MSComm1.CommPort = 2
          'MSComm1.PortOpen = True
          
     '  Else
           ' MsgBox ("没有发现此串口或已被占用")
   
End If
          
                  
combo:
 
 MsgBox ("通讯串口已经起用")
 
          
          
          
 


End Sub

Private Sub Command1_Click()

On Error GoTo err


Dim i As Integer



For i = 1 To 50              '循环一



send(0) = &HFF

send(1) = &HAA

send(2) = &H3

send(3) = &H25

send(4) = i
    
send(5) = &H0



MSComm1.Output = send()

Next i

 
For i = 51 To 100 Step 1               '循环二



send(0) = &HFF

send(1) = &HAA

send(2) = &H3

send(3) = &H25

send(4) = Str(i)
    
send(5) = &H0



MSComm1.Output = send()

Next i


 For i = 101 To 150 Step 1               '循环三



send(0) = &HFF

send(1) = &HAA

send(2) = &H3

send(3) = &H25

send(4) = Str(i)
    
send(5) = &H0



MSComm1.Output = send()

Next i
  

err:

'MsgBox err.Description

Exit Sub


End Sub

Private Sub Command3_Click()   '结束


MSComm1.PortOpen = False

End


End Sub

Private Sub Command4_Click()                               '手动发送

'Dim buf As Byte



  
 'buf = Text3.Text
 'Dim cc() As Byte

 'MSComm1.Output = CByte("&H" + buf)
  



'For i = 0 To 255


'cc(i) = i


'Next i


'Text3.Text = cc()

'MSComm1.Output = Text3.Text
'Do
'DoEvents
'Loop Until MSComm1.OutBufferCount = 0
'接收过程 MSComm1_OnComm()
'Select Case MSComm1.CommEvent
'Case comEvReceive
'Dim Buffer As Variant, b1, i
'MSComm1.InputMode = comInputModeBinery
'MSComm1.InputLen = 0
'Buffer = MSComm1.Input
'For i = LBound(Buffer) To UBound(Buffer)
'Debug.Print Buffer(i);
'Next i
''Dim i
'For i = 0 To 255

'cc() = &HFF &HAA
'cc() = Hex(1)



'Next i

'Text3.Text = Text3.Text & CStr(cc())
'MSComm1.Output = Text3.Text
 
 


'Dim i%, buf$
 ' buf = ""
  'OutByte = MSComm1.Output
  'For i = 0 To 255
    'buf = buf + Binary(i) '+ Chr(32)
 ' Next i
'MSComm1.Output = buf









  
                                    
                                       
                                                                      

End Sub

Private Sub Command5_Click()      '手动接受

Dim i%, buf$
  buf = ""
  InByte = MSComm1.Input
  For i = LBound(InByte) To UBound(InByte)
    buf = buf + Hex(InByte(i)) + Chr(32)
  Next i
 Text4.Text = Text4.Text + buf
                                                              '          Text4.Text = MSComm1.Input


End Sub



Private Sub Command6_Click()


Text4.Text = ""


End Sub

Private Sub Command7_Click()  '遥控全部

send(0) = &HFF

send(1) = &HAA

send(2) = &H3

send(3) = &H25

send(4) = &H1

send(5) = &H0

MSComm1.Output = send()



send(0) = &HFF

send(1) = &HAA

send(2) = &H3

send(3) = &H25

send(4) = &H2

send(5) = &H0

MSComm1.Output = send()                                      'ff aa 03 25 01 00
                                       


send(0) = &HFF

send(1) = &HAA

send(2) = &H3

send(3) = &H25

send(4) = &H3

send(5) = &H0

MSComm1.Output = send()
 
  
send(0) = &HFF

send(1) = &HAA

send(2) = &H3

send(3) = &H25

send(4) = &H4

send(5) = &H0

MSComm1.Output = send()
  
 



End Sub

Private Sub Form_Load()





MSComm1.PortOpen = True



'aend(0) = &HFF

'aend(1) = &HAA

'aend(2) = &H1

'aend(3) = &H1

'aend(4) = &H1

'aend(5) = &H0





Text1.Text = "日期:" & Date & "时间:" & Time()





  
  



End Sub



Private Sub msComm1_OnComm()           '自动接受16进制


  Dim t&, buf$, StrPos%, i%
  Select Case MSComm1.CommEvent
      ' 借着取代底下每一个 case 语句来处理每个事件与错误
   ' 事件
      Case comEvCD    ' CD 线的状态发生变化.
      Case comEvCTS   ' CTS 线的状态发生变化.
      Case comEvDSR   ' DSR 线的状态发生变化.
      Case comEvRing  ' Ring Indicator 变化.
      Case comEvReceive   ' 收到 RThreshold # of Data
         
       buf = ""
       InByte = MSComm1.Input
      For i = LBound(InByte) To UBound(InByte)
         buf = buf + Hex(InByte(i)) + Chr(32)
      Next i
     Text4.Text = Text4.Text + buf
        
        
       
      Case comEvSend  ' 传输缓冲区有 Sthreshold 个字符                            '
    End Select




End Sub