form1.frm

一个有效的教学型监控软件

            Size            =   14.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   585
         Index           =   2
         Left            =   1530
         TabIndex        =   2
         Top             =   1050
         Width           =   195
      End
      Begin VB.CheckBox chkLED 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   585
         Index           =   1
         Left            =   570
         TabIndex        =   1
         Top             =   1050
         Width           =   195
      End
      Begin VB.Image imgLED 
         Height          =   675
         Index           =   8
         Left            =   7260
         Picture         =   "Form1.frx":1A71
         Stretch         =   -1  'True
         Top             =   330
         Width           =   465
      End
      Begin VB.Image imgLED 
         Height          =   675
         Index           =   7
         Left            =   6285
         Picture         =   "Form1.frx":2308
         Stretch         =   -1  'True
         Top             =   315
         Width           =   465
      End
      Begin VB.Image imgLED 
         Height          =   675
         Index           =   6
         Left            =   5295
         Picture         =   "Form1.frx":2B9F
         Stretch         =   -1  'True
         Top             =   315
         Width           =   465
      End
      Begin VB.Image imgLED 
         Height          =   675
         Index           =   5
         Left            =   4290
         Picture         =   "Form1.frx":3436
         Stretch         =   -1  'True
         Top             =   315
         Width           =   465
      End
      Begin VB.Image imgLED 
         Height          =   675
         Index           =   4
         Left            =   3360
         Picture         =   "Form1.frx":3CCD
         Stretch         =   -1  'True
         Top             =   315
         Width           =   465
      End
      Begin VB.Image imgLED 
         Height          =   675
         Index           =   3
         Left            =   2415
         Picture         =   "Form1.frx":4564
         Stretch         =   -1  'True
         Top             =   300
         Width           =   465
      End
      Begin VB.Image imgLED 
         Height          =   675
         Index           =   2
         Left            =   1410
         Picture         =   "Form1.frx":4DFB
         Stretch         =   -1  'True
         Top             =   270
         Width           =   465
      End
      Begin VB.Image imgLED 
         Height          =   675
         Index           =   1
         Left            =   450
         Picture         =   "Form1.frx":5692
         Stretch         =   -1  'True
         Top             =   270
         Width           =   465
      End
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   -150
      Top             =   2400
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
      RThreshold      =   1
      InputMode       =   1
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "智能控制与仿真V1.0"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   36
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   720
      Left            =   3570
      TabIndex        =   45
      Top             =   30
      Width           =   6480
   End
   Begin VB.Image imgLEDon 
      Height          =   360
      Left            =   10890
      Picture         =   "Form1.frx":5F29
      Stretch         =   -1  'True
      Top             =   1500
      Visible         =   0   'False
      Width           =   210
   End
   Begin VB.Image imgLEDoff 
      Height          =   735
      Left            =   10050
      Picture         =   "Form1.frx":679A
      Stretch         =   -1  'True
      Top             =   1440
      Visible         =   0   'False
      Width           =   390
   End
   Begin VB.Menu menuFiles 
      Caption         =   "文件"
      Begin VB.Menu menuModify 
         Caption         =   "注册用户"
      End
      Begin VB.Menu menuExit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu menuHelp 
      Caption         =   "帮助"
      Begin VB.Menu menuAboutForm 
         Caption         =   "关于"
      End
   End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cblLED_Click(Index As Integer)
   Call sendCmdData(194, Index, Val(cblLED(Index).Text))
End Sub

Private Sub chkBeep_Click()
  If chkBeep.Value = 1 Then
    imgBeepON.Visible = True
    imgBeepOFF.Visible = False
    Call sendCmdData(195, 1, 204)
    chkBeep.Caption = "打开"
  Else
     imgBeepON.Visible = False
     imgBeepOFF.Visible = True
     Call sendCmdData(195, 0, 204)
     chkBeep.Caption = "关闭"
  End If
  
End Sub

Private Sub chkDraw_Click()
 If txtUserName.Text <> "" Then
   If chkDraw.Value = 1 Then
    Call sendCmdData(196, 1, 204)
    chkDraw.Caption = "打开"
  Else
     Call sendCmdData(196, 0, 204)
     chkDraw.Caption = "关闭"
  End If
 Else
   MsgBox "请输入值班人姓名", vbOKOnly + 32, "提示"
 End If
End Sub

Private Sub chkLED_Click(Index As Integer)
   Dim SendF(1 To 1) As Byte, intB As Integer, s(1 To 8) As Integer
   If chkLED(Index).Value = 1 Then
      imgLED(Index).Picture = imgLEDon.Picture
   Else
      imgLED(Index).Picture = imgLEDoff.Picture
   End If
   For i = 1 To 8
     If chkLED(i).Value = 1 Then
        s(i) = 0
     Else
        s(i) = 1
     End If
   Next
   For i = 1 To 8
     intB = intB + 2 ^ (i - 1) * s(i) '(chkLED(i).Value)
   Next
   Call sendCmdData(193, intB, 204)
End Sub

Private Sub cmdDel_Click()
If ADOVotage.Recordset.RecordCount = 0 Then
  Exit Sub
Else
  ADOVotage.Recordset.MoveFirst
End If
  While (ADOVotage.Recordset.RecordCount <> 0)
      ADOVotage.Recordset.Delete
      ADOVotage.Recordset.MoveNext
      If ADOVotage.Recordset.EOF Then
        Exit Sub
      End If
      
  Wend
  
End Sub

Private Sub cmdLader_Click()
   Unload Me
   frmLader.Show
End Sub

Private Sub cmdLED_Click(Index As Integer)
  Select Case Index
        Case 0
          For i = 1 To 8
            imgLED(i).Picture = imgLEDon.Picture
            chkLED(i).Value = 1
          Next i
        Case 1
          For i = 1 To 8
            If chkLED(i).Value = 1 Then
               imgLED(i).Picture = imgLEDoff.Picture
               chkLED(i).Value = 0
            Else
               imgLED(i).Picture = imgLEDon.Picture
               chkLED(i).Value = 1
            End If
          Next i
        Case 2
          For i = 1 To 8
            imgLED(i).Picture = imgLEDoff.Picture
            chkLED(i).Value = 0
          Next i
  End Select
End Sub




Private Sub cmdPicCls_Click()
  PicDraw.Cls
  Call DrawPos
End Sub

Private Sub Command1_Click()
   
End Sub

Private Sub Form_Load()
      MSComm1.PortOpen = True
      For i = 0 To 7
         For j = 0 To 9
           cblLED(i).AddItem j
         Next j
         cblLED(i).AddItem "关闭"
      Next i
      Me.Left = (Screen.Width - Me.Width) / 2
      Me.Top = (Screen.Height - Me.Height) / 2
      BSE1.SchemeStyle = 0
      BSE1.EndSubClassing
      BSE1.InitSubClassing
      Call DrawPos   '画坐标
      ADOVotage.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\采样数据.mdb;Persist Security Info=False"
      ADOVotage.CommandType = adCmdTable
      ADOVotage.RecordSource = "数据记录表"
      
End Sub
Private Sub sendCmdData(sOptData As Integer, sCmdData As Integer, EndData As Integer)
    Dim SendData(0 To 3) As Byte
    SendData(0) = &HCC
    SendData(1) = sOptData
    SendData(2) = sCmdData
    SendData(3) = EndData
    MSComm1.Output = SendData
End Sub

Private Sub menuAboutForm_Click()
  frmAbout.Show
End Sub

Private Sub menuExit_Click()
  MSComm1.PortOpen = False
  Unload Me
  End
End Sub

Private Sub menuModify_Click()
   frmPassModify.Show
End Sub

Private Sub MSComm1_OnComm()
Dim revBuf(0 To 3) As Byte, Buf() As Byte
Select Case MSComm1.CommEvent
  Case comEvReceive   ' 收到 RThreshold # of
     Buf = MSComm1.Input
     revBuf(0) = Buf(0)
     revBuf(1) = Buf(1)
     revBuf(2) = Buf(2)
     revBuf(3) = Buf(3)
     Select Case revBuf(0)
       Case 204
          Select Case revBuf(2)
               Case 0
                 Call K1_Program
               Case 1
                 'Call K2_Program
                 Unload Me
                 frmTraffic.Show
               Case 2
                 Call K3_Program
               Case 3
                  Unload Me
                  frmLader.Show
        End Select
     Case 192
        Static t As Integer
        t = t + 1
        PicDraw.Line -(t, revBuf(3)), vbBlue
        txtRec.Text = revBuf(3)
        Call AddADO
        If t >= 95 Then
          t = 0
          PicDraw.Cls
          Call DrawPos
        End If
        
     End Select
End Select
End Sub

Private Sub K1_Program()
   Static flag_K1 As Boolean
   If Not flag_K1 Then
      Shape1.BackColor = vbGreen
   Else
      Shape1.BackColor = &H8000&
   End If
   flag_K1 = Not flag_K1
End Sub
Private Sub K2_Program()
  Static flag_K2 As Boolean
  If Not flag_K2 Then
     trmTraffic.Enabled = True
  Else
     trmTraffic.Enabled = False
     TraRed.BackColor = &H80&
     TraYellow.BackColor = &H8080&
     TraGreen.BackColor = &H8000&
  End If
  flag_K2 = Not flag_K2
End Sub
Private Sub K3_Program()
   Static intK3 As Integer
   intK3 = intK3 + 1
   txtCount.Text = intK3
End Sub

Private Sub trmTraffic_Timer()
     Static MyTimer As Integer
     MyTimer = MyTimer + 1
     Select Case MyTimer
            Case 1 To 15
              TraRed.BackColor = vbRed
              TraYellow.BackColor = &H8080&
              TraGreen.BackColor = &H8000&
            Case 16 To 20
              TraRed.BackColor = &H80&
              TraYellow.BackColor = vbYellow
              TraGreen.BackColor = &H8000&
            Case 21 To 35
              TraRed.BackColor = &H80&
              TraYellow.BackColor = &H8080&
              TraGreen.BackColor = vbGreen
            Case 36 To 40
              TraRed.BackColor = &H80&
              TraYellow.BackColor = vbYellow
              TraGreen.BackColor = &H8000&
    End Select
    If MyTimer >= 40 Then
        MyTimer = 0
    End If
End Sub

Private Sub DrawPos()
  PicDraw.Scale (-5, 285)-(105, -100)
      PicDraw.DrawWidth = 2
      PicDraw.Line (-5, 0)-(100, 0), vbRed
      PicDraw.Line (0, 280)-(0, -100), vbRed
      For i = -80 To 260 Step 20
        PicDraw.Line (0, i)-(1, i), vbRed
        PicDraw.Print i
      Next
      For i = 5 To 95 Step 5
        PicDraw.Line (i, 0)-(i, -5), vbRed
        PicDraw.Print i
      Next
      PicDraw.Line (-1, 270)-(0, 280), vbRed
      PicDraw.Line (1, 270)-(0, 280), vbRed
      PicDraw.Line (100, 0)-(98, 6), vbRed
      PicDraw.Line (100, 0)-(98, -6), vbRed
      PicDraw.CurrentX = 0
      PicDraw.CurrentY = 0
End Sub

Private Sub AddADO()
      ADOVotage.Recordset.AddNew
      ADOVotage.Recordset.Fields(1) = txtUserName.Text
      ADOVotage.Recordset.Fields(2) = txtRec.Text
      ADOVotage.Recordset.Fields(3) = Now
      ADOVotage.Recordset.Update
End Sub