form1.frm

读取数据库数据并显示在LED屏上。串口编程

            Size            =   15
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   360
         TabIndex        =   41
         Top             =   4320
         Width           =   1320
      End
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   1560
      Top             =   5640
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.CommandButton Command18 
      Caption         =   "退出程序"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   8760
      TabIndex        =   2
      Top             =   6900
      Width           =   1575
   End
   Begin VB.CommandButton Command17 
      Caption         =   "打开串口"
      Height          =   375
      Left            =   7080
      TabIndex        =   1
      Top             =   6900
      Width           =   975
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      ItemData        =   "Form1.frx":324A
      Left            =   6000
      List            =   "Form1.frx":324C
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   6937
      Width           =   735
   End
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   1080
      Top             =   5760
   End
   Begin VB.Timer Timer2 
      Left            =   480
      Top             =   5640
   End
   Begin VB.Label Label18 
      BackStyle       =   0  'Transparent
      Caption         =   "选择通信串口"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FFFF&
      Height          =   255
      Left            =   4320
      TabIndex        =   39
      Top             =   6960
      Width           =   1575
   End
   Begin VB.Label Label20 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "已打开"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FFFF&
      Height          =   255
      Left            =   6720
      TabIndex        =   38
      Top             =   7440
      Width           =   975
   End
   Begin VB.Label Label19 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "当前工作串口"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FFFF&
      Height          =   240
      Left            =   4800
      TabIndex        =   37
      Top             =   7440
      Width           =   1665
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "南隔堤水位LED显示系统"
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   26.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   525
      Left            =   3675
      TabIndex        =   20
      Top             =   240
      Width           =   5745
   End
   Begin VB.Label Label21 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "1"
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   21.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   435
      Left            =   6480
      TabIndex        =   19
      Top             =   7320
      Width           =   255
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Command_Click(Index As Integer)       '手动/自动置数按钮组
    If Command(Index).Caption = "手动置数" Then
        Text(Index).Enabled = True
        cmd(Index) = 1
        Command(Index).Caption = "自动置数"
    Else
        Text(Index).Enabled = False
        cmd(Index) = 0
        Command(Index).Caption = "手动置数"
        Call getdata
        Call send
    End If
End Sub



Private Sub Command17_Click()
    On Error Resume Next
    If Command17.Caption = "关闭串口" Then
        MSComm1.PortOpen = False
        Command17.Caption = "打开串口"
        Label19.Caption = "未打开工作串口"
        Label21 = ""
        Label20 = ""
        Combo1.Enabled = True
    Else
        MSComm1.CommPort = Combo1.Text
        MSComm1.Settings = "9600,n,8,1"      '打开串口，设置为9600，n，8，1
        MSComm1.PortOpen = True
        If Err Then           '错误处理
            msg = MsgBox(" 串口 " & Combo1.Text & " 打开无效！请选择其它串口 ", vbOKOnly, "警告")
            Exit Sub
        Else
            Label19 = "当前工作串口"
            Label21.Caption = Combo1.Text
            Label20.Caption = "已打开"
            Command17.Caption = "关闭串口"
            Combo1.Enabled = False
        End If
    End If
End Sub

Private Sub Command18_Click()       '关闭程序按钮
    If Label21.Caption <> "" Then
        MSComm1.PortOpen = False
    End If
    If qy2.State = adStateOpen Then
        qy2.Close
    End If
    Unload Form2
    Unload Form3
    End
End Sub




Private Sub Form_Initialize()       '窗体初始化时查找数据库数据
    qy1.Open "select max(datatime) from 1_1Yc ", cnn, adOpenStatic, adLockReadOnly, adCmdText
    Label37.Caption = qy1.Fields(0)
    If Label37.Caption = "2008-4-1 12:35:29" Then
        MsgBox "当前数据库中无数据记录可显示"
        Label37.Caption = ""
        Label4.Caption = ""
        qy1.Close
        Exit Sub
    Else
        qy1.Close
        Set qy2 = cnn.Execute("select * from 1_1Yc where datatime=#" & Label37.Caption & "#")
        Label37.Caption = qy2.Fields(0)
        Label4.Caption = qy2.Fields(0)
        For i = 1 To 3
            Text(i).Text = qy2.Fields(i)
        Next i
        For i = 4 To 16
            Text(i).Text = qy2.Fields(i + 2)
        Next i
        qy2.Close
        'cnn.Close
    End If
End Sub
Private Sub Form_Load()     '窗体装入时打开串口1，先执行LOAD，再执行INITIALIZE
    Dim i As Integer
    On Error Resume Next    '当发生错误时，从发生错误的语句下一句继续执行
    For i = 1 To 9
        Combo1.AddItem i
    Next i
    Combo1.ListIndex = 0
    MSComm1.CommPort = 1
    MSComm1.Settings = "9600,n,8,1"
    MSComm1.PortOpen = True
    If Err Then           '错误处理,也可以用msgbox error()来显示错误信息
        msg = MsgBox(" 串口 1 打开无效！请选择其它串口 ", vbOKOnly, "警告")
        Label19.Caption = "未打开工作串口"
        Label21 = ""
        Label20 = ""
        Command117.Caption = "打开串口"
        Combo1.Enabled = True
        Exit Sub
    Else
        Label19 = "当前工作串口"
        Label21.Caption = "1"
        Label20.Caption = "已打开"
        Command17.Caption = "关闭串口"
        Combo1.Enabled = False
    End If
End Sub


Private Sub Text_Change(Index As Integer)     '当置为手动置数且文本窗有数据改变时，延时5秒执行发送数据
Timer2.Enabled = False
Timer2.Interval = 5000
Timer2.Enabled = True
End Sub


Private Sub Timer1_Timer()        '定时5分钟一次读数据并发送
    n = n + 1
    If n >= 300 Then
        Call send
        'cnn.Close
        n = 0
    End If
End Sub

Private Sub getdata()       '读数据库数据

    qy1.Open "select max(datatime) from 1_1Yc ", cnn, adOpenStatic, adLockReadOnly, adCmdText
    date1 = qy1.Fields(0)
    If date1 = "2008-4-1 12:35:29" Then
        Form3.Label1.Caption = "当前数据库无数据可显示!"
        Form3.Show 0, Me
        Label37.Caption = ""
        Label4.Caption = ""
        For i = 1 To 16
            If cmd(i) = 0 Then
                Text(i).Text = ""
            End If
        Next i
        qy1.Close
        Exit Sub
    Else
        qy1.Close
        Set qy2 = cnn.Execute("select * from 1_1Yc where datatime=#" & date1 & "#")
        Label37.Caption = qy2.Fields(0)
        Label4.Caption = qy2.Fields(0)
        For i = 1 To 3
            If cmd(i) = 0 Then
                Text(i).Text = qy2.Fields(i)
            End If
        Next i
        For i = 4 To 16
            If cmd(i) = 0 Then
                Text(i).Text = qy2.Fields(i + 2)
            End If
        Next i
        qy2.Close
    End If

End Sub
Private Sub process()       '处理数据
    Dim temp(4) As String
    For i = 0 To 15
        For z = 0 To 3
            data(i - 1, z) = Chr("&h0")
        Next z
    Next i
    For i = 1 To 16
        temp(0) = "0"
        temp(1) = "0"
        temp(2) = "0"
        temp(3) = "0"
        Text(i).Text = Trim(Text(i).Text)
        If Text(i).Text = "" Or Text(i).Text = "0" Or Text(i).Text = "00" Or Text(i).Text = "000" Or Text(i).Text = "0000" Or Text(i).Text = "00000" Then
            data(i - 1, 0) = Chr(&H0)
            data(i - 1, 1) = Chr(&H0)
            data(i - 1, 2) = Chr(&H0)
            data(i - 1, 3) = Chr(&H0)
        Else
            a = Len(Text(i).Text)
            b = InStr(Text(i).Text, ".")
            Select Case b
            Case 0, Is > 3
                If a > 2 Then
                    Form2.Label1.Caption = "第"
                    Form2.Label2.Caption = i
                    Form2.Label3.Caption = "号数据有错误，请检查!"
                    Form2.Label4.Caption = "(最大有效至99.99)"
                    Form2.Show 0, Me     '请比较form2.show显示窗体的不同之处
                    er(i) = 1
                    'MsgBox "第 " & i & " 号数据有错误，请检查(最大只能----)"
                Else
                    temp(2) = Right(Text(i).Text, 1)
                    temp(3) = IIf(a <> 2, 0, Left(Text(i).Text, 1))
                End If
            Case 1
                temp(0) = IIf(a > 2, Mid(Text(i).Text, 3, 1), 0)
                temp(1) = IIf(a >= 2, Mid(Text(i).Text, 2, 1), 0)
            Case 2
                temp(0) = IIf(a > 3, Mid(Text(i).Text, 4, 1), 0)
                temp(1) = IIf(a >= 3, Mid(Text(i).Text, 3, 1), 0)
                temp(2) = Left(Text(i).Text, 1)
            Case 3
                temp(0) = IIf(a > 4, Mid(Text(i).Text, 5, 1), 0)
                temp(1) = IIf(a >= 4, Mid(Text(i).Text, 4, 1), 0)
                temp(2) = Mid(Text(i).Text, 2, 1)
                temp(3) = Left(Text(i).Text, 1)
            End Select
            If er(i) = 0 Then
                For z = 0 To 3
                    If Asc(temp(z)) > 57 Or Asc(temp(z)) < 48 Then
                        'MsgBox "第 " & i & " 号数据有错误，含有非法符!"
                        Form2.Label1.Caption = "第"
                        Form2.Label2.Caption = i
                        Form2.Label3.Caption = "号数据有错误，请检查!"
                        Form2.Label4.Caption = "(含有非法字符)"
                        Form2.Show 0, Me
                        er(i) = 1
                        Exit For
                    Else
                        data(i - 1, z) = Chr(Asc(temp(z)) - 48)
                    End If
                Next z
            End If
        End If
    Next i

End Sub

Private Sub send()      '发送数据
'tkOpenAccessDB App.Path & "\data.mdb"
Unload Form2
Unload Form3
    Call getdata
    For i = 1 To 16
        er(i) = 0
    Next i

    Call process

    For i = 1 To 16
        If er(i) = 1 Then
            For z = 0 To 3
                data(i - 1, z) = Chr("&h0")
            Next z
        End If
    Next i

    If MSComm1.PortOpen Then
        For i = 1 To 16
            For z = 0 To 3
                MSComm1.Output = data(i - 1, z)
            Next z
        Next i
    Else
        MsgBox "未打开工作串口"
    End If
End Sub

Private Sub Timer2_Timer()
Call send
'cnn.Close
Timer2.Interval = 0
Timer2.Enabled = False
End Sub