frmsetcj.frm

Visual Basic串口通信技术与典型实例

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmSetcj 
   Caption         =   "处警参数"
   ClientHeight    =   4935
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7065
   LinkTopic       =   "Form1"
   ScaleHeight     =   4935
   ScaleWidth      =   7065
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   4440
      TabIndex        =   6
      Top             =   3600
      Width           =   1215
   End
   Begin VB.CommandButton cmdLast 
      Caption         =   "上一步"
      Height          =   375
      Left            =   2760
      TabIndex        =   5
      Top             =   3600
      Width           =   1095
   End
   Begin VB.CommandButton cmdNext 
      Caption         =   "下一步"
      Height          =   375
      Left            =   960
      TabIndex        =   4
      Top             =   3600
      Width           =   1215
   End
   Begin VB.CommandButton cmdEdit 
      Caption         =   "修改"
      Height          =   375
      Left            =   4440
      TabIndex        =   3
      Top             =   2400
      Width           =   1095
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "删除"
      Height          =   375
      Left            =   2760
      TabIndex        =   2
      Top             =   2400
      Width           =   1095
   End
   Begin VB.CommandButton cmdAdd 
      Caption         =   "添加"
      Height          =   375
      Left            =   960
      TabIndex        =   1
      Top             =   2400
      Width           =   1215
   End
   Begin MSComctlLib.ListView ListView 
      Height          =   1695
      Left            =   600
      TabIndex        =   0
      Top             =   360
      Width           =   5655
      _ExtentX        =   9975
      _ExtentY        =   2990
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.Line Line1 
      X1              =   0
      X2              =   7080
      Y1              =   3000
      Y2              =   3000
   End
End
Attribute VB_Name = "frmSetcj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub cmdAdd_Click()
  frmcj.Caption = "添加处警"
  frmcj.Show vbModal
End Sub

Private Sub cmdCancel_Click()
   Unload Me
End Sub

Private Sub cmdDelete_Click()
  frmcj.Caption = "删除处警"
 '屏蔽frmcj上的textbox和optionbutton
  frmcj.Text1.Enabled = False
  frmcj.Text2.Enabled = False
  frmcj.Text3.Enabled = False
  frmcj.Text4.Enabled = False
  frmcj.Option1.Enabled = False
  frmcj.Option2.Enabled = False
  frmcj.Option3.Enabled = False
  frmcj.Option4.Enabled = False
  frmcj.Show vbModal
End Sub

Private Sub cmdEdit_Click()
  frmcj.Caption = "修改处警"
  frmcj.Show vbModal
End Sub

Private Sub cmdNext_Click()
   Me.Hide
   frmSetbj.Show vbModal
End Sub

Private Sub cmdLast_Click()
   Me.Hide
   frmSetbf.Show vbModal
End Sub

Private Sub Form_Load()
      Call makecolumns
      Call initcj
End Sub

Private Sub Form_Resize()
    Me.Height = frmSetbf.Height
    Me.Width = frmSetbf.Width
    Me.Left = frmSetbf.Left
    Me.Top = frmSetbf.Top
End Sub
'建表头
Private Sub makecolumns()
    ListView.View = lvwReport
    ListView.FullRowSelect = True
    ListView.ColumnHeaders.Clear
    ListView.ColumnHeaders.Add , , "处警名称", ListView.Width / 6
    ListView.ColumnHeaders.Add , , "端口属性", ListView.Width / 6
    ListView.ColumnHeaders.Add , , "端口编号", ListView.Width / 6
    ListView.ColumnHeaders.Add , , "动作类型", ListView.Width / 6
    ListView.ColumnHeaders.Add , , "信号发码", ListView.Width / 6
    ListView.ColumnHeaders.Add , , "电话号码", ListView.Width / 6
End Sub

Private Sub initcj()
Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
Dim str As String
    str = "select * from ChujingSet"
    rs.Open str, cn, adOpenDynamic, adLockOptimistic
    
    ListView.ListItems.Clear
    
    If addlistitem(rs) Then chkLine = 1
End Sub
'将打开的表r加入listview的item中，如果r不为空集的话，则返回true，反之为false
Private Function addlistitem(r As ADODB.Recordset) As Boolean
          If r.EOF Or r.BOF Then
                   addlistitem = False
                   Exit Function
          End If
     
               addlistitem = True
     
             r.MoveFirst
             
  While Not r.EOF And Not r.BOF
  Dim str1, str2, str3, str4, str5, str6 As String
     
           str1 = r!cjname
     
         If IsNull(str1) Then
               MsgBox ("此纪录无主键")
               Exit Function
         End If
         
         If IsNull(r!porperty) Then
                   str2 = "-"
         Else
                 str2 = r!porperty
         End If
     
         If IsNull(r!Number) Then
                 str3 = "-"
         Else
                 str3 = r!Number
         End If
     
         If IsNull(r!typeact) Then
                 str4 = "-"
         Else
                str4 = r!typeact
         End If
         
         If IsNull(r!infocode) Then
                str5 = "-"
         Else
               str5 = r!infocode
         End If
         
         If IsNull(r!telnumber) Then
                str6 = "-"
         Else
                str6 = r!telnumber
        End If
     
     Select Case str4
        Case "-"
            str5 = "-"
            str6 = "-"
        Case "拨号"
            str5 = "-"
        Case "发码"
            str6 = "-"
      End Select
     
     Set mLogItem = ListView.ListItems.Add(Text:=str1)
      mLogItem.ListSubItems.Add Text:=str2
      mLogItem.ListSubItems.Add Text:=str3
      mLogItem.ListSubItems.Add Text:=str4
      mLogItem.ListSubItems.Add Text:=str5
      mLogItem.ListSubItems.Add Text:=str6
      
      r.MoveNext
  Wend
      
      r.Close
End Function

Private Sub listView_ItemClick(ByVal Item As MSComctlLib.ListItem)
    chkLine = Item.index
End Sub