form1.frm

al808的一个控制温度测试程序

VERSION 5.00
Object = "{65E121D4-0C60-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCHRT20.OCX"
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Begin VB.Form Form1 
   Caption         =   "AL808通信测试"
   ClientHeight    =   6135
   ClientLeft      =   1110
   ClientTop       =   2025
   ClientWidth     =   9315
   LinkTopic       =   "Form1"
   ScaleHeight     =   6135
   ScaleWidth      =   9315
   Begin VB.CommandButton Command1 
      Caption         =   "接收当前温度"
      Height          =   372
      Left            =   1080
      TabIndex        =   0
      Top             =   3120
      Width           =   1332
   End
   Begin VB.ComboBox Combo2 
      Height          =   276
      Left            =   2640
      Style           =   2  'Dropdown List
      TabIndex        =   18
      Top             =   720
      Width           =   2052
   End
   Begin VB.ComboBox Combo1 
      Height          =   276
      ItemData        =   "Form1.frx":0000
      Left            =   2640
      List            =   "Form1.frx":0002
      Style           =   2  'Dropdown List
      TabIndex        =   16
      Top             =   1080
      Width           =   2052
   End
   Begin VB.TextBox Text1 
      Height          =   372
      Left            =   2640
      TabIndex        =   14
      Text            =   "0"
      Top             =   1560
      Width           =   2052
   End
   Begin VB.TextBox Text6 
      Height          =   372
      Left            =   2640
      TabIndex        =   13
      Text            =   "1"
      Top             =   2040
      Width           =   2052
   End
   Begin VB.TextBox Text5 
      Height          =   495
      Left            =   2040
      MultiLine       =   -1  'True
      TabIndex        =   11
      Text            =   "Form1.frx":0004
      Top             =   5400
      Width           =   2652
   End
   Begin VB.TextBox Text4 
      Height          =   492
      Left            =   2040
      TabIndex        =   9
      Text            =   "60"
      Top             =   4680
      Width           =   2652
   End
   Begin VB.Timer Timer2 
      Interval        =   1000
      Left            =   4440
      Top             =   3480
   End
   Begin MSHierarchicalFlexGridLib.MSHFlexGrid t1 
      Height          =   2172
      Left            =   5520
      TabIndex        =   7
      Top             =   360
      Width           =   3612
      _ExtentX        =   6376
      _ExtentY        =   3836
      _Version        =   393216
      Cols            =   3
      _NumberOfBands  =   1
      _Band(0).Cols   =   3
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Check1"
      Height          =   375
      Left            =   1920
      TabIndex        =   6
      Top             =   2640
      Width           =   255
   End
   Begin VB.TextBox Text3 
      Height          =   375
      Left            =   2640
      TabIndex        =   4
      Text            =   "Text3"
      Top             =   3120
      Width           =   2052
   End
   Begin VB.CommandButton Command2 
      Caption         =   "发送设定值"
      Height          =   372
      Left            =   1080
      TabIndex        =   2
      Top             =   2040
      Width           =   1332
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   360
      Top             =   3480
   End
   Begin VB.TextBox Text2 
      Height          =   495
      Left            =   2040
      MultiLine       =   -1  'True
      TabIndex        =   1
      Text            =   "Form1.frx":000C
      Top             =   3840
      Width           =   2655
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   360
      Top             =   2640
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      CommPort        =   2
      DTREnable       =   -1  'True
      RThreshold      =   1
      ParitySetting   =   2
      DataBits        =   7
      InputMode       =   1
   End
   Begin MSChart20Lib.MSChart g1 
      Height          =   2532
      Left            =   5160
      OleObjectBlob   =   "Form1.frx":0014
      TabIndex        =   10
      Top             =   2640
      Width           =   3972
   End
   Begin VB.Label Label4 
      Caption         =   "通信速度:"
      Height          =   372
      Left            =   1080
      TabIndex        =   17
      Top             =   720
      Width           =   1932
   End
   Begin VB.Label Label3 
      Caption         =   "通信端口:"
      Height          =   372
      Left            =   1080
      TabIndex        =   15
      Top             =   1200
      Width           =   1932
   End
   Begin VB.Label Label1 
      Caption         =   "采样时间:"
      Height          =   492
      Index           =   2
      Left            =   1080
      TabIndex        =   12
      Top             =   4680
      Width           =   1332
   End
   Begin VB.Label Label2 
      Caption         =   "仪表地址:"
      Height          =   372
      Left            =   1080
      TabIndex        =   8
      Top             =   1680
      Width           =   1932
   End
   Begin VB.Label Label1 
      Caption         =   "实时接收:"
      Height          =   495
      Index           =   1
      Left            =   1080
      TabIndex        =   5
      Top             =   2760
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "接受数据:"
      Height          =   492
      Index           =   0
      Left            =   1080
      TabIndex        =   3
      Top             =   3840
      Width           =   1332
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim d

Private Sub Check1_Click()
    On Error Resume Next
    If Check1.Value Then
        Command1.Enabled = False
        Timer1.Enabled = True
    Else
        Command1.Enabled = True
        Timer1.Enabled = False
    End If
End Sub

Private Sub Combo1_Click()
    On Error Resume Next
    MSComm1.PortOpen = False
    If Combo1.Text = "COMM1" Then
        MSComm1.CommPort = 1
    Else
        MSComm1.CommPort = 2
    End If
    MSComm1.PortOpen = True
End Sub

Private Sub Combo2_Click()
    On Error Resume Next
    MSComm1.PortOpen = False
    MSComm1.Settings = Trim$(Combo2.Text) + ",e,7,1"
    MSComm1.PortOpen = True
End Sub

Private Sub Command1_Click()
    On Error Resume Next
    Dim a1(0 To 7) As Byte
    
    a1(0) = 4
    a1(1) = &H30 + (Int(Val(Text1.Text) / 10) Mod 10) '计算仪表地址
    a1(2) = &H30 + (Int(Val(Text1.Text) / 10) Mod 10)
    a1(3) = &H30 + (Int(Val(Text1.Text) / 1) Mod 10)
    a1(4) = &H30 + (Int(Val(Text1.Text) / 1) Mod 10)
    a1(5) = &H50
    a1(6) = &H56
    a1(7) = 5
    MSComm1.Output = a1
    
    Text2.Text = ""
    Text5.Text = ""
End Sub

Private Sub Command2_Click()
    On Error Resume Next
    Dim a1(0 To 14) As Byte
    Dim i, t
    
    a1(0) = 4
    a1(1) = &H30 + (Int(Val(Text1.Text) / 10) Mod 10) '计算仪表地址
    a1(2) = &H30 + (Int(Val(Text1.Text) / 10) Mod 10)
    a1(3) = &H30 + (Int(Val(Text1.Text) / 1) Mod 10)
    a1(4) = &H30 + (Int(Val(Text1.Text) / 1) Mod 10)
    a1(5) = 2
    a1(6) = &H53
    a1(7) = &H4C
    
    a1(8) = &H30 + (Int(Val(Text6.Text) / 1000) Mod 10)
    a1(9) = &H30 + (Int(Val(Text6.Text) / 100) Mod 10)
    a1(10) = &H30 + (Int(Val(Text6.Text) / 10) Mod 10)
    a1(11) = &H30 + (Int(Val(Text6.Text) / 1) Mod 10)
    a1(12) = &H20
    a1(13) = 3
    
    t = a1(6)
    For i = 7 To 13
        t = t Xor a1(i)
    Next i
    a1(14) = t
    
    MSComm1.Output = a1

    Text2.Text = ""
    Text5.Text = ""
End Sub

Private Sub Form_Load()
    On Error Resume Next
    Dim i, j
    
    For i = 1 To 100
        g1.Row = i
        g1.Data = 0
    Next i
    g1.Row = 1
    t1.Rows = 1
    t1.ColWidth(0) = 2000
    t1.Row = 0
    t1.Col = 0
    t1.Text = "时间"
    t1.Col = 1
    t1.Text = "温度"
    t1.Col = 2
    t1.Text = "变化"
    MSComm1.PortOpen = True
    Text2.Text = ""
    Text5.Text = ""
    Text3.Text = ""
    Combo1.AddItem "COMM1"
    Combo1.AddItem "COMM2"
    Combo1.Text = "COMM1"

    Combo2.AddItem "300"
    Combo2.AddItem "600"
    Combo2.AddItem "1200"
    Combo2.AddItem "2400"
    Combo2.AddItem "4800"
    Combo2.AddItem "9600"
    Combo2.AddItem "19200"
    Combo2.Text = "9600"
End Sub

Private Sub MSComm1_OnComm()
    On Error Resume Next

    Dim a1() As Byte
    Dim i, l, t1
    
    l = MSComm1.InBufferCount
    a1 = MSComm1.Input
    For i = 0 To l - 1
        t1 = a1(i)
        Text2.Text = Right$("0" + Hex$(t1), 2) + "-" + Text2.Text
        If Mid(Text2.Text, 1, 2) = "03" Then
            If Mid$(Text2.Text, 19, 2) = "56" Then
                If Mid$(Text2.Text, 22, 2) = "50" Then
                    If Mid$(Text2.Text, 25, 2) = "02" Then
                        Text3.Text = Chr(Val("&H" + Mid$(Text2.Text, 13, 2)))
                        Text3.Text = Text3.Text + Chr(Val("&H" + Mid$(Text2.Text, 10, 2)))
                        Text3.Text = Text3.Text + Chr(Val("&H" + Mid$(Text2.Text, 7, 2)))
                        'Text3.Text = Text3.Text + "."
'                        Text3.Text = Text3.Text + Chr(Val("&H" + Mid$(Text2.Text, 12, 2)))
                    End If
                End If
            End If
        End If
    Next i
    For i = 0 To l - 1
        t1 = a1(i)
        Text5.Text = Text5.Text + Right$("0" + Hex$(t1), 2) + "-"
    Next i
End Sub

Private Sub Timer1_Timer() '自动读取控制器测量值
    On Error Resume Next
    Dim a1(0 To 7) As Byte
    
    a1(0) = 4
    a1(1) = &H30 + (Int(Val(Text1.Text) / 10) Mod 10)
    a1(2) = &H30 + (Int(Val(Text1.Text) / 10) Mod 10)
    a1(3) = &H30 + (Int(Val(Text1.Text) / 1) Mod 10)
    a1(4) = &H30 + (Int(Val(Text1.Text) / 1) Mod 10)
    a1(5) = &H50                                      'P
    a1(6) = &H56                                      'V
    a1(7) = 5
    MSComm1.Output = a1
    
    Text2.Text = ""
    Text5.Text = ""
End Sub

Private Sub Timer2_Timer() '记录数据
    On Error Resume Next
    If Check1.Value Then
        d = d + 1
        If d >= Val(Text4.Text) Then
            d = 0
            t1.Rows = t1.Rows + 1
            t1.Row = t1.Rows - 1
            t1.Col = 0
            t1.Text = Str$(Hour(Now)) + ":" + Str$(Minute(Now)) + ":" + Str$(Second(Now))
            t1.Col = 1
            t1.Text = Text3.Text
            g1.Data = Val(Text3.Text)
            g1.Row = g1.Row + 1
            If g1.Row > 99 Then
                g1.Row = 1
            End If
        End If
    End If
End Sub