表的测试.frm

模拟屏 实时控制 监测 报警 监测报告

VERSION 5.00
Begin VB.Form Form3 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "四位数显表的测试"
   ClientHeight    =   8880
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6630
   LinkTopic       =   "Form3"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   8880
   ScaleWidth      =   6630
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton Command9 
      Caption         =   "显示EXCEL"
      Height          =   375
      Left            =   4080
      TabIndex        =   21
      Top             =   5760
      Width           =   1215
   End
   Begin VB.CommandButton Command8 
      Caption         =   "自动取值并发送"
      Height          =   375
      Left            =   3960
      TabIndex        =   20
      Top             =   4920
      Width           =   1455
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   480
      Top             =   4440
   End
   Begin VB.CommandButton Command7 
      Caption         =   "取值并发送"
      Height          =   375
      Left            =   960
      TabIndex        =   19
      Top             =   5760
      Width           =   1215
   End
   Begin VB.CommandButton Command6 
      Caption         =   "关闭EXCEL"
      Height          =   375
      Left            =   3960
      TabIndex        =   18
      Top             =   6840
      Width           =   1335
   End
   Begin VB.CommandButton Command4 
      Caption         =   "打开EXCEL"
      Height          =   375
      Left            =   960
      TabIndex        =   17
      Top             =   4920
      Width           =   1215
   End
   Begin VB.CommandButton Command3 
      Caption         =   "发送"
      Height          =   375
      Left            =   4320
      TabIndex        =   15
      Top             =   3840
      Width           =   855
   End
   Begin VB.TextBox Text5 
      Height          =   270
      Left            =   2640
      MaxLength       =   5
      TabIndex        =   14
      Top             =   3840
      Width           =   855
   End
   Begin VB.CommandButton Command1 
      Caption         =   "返回"
      Height          =   375
      Left            =   3960
      TabIndex        =   13
      Top             =   7560
      Width           =   1335
   End
   Begin VB.CommandButton Command12 
      Caption         =   "修改地址"
      Height          =   375
      Left            =   4200
      TabIndex        =   8
      Top             =   2880
      Width           =   975
   End
   Begin VB.TextBox Text6 
      Height          =   270
      Left            =   3240
      MaxLength       =   4
      TabIndex        =   7
      Top             =   3000
      Width           =   615
   End
   Begin VB.TextBox Text2 
      Height          =   270
      Left            =   1440
      MaxLength       =   4
      TabIndex        =   6
      Top             =   3000
      Width           =   615
   End
   Begin VB.CommandButton Command11 
      Caption         =   "广播命令"
      Height          =   375
      Left            =   4320
      TabIndex        =   5
      Top             =   720
      Width           =   975
   End
   Begin VB.CommandButton Command2 
      Caption         =   "初始化"
      Height          =   375
      Left            =   3240
      TabIndex        =   4
      Top             =   720
      Width           =   855
   End
   Begin VB.TextBox Text4 
      Height          =   270
      Left            =   1800
      MaxLength       =   4
      TabIndex        =   3
      Top             =   840
      Width           =   615
   End
   Begin VB.CommandButton Command5 
      Caption         =   "发送"
      Default         =   -1  'True
      Height          =   375
      Left            =   4440
      TabIndex        =   2
      Top             =   1800
      Width           =   855
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Index           =   0
      Left            =   1800
      MaxLength       =   15
      TabIndex        =   1
      Top             =   1920
      Width           =   1935
   End
   Begin VB.TextBox Text3 
      Height          =   1095
      Left            =   960
      MaxLength       =   75
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   6960
      Width           =   2415
   End
   Begin VB.Label Label3 
      Caption         =   "遥测数据："
      Height          =   375
      Left            =   600
      TabIndex        =   16
      Top             =   3840
      Width           =   1095
   End
   Begin VB.Label Label6 
      Caption         =   "新地址："
      Height          =   255
      Left            =   2400
      TabIndex        =   12
      Top             =   3000
      Width           =   975
   End
   Begin VB.Label Label2 
      Caption         =   "原地址："
      Height          =   255
      Left            =   600
      TabIndex        =   11
      Top             =   3000
      Width           =   855
   End
   Begin VB.Label Label8 
      Caption         =   "地址："
      Height          =   255
      Left            =   720
      TabIndex        =   10
      Top             =   840
      Width           =   615
   End
   Begin VB.Label Label1 
      Caption         =   "发送数据："
      Height          =   255
      Index           =   1
      Left            =   600
      TabIndex        =   9
      Top             =   1920
      Width           =   1095
   End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public inttime As Integer  '发送时间间隔
Public strset As String
Dim myarray(12) As String
Public intport As Integer   '串行口号
Dim xlApp As Excel.Application                          '定义EXCEL类
Dim xlBook As Excel.Workbook                          '定义工件簿类
Dim xlsheet As Excel.Worksheet                          '定义工作表类
Dim nn As Integer
Private Sub Command1_Click()
Form3.Visible = False
  If Dir("E:\vb\excel.bz") <> "" Then                     '由VB关闭EXCEL
         xlBook.RunAutoMacros (xlAutoClose)                  '执行EXCEL关闭宏
            xlBook.Close (True)                                 '关闭EXCEL工作簿
            xlApp.Quit                                         '关闭EXCEL
          End If
          Set xlApp = Nothing                                   '释放EXCEL对象
End Sub

Private Sub Command11_Click()
 If Not Form1.MSComm1.PortOpen Then
       MsgBox ("请先选择串口后，再执行此操作")
   Else
       Form1.MSComm1.Output = "UUf13333c"  ' 向串口发送广播命令
  End If
End Sub

Private Sub Command12_Click()
 If Len(Trim(Text2.Text)) < 4 Then
   m1 = 4 - Len(Trim(Text2.Text))
   Dim d As Integer, sss As String
   For d = 1 To m1
     sss = sss + "0"
   Next
 Text2.Text = sss + Trim(Text2.Text)
 End If
 If Len(Trim(Text6.Text)) < 4 Then
   m1 = 4 - Len(Trim(Text6.Text))
  sss = ""
   For d = 1 To m1
     sss = sss + "0"
   Next
 Text6.Text = sss + Trim(Text6.Text)
 End If
 Dim n1 As Integer, n2 As Integer
Dim i As Integer, s As String
Dim myarray() As String
'将旧地址和新地址都读取到myarray()数组中，并且将每位数据的ASC码值累加到n2中
ReDim myarray(8)
For i = 1 To 4
myarray(i) = Mid(Trim(Text2.Text), i, 1)
n2 = n2 + Asc(myarray(i))
Next
For i = 5 To 8
myarray(i) = Mid(Trim(Text6.Text), i - 4, 1)
n2 = n2 + Asc(myarray(i))
Next
'累加两个％的ASC码值并取其低位字节
n2 = n2 + Asc("%")
n2 = n2 + Asc("%")
s = Right(Hex(n2), 2)
 '发送
  If Not Form1.MSComm1.PortOpen Then
       MsgBox ("请先选择串口后，再执行此操作")
  Else
      Form1.MSComm1.Output = "UU%" + Text2.Text + Text6.Text + "%" + s
       
  End If
Text4.Text = Text6.Text
End Sub

Private Sub Command2_Click()

Dim m As Integer, m1 As Integer
If Not Form1.MSComm1.PortOpen Then
       MsgBox ("请先选择串口后，再执行此操作")  '判断串口的打开状态
Else
If Len(Trim(Text4.Text)) < 4 Then
   m1 = 4 - Len(Trim(Text4.Text))
   Dim d As Integer, sss As String
   For d = 1 To m1
     sss = sss + "0"
   Next
 Text4.Text = sss + Trim(Text4.Text)
 End If
      
 s = "UU%" + Text4.Text + "0000$"
 Dim i As Integer, n As Integer
 For i = 3 To 12
 myarray(i) = Mid(s, i, 1)
 n = n + Asc(myarray(i))
 Next
 s1 = Right(Hex(n), 2)
 Form1.MSComm1.Output = s + s1
End If
Text3.Text = s + s1 + Chr$(13) + Chr$(10) + Text3.Text
End Sub


Private Sub Command3_Click()
If Text4.Text = "" Then
MsgBox ("请输入芯片的地址")
Else
Dim m1 As Integer
  If Len(Trim(Text4.Text)) < 4 Then
   m1 = 4 - Len(Trim(Text4.Text))
   Dim d As Integer, sss As String
   For d = 1 To m1
     sss = sss + "0"
   Next
 Text4.Text = sss + Trim(Text4.Text)
 End If
            
Dim i As Integer, j As Integer, n As Integer, c As Integer, m As Integer, l As Integer
Dim s As String
n = n + Asc("#")
For c = 1 To 4
n = n + Asc(Mid(Trim(Text4.Text), c, 1))
Next
  m = 4
 For i = 1 To Len(Trim(Text5.Text))
    If Mid(Text5.Text, i, 1) = "." Then
       j = Len(Trim(Text5.Text)) - i
       m = 5
     Else
       s = s + Mid(Text5.Text, i, 1)
       
    End If
 Next
 l = m - Len(Trim(Text5.Text))
  For i = 1 To l
  s = " " + s
  Next

  s = s & j
 For i = 1 To 5
   n = n + Asc(Mid(s, i, 1))
 Next
 Form1.MSComm1.Output = "UU#" + Text4.Text + s + Right(Hex(n), 2)
End If



Text3.Text = "UU#" + Text4.Text + s + Right(Hex(n), 2) + Chr$(13) + Chr$(10) + Text3.Text

End Sub



Private Sub Command5_Click()
Dim n1 As Integer, n2 As Integer
Dim i As Integer, s As String
Dim myarray() As String
n1 = Len(Trim(Text1(0).Text)) '所发送的命令
ReDim myarray(n1)
For i = 3 To n1
myarray(i) = Mid(Trim(Text1(0).Text), i, 1) '从第三位开始取数据
n2 = n2 + Asc(myarray(i))  '累加ASC值
Next
s = Right(Hex(n2), 2)     '取低字节
   If Not Form1.MSComm1.PortOpen Then
       MsgBox ("请先选择串口后，再执行此操作")
   Else
      Form1.MSComm1.Output = Text1(0).Text + s '向串口发送数据
   End If
Text3.Text = Text1(0).Text + s + Chr$(13) + Chr$(10) + Text3.Text
End Sub
    
        Private Sub Command4_Click()                           '打开EXCEL过程
          If Dir("E:\vb060513\excel.bz") = "" Then                     '判断EXCEL是否打开
            Set xlApp = CreateObject("Excel.Application")           '创建EXCEL应用类
           'xlApp.Visible = True                                '设置EXCEL可见
            xlApp.Visible = False
            Set xlBook = xlApp.Workbooks.Open("E:\vb060513\a.xls")    '打开EXCEL工作簿
            Set xlsheet = xlBook.Worksheets(1)                    '打开EXCEL工作表
            xlsheet.Activate                                    '激活工作表
            'xlsheet.Cells(1, 1) = "abc"  '给单元格1行驶列赋值
            
            xlBook.RunAutoMacros (xlAutoOpen)                 '运行EXCEL中的启动宏
          Else
            MsgBox ("EXCEL已打开")
          End If
          nn = 1
        End Sub

        Private Sub Command6_Click()
          If Dir("E:\vb060513\excel.bz") <> "" Then                     '由VB关闭EXCEL
         xlBook.RunAutoMacros (xlAutoClose)                  '执行EXCEL关闭宏
            xlBook.Close (True)                                 '关闭EXCEL工作簿
            xlApp.Quit                                         '关闭EXCEL
          End If
          Set xlApp = Nothing                                   '释放EXCEL对象
          Timer1.Enabled = False
        End Sub

Private Sub Command7_Click()
         Dim nn As Integer
         nn = nn + 1
         If nn = 5 Then
         nn = 0
         End If
         Text5.Text = xlsheet.Cells(2, 1).Value
           
End Sub


Private Sub Command8_Click()
 If Err Then
    MsgBox ("EXCEL文件没有打开 ") '如果EXCEL文件没有被打开
Else
 If Text4.Text = "" Then
 MsgBox ("请输入芯片的地址")
Else
       
If Command8.Caption = "自动取值并发送" Then

      Command8.Caption = "关闭自动取值"
     Timer1.Enabled = True
Else
  If Command8.Caption = "关闭自动取值" Then

      Command8.Caption = "自动取值并发送"
     Timer1.Enabled = False
  End If
End If
End If
End If
End Sub



Private Sub Command9_Click()
On Error Resume Next
 
  If Command9.Caption = "显示EXCEL" Then

      Command9.Caption = "不显示EXCEL"
      xlApp.Visible = True
Else
  If Command9.Caption = "不显示EXCEL" Then

      Command9.Caption = "显示EXCEL"
      xlApp.Visible = False
  End If
End If
         If Err Then
           MsgBox ("EXCEL文件没有打开 ") '如果EXCEL文件没有被打开
         End If
End Sub

Private Sub Timer1_Timer()
          If Err Then
            MsgBox ("EXCEL文件没有打开 ") '如果EXCEL文件没有被打开
          End If
         nn = nn + 1
         If xlsheet.Cells(nn, 1).Value = "" Then
       '  MsgBox ("是否重新读取",vbOKCancel )
        iii = MsgBox("是否重新读取", vbOKCancel, "是否重新读取")
         If iii = 1 Then   '判断如果单击确定钮按就重新再读一次
         nn = 1
         Else              '判断如果单击取消钮按则将自动取值功能关闭
          Command8.Caption = "自动取值并发送"
          Timer1.Enabled = False
         End If
         End If
         Text5.Text = xlsheet.Cells(nn, 1).Value
    
            
Dim i As Integer, j As Integer, n As Integer, c As Integer, m As Integer, l As Integer
Dim s As String
n = n + Asc("#")
For c = 1 To 4
n = n + Asc(Mid(Trim(Text4.Text), c, 1))
Next
  m = 4
 For i = 1 To Len(Trim(Text5.Text))
    If Mid(Text5.Text, i, 1) = "." Then
       j = Len(Trim(Text5.Text)) - i
       m = 5
     Else
       s = s + Mid(Text5.Text, i, 1)
       
    End If
 Next
 l = m - Len(Trim(Text5.Text))
  For i = 1 To l
  s = " " + s
  Next

  s = s & j
 For i = 1 To 5
   n = n + Asc(Mid(s, i, 1))
 Next
 Form1.MSComm1.Output = "UU#" + Text4.Text + s + Right(Hex(n), 2)




Text3.Text = "UU#" + Text4.Text + s + Right(Hex(n), 2) + Chr$(13) + Chr$(10) + Text3.Text

End Sub