TabIndex        =   0
      Top             =   240
      Width           =   900
   End
End
Attribute VB_Name = "frmBufpara"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'布防參數變量
Private gbfname As String            '添加刪除編輯面板上記錄各屬性值
Private gbfcode As String
Private gporperty As String
Private gnum As String
Private gpm As Boolean
Private Sub cmdCancel_Click()
   Unload Me
End Sub

Private Sub cmdEnter_Click()
   Call getdata                    '從form上得到要寫進數據庫的數據
    
  
   '根據不同操作采取不同的action
  Select Case Me.Caption
      Case "刪除布防"
         If MsgBox("是否確實要刪除該條布防參數", vbYesNo, "詢問") = vbYes Then
             Call deleteBf
         End If
      Case "添加布防"
           If dataCheck() Then          '數據檢查并給以提示
                Call AddNew
              Else:
                 MsgBox ("事件編碼重復，請檢查")
           End If
      Case "編輯布防"
           If dataCheck() Then          '數據檢查并給以提示
                 Call editBf
              Else:
                 MsgBox ("事件編碼重復，請檢查")
           End If
  End Select
  
  Unload Me
End Sub

Private Sub Form_Load()
   Me.Top = (frmMain.Height - Me.Height) / 2
   Me.Left = (frmMain.Width - Me.Width) / 2
   '添加布防需要初始化參數
   If Me.Caption <> "添加布防" Then Call paraInit
   
End Sub
'參數初始化
Private Sub paraInit()
     
   If chkIndex = 0 Then Exit Sub    '如果沒有選中則不用進行表格內容寫入。
   '初始化參數bfname,bfcode,porperty,number
   gbfname = frmSetpara.lvwPara.ListItems(chkIndex).Text
   gbfcode = frmSetpara.lvwPara.ListItems(chkIndex).SubItems(1)
   gporperty = frmSetpara.lvwPara.ListItems(chkIndex).SubItems(2)
   gnum = frmSetpara.lvwPara.ListItems(chkIndex).SubItems(3)
   
   Select Case frmSetpara.lvwPara.ListItems(chkIndex).SubItems(4)
          Case "啟用"
                  gpm = True
          Case "禁用"
                  gpm = False
   End Select
   '將初始化完畢的參數返回到form上面
   Text1.Text = gbfname
   Text2.Text = gbfcode
   
   If gporperty = "串口" Then
      Option1.Value = True
      Option2.Value = False
   Else
      Option2.Value = True
      Option1.Value = False
   End If
   Text3.Text = gnum
   
   If gpm Then
          Option3.Value = True
          Option4.Value = False
   Else
         Option3.Value = False
         Option4.Value = True
   End If
End Sub
'新加一條記錄
Private Sub AddNew()
  On Error GoTo x
     Dim rs As ADODB.Recordset
        Set rs = New ADODB.Recordset
        rs.Open "select * from bufangset;", cn, adOpenDynamic, adLockOptimistic
       rs.AddNew
           rs!bfname = gbfname
           rs!bfcode = BintoDec(gbfcode)
           rs!porperty = gporperty
           rs!Number = gnum
           rs!promote = gpm
        rs.Update
        rs.Close
      
        '將list更新
      Dim mitem As ListItem
        Set mitem = frmSetpara.lvwPara.ListItems.Add(Text:=gbfname)
        If IsNull(gbfcode) Then
             mitem.SubItems(1) = "-"
        Else
              mitem.SubItems(1) = gbfcode
        End If
        
        If IsNull(gporperty) Then
              mitem.SubItems(2) = "-"
        Else
              mitem.SubItems(2) = gporperty
        End If
        
        If IsNull(gnum) Then
              mitem.SubItems(3) = "-"
        Else
              mitem.SubItems(3) = gnum
        End If
        
        If IsNull(gpm) Then
              mitem.SubItems(4) = "-"
        Else
           If gpm Then
                 mitem.SubItems(4) = "啟用"
           Else
                 mitem.SubItems(4) = "禁用"
           End If
        End If
       
      Exit Sub
x:
   MsgBox ("請再次檢查數據")
End Sub
'刪除一條記錄
Private Sub deleteBf()
  On Error GoTo x
     Dim rs As ADODB.Recordset
         Set rs = New ADODB.Recordset
     Dim str As String
         str = "select * from BufangSet where bfname = '" & gbfname & "';"
       rs.Open str, cn, adOpenDynamic, adLockOptimistic
    If rs.EOF Or rs.BOF Then
        MsgBox ("數據庫中沒有這條記錄")
        Exit Sub
    Else
        rs.Delete
        rs.Update
    End If
       rs.Close
   
   frmSetpara.lvwPara.ListItems.Remove chkIndex
   Exit Sub
   
x:
    MsgBox ("Error # " & CStr(Err.Number) & " was generated by " _
         & Err.Source & Chr(13) & Err.Description)
End Sub
'編輯一條紀錄
Private Sub editBf()
  On Error GoTo errordo
    Dim rs As ADODB.Recordset
       Set rs = New ADODB.Recordset
    Dim str As String
    Dim tempbfname As String
       tempbfname = frmSetpara.lvwPara.ListItems(chkIndex)
       str = "select * from BufangSet where bfname = '" & tempbfname & "';"
       rs.Open str, cn, adOpenDynamic, adLockOptimistic
            rs!bfname = gbfname
            rs!bfcode = BintoDec(gbfcode)
            rs!porperty = gporperty
            rs!Number = gnum
            rs!promote = gpm
        rs.Update
        rs.Close
    
    Dim itemx As ListItem
        Set itemx = frmSetpara.lvwPara.ListItems(chkIndex)
            itemx.Text = gbfname
            itemx.SubItems(1) = gbfcode
            itemx.SubItems(2) = gporperty
            itemx.SubItems(3) = gnum
    
         If gpm Then
               itemx.SubItems(4) = "啟用"
         Else
               itemx.SubItems(4) = "禁用"
         End If
     Exit Sub
     
errordo:
     MsgBox ("Error # " & CStr(Err.Number) & " was generated by " _
         & Err.Source & Chr(13) & Err.Description)
End Sub
'獲得數據從操作面板上
Private Sub getdata()
  gbfname = Trim$(Text1.Text)
  gbfcode = Trim$(Text2.Text)
 
  If Option1.Value Then
      gporperty = "串口"
  Else
      gporperty = "并口"
  End If
   gnum = Trim$(Text3.Text)
 
  If Option3.Value Then
      gpm = True
  Else
      gpm = False
  End If
End Sub
'數據檢查規則:事件編碼是否重復
Private Function dataCheck() As Boolean
Dim i As Integer
Dim itemx As ListItem
    
    For i = 1 To frmSetpara.lvwPara.ListItems.count
        Set itemx = frmSetpara.lvwPara.ListItems(i)
If (itemx.SubItems(1) = gbfcode) And (itemx.SubItems(2) = gporperty) And (itemx.SubItems(3) = gnum) Then
              dataCheck = False
              Exit Function
End If
    Next i
    dataCheck = True
    
End Function
'字符串是否為二進制的判斷
Private Function BinX(str As String) As Boolean
Dim i As Integer
Dim length As Integer
       length = Len(str)
     If length <= 8 Then
              BinX = True
     Else
          BinX = False
     End If
End Function

Private Sub Text1_Change()

End Sub

'事件編碼的鍵盤輸入限制條件:0 1
Private Sub Text2_KeyPress(KeyAscii As Integer)
   Select Case KeyAscii
          Case Asc(0), Asc(1)
             
          Case Else
             KeyAscii = 0
   End Select
End Sub

'觸發事件編碼判斷
Private Sub Text2_Validate(Cancel As Boolean)
    If Not BinX(Text2.Text) Then
          MsgBox ("觸發事件碼應為0,1代碼")
          Text2.Text = "0000"
    End If
End Sub

Private Sub Text3_Change()
    '判斷端口編號是否為數字
    If Not IsNumeric(Text3.Text) Then
               If Text3.Text <= 0 Then
                   Dim n As Integer
                    n = MsgBox("端口編號應該為十進制數", , 重要提示)
                    Text3.Text = "0"
               End If
    End If
    '如果端口編號是數字的話
    '再分別按照端口類型判斷
    'option1:串行端口
    If Option1.Value Then
             If CLng(Text3.Text) > 16 Then
                   MsgBox ("串口編號范圍在0-16之間")
                   Text3.Text = "0"
             End If
    End If
    'option2:并行端口
    If Option2.Value Then
             If CLng(Text3.Text) > 65536 Then
                   MsgBox ("并口編號范圍在0-65536之間")
                   Text3.Text = "0"
             End If
     End If
End Sub