main.frm

通过PC机的串口和单片机等嵌入式下位机通信

      Width           =   855
   End
End
Attribute VB_Name = "Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim FlashCount As Integer         '闪烁辅助
Dim ConnectCount As Integer       '连接次数

Private Sub Add_Click()
Dim mytime(1 To 7) As String
Dim mystr As String
Dim n As Integer          '空格个数

If CheckTime() <> True Then    '检查是否合法
  Exit Sub
End If

If List.ListCount <= 9 Then
  n = 3
ElseIf List.ListCount > 9 And List.ListCount < 100 Then
  n = 2
Else
  n = 1
End If
mystr = Trim(ZuZhi(n))
ListState(List.ListCount) = 0
List.AddItem (mystr)
End Sub
'添加条件事件
Private Sub Add1_Click()
Dim n As Integer
Dim mystr As String
If List.ListCount <= 9 Then
  n = 3
ElseIf List.ListCount > 9 And List.ListCount < 100 Then
  n = 2
Else
  n = 1
End If
ListState(List.ListCount) = 1
mystr = Trim(Str$(Main.List.ListCount)) + Space(n) + Trim(TiaoJian.Text) + Space(21 - Len(Trim(TiaoJian.Text))) + " " + Trim(information1.Text)
List.AddItem (mystr)
End Sub

Private Sub Clear_Click()
If MsgBox("确认要清除所有信息吗?", vbYesNo, "警告!") = 6 Then
  List.Clear
  List.List(0) = "序号" + "    触发条件" + "          触发事件"
End If
End Sub

Private Sub Clr_Click()
For i = 1 To 7
  Time(i).Text = ""
Next i
information.Text = ""
Time(7).SetFocus
End Sub

Private Sub Clr1_Click()
TiaoJian.Text = ""
information.Text = ""
TiaoJian.SetFocus
End Sub

'删除事件
Private Sub Delete_Click()
If List.ListIndex <> 0 And List.ListIndex <> -1 Then
  n = List.ListIndex
  List.RemoveItem List.ListIndex
  For i = 1 To List.ListCount - 1
    List.List(i) = Trim(Str$(i)) + Space(4 - Len(Trim(Str$(i)))) + Mid(List.List(i), 5)
  Next i
  For i = n To List.ListCount - 1
    ListState(i) = ListState(i + 1)
  Next i
End If
End Sub

'修改按钮过程
Private Sub Edit_Click()
Dim mystr As String

If List.ListIndex = -1 Or List.ListIndex = 0 Then
  Exit Sub
End If

mystr = Mid(List.Text, 5)
If ListState(List.ListIndex) = 0 Then
  STab.Tab = 0
  Time(7).Text = Trim(Mid(mystr, 1, 4))
  Time(6).Text = Trim(Mid(mystr, 6, 2))
  Time(5).Text = Trim(Mid(mystr, 9, 2))
  Time(4).Text = Trim(Mid(mystr, 12, 1))
  Time(3).Text = Trim(Mid(mystr, 14, 2))
  Time(2).Text = Trim(Mid(mystr, 17, 2))
  Time(1).Text = Trim(Mid(mystr, 20, 2))
  information.Text = Trim(Mid(mystr, 23))
Else
  STab.Tab = 1
  TiaoJian.Text = Mid(mystr, 1, 21)
  information1.Text = Trim(Mid(mystr, 23))
End If

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If (KeyCode = 13 Or KeyCode = 108) And Add.Enabled Then
  Call Add_Click
End If
End Sub

'窗体加载，变量初始化
Private Sub Form_Load()
Add.Enabled = False
Add1.Enabled = False
ConnectCount = 0

TimeCount = 0
ThingCount = 0

FlashCount = 0     '连通标志辅助变量
SendMode = 0       '发送时期标志
End_Flag = &H7C
List.List(0) = "序号" + "    触发条件" + "          触发事件"

For i = 1 To 8   '各种种类事件的数量是0
  KindCount(i) = 0
Next i

intComPort = 0     '默认端口是0
Main.MSComm.Settings = "9600,E,8,1" '端口属性

Shape2.Left = 25
Shape2.Width = 7650
Shape2.Top = 250
Shape2.Height = 1680
Shape3.Left = 25
Shape3.Width = 7650
Shape3.Top = 250
Shape3.Height = 1680
End Sub


'连接下位机按钮的过程
Private Sub Connected_Click()
SendMode = 1                            '等待接收connected
Connected.Enabled = False
MSComm.InputMode = comInputModeText     '接收模式
Main.Timer3.Enabled = True
End Sub

Private Sub List_DblClick()
Call Edit_Click
End Sub

'导入文件
Private Sub LoadFile_Click()
Dim InputData As String
Dim loadcount As String  '读入各个种类的个数
Dim loadstate As String  '读入各个状态
Dim n As Integer
n = 0

On Error GoTo Nofile

Dialog.Filter = "文本文件|*.txt"
Dialog.CancelError = True
Dialog.ShowOpen
strFileName = Dialog.FileTitle
strFileDirectary = Dialog.FileName
FileDirector.Text = strFileDirectary
List.Clear

Open strFileDirectary For Input As #1
  Do While Not EOF(1)
  Line Input #1, InputData
  'List.AddItem Trim(Str$(n)) + Space(4 - Len(Trim(Str$(n)))) + Mid(InputData, 5)
  List.AddItem InputData
  n = n + 1
  Loop
Close #1
n = n - 3           '记录的个数

'获得存储的数量和状态,并删除最后两行
loadcount = Trim(Mid(List.List(List.ListCount - 2), 5))
loadstate = Trim(Mid(List.List(List.ListCount - 1), 5))
List.RemoveItem (List.ListCount - 1)
List.RemoveItem (List.ListCount - 1)

For i = 1 To 21 Step 3
  KindCount((i + 2) / 3) = Val(Trim(Mid(loadcount, i, 3)))
Next i

For i = 1 To n
  ListState(i) = Val(Mid(loadstate, i, 1))
Next i

Nofile:
  If Err.Number = 32775 Then
    Exit Sub
    List.List(0) = "序号" + "    触发条件" + "          触发事件"
  End If
End Sub

'端口接收事件
Private Sub MSComm_OnComm()
Dim rebyte() As Byte
Dim restr As String
Dim intInputLen As Integer
intInputLen = 0

 If MSComm.CommEvent = comEvReceive Then
  
      Select Case SendMode
        Case 1                                     '接收connected
          MSComm.InputMode = comInputModeText
          Do Until intInputLen > 8
            intInputLen = MSComm.InBufferCount
          Loop
          restr = MSComm.Input
          restr = Trim(Mid(restr, 1, 9))
          Call Checkconnected(restr)
          Exit Sub
        Case 2, 4                                   '接收iamok
          restr = Mid(MSComm.Input, 1, 5)
          Call Checkiamok(restr)
          Exit Sub
        Case 3                                      '接收FE
          intInputLen = MSComm.InBufferCount
          ReDim rebyte(intInputLen)
          rebyte = MSComm.Input
          Call CheckFE(rebyte())
          Exit Sub
        Case 5                                       '接收FD
          intInputLen = MSComm.InBufferCount
          ReDim rebyte(intInputLen)
          rebyte = MSComm.Input
          Call CheckFD(rebyte())
          Exit Sub
        Case 6                                       '接收时间和事件的个数
          intInputLen = MSComm.InBufferCount
          ReDim rebyte(intInputLen)
          rebyt = MSComm.Input
          Call CheckCount(rebyte())
          Exit Sub
      End Select
  End If
End Sub
'上传数据
Private Sub Receiveinf_Click()
Dim byt(0 To 3) As Byte
For i = 0 To 2
  byt(i) = &HFC
Next i
byt(3) = &H7C

If intComPort = 0 Then
  k = MsgBox("请先选择端口再进行连接.", vbInformation, "无效端口")
  Exit Sub
End If

If MSComm.PortOpen Then
  MSComm.PortOpen = False
End If
MSComm.InputMode = comInputModeBinary
MSComm.CommPort = intComPort
MSComm.PortOpen = True                 '开端口
MSComm.Output = byt()
SendMode = 6                           '接收时间和事件的个数
End Sub

'保存文件
Private Sub SaveFile_Click()
On Error GoTo Cancel
Call Sort                  '先排序
Dim countstr As String
Dim statestr As String
countstr = ""
statestr = ""

'各种事件的数量
For i = 1 To 8
  countstr = countstr + Str$(KindCount(i)) + Space(3 - Len(Str$(KindCount(i))))
Next i

For i = 1 To List.ListCount - 1
  statestr = statestr + Trim(Str$(ListState(i)))
Next i

Dialog.Filter = "文本文件|*.txt"
Dialog.ShowSave
strFileDirectary = Dialog.FileName
strFileName = Dialog.FileTitle
Savedir.Text = strFileDirectary
Open strFileDirectary For Output As #1
  For i = 0 To List.ListCount - 1
    Print #1, List.List(i)
  Next i
  Print #1, Space(4) + Trim(countstr)        '保存事件的数量
  Print #1, Space(4) + Trim(statestr)        '保存状态
Close #1
Cancel:
End Sub
'发送信息到下位机
Private Sub Sendinf_Click()
If List.ListCount = 1 Then
  k = MsgBox("不能发送空记录!", vbCritical, "无效操作")
  Exit Sub
End If
Call Sort                                     '排序
Call Sendtime_Click                           '握手信号
SendMode = 4                                  '等待接收iamok
End Sub

'发送时间到下位机
Private Sub Sendtime_Click()
If intComPort = 0 Then
  k = MsgBox("请先选择端口再进行发送.", vbInformation, "无效端口")
  Exit Sub
End If

If MSComm.PortOpen Then
  MSComm.PortOpen = False
End If

MSComm.InputMode = comInputModeText
MSComm.CommPort = intComPort
MSComm.PortOpen = True                            '开端口
MSComm.Output = "ready" + Chr(0) + Chr(End_Flag)  '握手信号
SendMode = 2                                      '等待接收iamok
End Sub

'排序
Private Sub Sortedcom_Click()
Call Sort
End Sub

Private Sub STab_Click(PreviousTab As Integer)
If STab.Tab = 0 Then
  Time(7).SetFocus
ElseIf STab.Tab = 1 Then
  TiaoJian.SetFocus
End If
End Sub

Private Sub systimeOption_Click()
Timer1.Interval = 1000
Timer1.Enabled = True
End Sub

Private Sub TiaoJian_Change()
Call information1_Change
End Sub

'时间显示
Private Sub Timer1_Timer()
Systemtime.Text = Trim(Str$(Now))
End Sub

'灯的循环闪烁
Private Sub Timer2_Timer()
FlashCount = FlashCount + 1
If FlashCount = 11 Then
  FlashCount = 1
End If
For i = 1 To 10
  Shape1(i).FillColor = QBColor(1)
Next i
Shape1(FlashCount).FillColor = QBColor(12)
End Sub

'连接下位机，等待40秒
Private Sub Timer3_Timer()
Dim mystr As String
mystr = "???"

'连接失败
ConnectCount = ConnectCount + 1
If ConnectCount >= 60 Then
  k = MsgBox("通信连接超时,请重试", vbInformation, "连接失败")
  ConnectCount = 0
  Status.Caption = "通信未连接"
  Connected.Enabled = True
  Timer3.Enabled = False
  Exit Sub
End If

'时间不到继续发送
If intComPort = 0 Then
  k = MsgBox("请先选择端口再进行连接.", vbInformation, "无效端口")
  Timer3.Enabled = False
  Connected.Enabled = True
  Exit Sub
End If

If MSComm.PortOpen Then
  MSComm.PortOpen = False
End If
Status.Caption = "通信连接中..."
MSComm.CommPort = intComPort
MSComm.PortOpen = True              '开端口
MSComm.Output = mystr + Chr(&H7C)
End Sub
'端口改变
Private Sub Comport_Click()
If Comport.Text = "COM1" Then
  intComPort = 1
ElseIf Comport.Text = "COM2" Then
  intComPort = 2
Else
  intComPort = 0
End If
End Sub
'时间文本框改变过程
Private Sub Time_Change(Index As Integer)
Select Case Index
  Case 7
    If Len(Time(7).Text) = 4 Then
      Time(6).SetFocus
    End If
  Case 6
    If Len(Time(6).Text) = 2 Or Val(Time(6).Text) >= 2 Then
      Time(5).SetFocus
    End If
  Case 5
    If Len(Time(5).Text) = 2 Or Val(Time(5).Text) >= 4 Then
      Time(4).SetFocus
    End If
  Case 4
    If Len(Time(4).Text) = 1 Then
      Time(3).SetFocus
    End If
  Case 3
    If Len(Time(Index).Text) = 2 Or Val(Time(3).Text) >= 3 Then
      Time(2).SetFocus
    End If
  Case 2
    If Len(Time(2).Text) = 2 Or Val(Time(2).Text) >= 6 Then
      Time(1).SetFocus
    End If
  Case 1
    If Len(Time(1).Text) = 2 Or Val(Time(1).Text) >= 6 Then
      information.SetFocus
    End If
End Select
End Sub
Private Sub information_Change()
If information.Text <> "" Then
  Add.Enabled = True
Else
  Add.Enabled = False
End If
End Sub

Private Sub information1_Change()
If information1.Text <> "" And TiaoJian.Text <> "" Then
  Add1.Enabled = True
Else
  Add1.Enabled = False
End If
End Sub

Private Sub ZsOption_Click()
Timer1.Enabled = False
k = MsgBox("使用自定时间的格式必须和原来的格式严格一致", vbOKOnly, "提示")
End Sub