frmrelation_gps.frm

用VB开发的巡检系统基于MAPINFo用VB开发的巡检系统基于MAPINFo很好的

Dim blSelectNode As Boolean '判断是否选定节点

Private Sub Check1_Click()
    Dim I As Integer
    If Check1.Value = 1 Then
        For I = 1 To Me.ListView1.ListItems.Count
            Me.ListView1.ListItems(I).Checked = True
        Next
    Else
        For I = 1 To Me.ListView1.ListItems.Count
            Me.ListView1.ListItems(I).Checked = False
        Next
    End If
End Sub

Private Sub Check2_Click()
    Dim I As Integer
    If Check2.Value = 1 Then
        For I = 1 To Me.ListView2.ListItems.Count
            Me.ListView2.ListItems(I).Checked = True
        Next
    Else
        For I = 1 To Me.ListView2.ListItems.Count
            Me.ListView2.ListItems(I).Checked = False
        Next
    End If
End Sub

Private Sub Combo1_Click()
    '加载巡检设备图层的资料
    Dim strSql As String
    Dim TableName As String
    Dim ItemCount As Long
    Me.Check2.Value = 0
    TableName = Combo1.Text
    If Len(TableName) = 0 Then Exit Sub
    ListView2.ListItems.Clear
    strSql = "select * from tbl_Equipment where TableName='" & TableName & "'"
    Set rs = Nothing
    rs.Open strSql, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
    Do Until rs.EOF
        ItemCount = ItemCount + 1
        ListView2.ListItems.Add , "T_" & CStr(ItemCount), ItemCount
        ListView2.ListItems(ItemCount).SubItems(1) = rs("TableName")
        ListView2.ListItems(ItemCount).SubItems(2) = rs("EquipmentID")
        ListView2.ListItems(ItemCount).SubItems(3) = rs("Name")
        ListView2.ListItems(ItemCount).SubItems(4) = rs("Center_X")
        ListView2.ListItems(ItemCount).SubItems(5) = rs("Center_Y")
        rs.MoveNext
    Loop
    rs.Close
    StatusBar1.Panels(2).Text = TableName & "   共提取的巡检设备为：" & ItemCount & " 个"
End Sub

Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Command3_Click()
    '移除绑定的巡检设备
    Dim sGpsID As String, sTableName As String, iRowID As Integer
    Dim I As Integer
    Dim strDelete As String
    On Error GoTo err_lab
    If Not blSelectNode Then Exit Sub
    If Me.ListView1.ListItems.Count = 0 Then Exit Sub
    sGpsID = Me.TreeView1.SelectedItem.Text
    For I = 1 To Me.ListView1.ListItems.Count
        If Me.ListView1.ListItems(I).Checked = True Then
            sTableName = Me.ListView1.ListItems(I).SubItems(1)
            iRowID = Val(Me.ListView1.ListItems(I).SubItems(2))
            strDelete = "delete from tbl_EquipmentToGPS where GPSID='" & sGpsID & "' and TableName='" & sTableName & "' and EquipmentID=" & iRowID
            gblCn.Execute strDelete
        End If
    Next
    '刷新设备
    LoadListItemData sGpsID
    Exit Sub
err_lab:
    MsgBox Err.Description, vbInformation, "提示"
End Sub

Private Sub Command4_Click()
    '追加绑定的巡检设备
    Dim sGpsID As String, sTableName As String, iEquipmentID As Integer
    Dim I As Integer
    Dim strSql As String
    On Error GoTo err_lab
    If Not blSelectNode Then
        MsgBox "没有选定GPS终端号，请检查！", vbInformation, "提示"
        Exit Sub
    End If
    If Me.ListView2.ListItems.Count = 0 Then Exit Sub
    sGpsID = Me.TreeView1.SelectedItem.Text
    For I = 1 To Me.ListView2.ListItems.Count
        If Me.ListView2.ListItems(I).Checked = True Then
            sTableName = Me.ListView2.ListItems(I).SubItems(1)
            iEquipmentID = Val(Me.ListView2.ListItems(I).SubItems(2))
            'sEquipmentName = Me.ListView2.ListItems(I).SubItems(3)
            
            Set rs = Nothing
            strSql = "select * from tbl_EquipmentToGPS where GPSID='" & sGpsID & "' and TableName='" & sTableName & "' and EquipmentID=" & iEquipmentID
            rs.Open strSql, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
            If rs.RecordCount > 0 Then
            
            Else
                rs.AddNew
                rs("GpsID").Value = sGpsID
                rs("TableName").Value = sTableName
                rs("EquipmentID").Value = iEquipmentID
                'rs("Name").Value = sEquipmentName
                rs.Update
            End If
            rs.Close
        End If
    Next
    '刷新设备
    LoadListItemData sGpsID
    Exit Sub
err_lab:
    MsgBox Err.Description, vbInformation, "提示"
End Sub

Private Sub Form_Load()
    lblReadme.Caption = "说明：" & vbCrLf & "1、追加或移除GPS终端号所绑定的巡检设备" _
            & "   " & "2、显示目前提取入库的巡检设备"
    
    InitListViewHeader
    InitTreeView
    
    '提取巡检目标图层
    Get_DestinationTableName Me.Combo1
End Sub

Private Sub Form_Resize()
    With Me
        .Picture1.Width = .ScaleWidth
        .lblLineTop.Width = .ScaleWidth
        .lblLineBottom.Width = .ScaleWidth
        .lblLineBottom.Top = .ScaleHeight - .StatusBar1.Height - 700
    End With
    
    TreeView1.Top = 1230
    Frame1.Top = 1200
    Frame2.Top = 1200
    
    
    ListView1.Top = Frame1.Top + Frame1.Height + 30
    ListView2.Top = Frame1.Top + Frame1.Height + 30
    
    ListView1.Left = 2010
    Frame1.Left = ListView1.Left
    
    Me.Command1.Top = Me.ScaleHeight - Me.StatusBar1.Height - 500
    Me.Command1.Left = Me.ScaleWidth - Me.Command1.Width - 500
    
    Me.TreeView1.Height = Me.lblLineBottom.Top - Me.lblLineTop.Top - 100
    Me.ListView1.Height = Me.TreeView1.Height - Me.Frame1.Height - 30

    ListView1.Width = (Me.ScaleWidth - ListView1.Left - 50 - 1050) / 2
    
    ListView2.Left = ListView1.Left + ListView1.Width + 50 + 1000
    ListView2.Width = ListView1.Width
    ListView2.Height = ListView1.Height
    
    Frame1.Width = ListView1.Width
    Frame2.Width = ListView2.Width
    Frame2.Left = ListView2.Left
    
    Me.Command4.Top = Me.ScaleHeight / 2
    Me.Command4.Left = ListView2.Left - 1000
    
    Me.Command3.Top = Me.Command4.Top + Me.Command4.Height + 100
    Me.Command3.Left = Me.Command4.Left
    
'    Me.Command2.Top = Me.Command3.Top + Me.Command3.Height + 100
'    Me.Command2.Left = Me.Command3.Left
    
    lblReadme.Top = Command1.Top
    
    Me.StatusBar1.Panels(1).Width = Me.ScaleWidth / 2
    Me.StatusBar1.Panels(2).AutoSize = sbrSpring
    
    Me.Check1.Left = Frame1.Width - Me.Check1.Width - 100
    Me.Check2.Left = Frame2.Width - Me.Check2.Width - 100
End Sub

Sub InitListViewHeader()
    With Me.ListView1
        .ColumnHeaders.Add , , "序号", 600
        .ColumnHeaders.Add , , "设备图层", 1400, 2
        .ColumnHeaders.Add , , "设备号", 800, 2
        .ColumnHeaders.Add , , "设备名称", 1000, 2
        .ColumnHeaders.Add , , "中心点(X)", 1000, 2
        .ColumnHeaders.Add , , "中心点(Y)", 1000, 2
    End With
    With Me.ListView2
        .ColumnHeaders.Add , , "序号", 600
        .ColumnHeaders.Add , , "设备图层", 1400, 2
        .ColumnHeaders.Add , , "设备号", 800, 2
        .ColumnHeaders.Add , , "设备名称", 1000, 2
        .ColumnHeaders.Add , , "中心点(X)", 1000, 2
        .ColumnHeaders.Add , , "中心点(Y)", 1000, 2
    End With
End Sub

'刷新部门
Public Sub InitTreeView()
    Dim nodeX As Node
    Dim strSql As String
    'On Error Resume Next
    TreeView1.Nodes.Clear
    TreeView1.ImageList = ImageList1
    TreeView1.Nodes.Add , , "ROOT", "GPS终端号列表", 1
    strSql = "select * from tbl_GPS order by GpsID asc"
    Set rs = Nothing
    rs.Open strSql, gblCn, adOpenForwardOnly, adLockOptimistic, adCmdText
    Do Until rs.EOF
        TreeView1.Nodes.Add "ROOT", tvwChild, CStr("N_" & rs("GpsID")), rs("GpsID"), 2
        rs.MoveNext
    Loop
    rs.Close
    TreeView1.Nodes(1).Expanded = True
End Sub




Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
    Dim curNode As String
    Me.Check1.Value = 0
    curNode = Node.Text
    Select Case Node.Key
        Case "ROOT"
            Me.StatusBar1.Panels(1).Text = ""
            blSelectNode = False
            Me.ListView1.ListItems.Clear
        Case Else
            blSelectNode = True
            Node.SelectedImage = 3
            LoadListItemData curNode
    End Select
End Sub

'刷新设备
Public Sub LoadListItemData(ByVal flag As String)
    Dim strSql As String
    Dim n As Integer
    Dim lstItem As ListItem
    Dim ItemCount As Integer
    On Error GoTo err_lab
    With Me
        .ListView1.ListItems.Clear
        Set rs = Nothing
        strSql = "select B.TableName,B.EquipmentID,B.name,B.Center_X,B.Center_Y from tbl_EquipmentToGPS as A,tbl_Equipment as B " _
            & " where A.TableName=B.TableName and A.EquipmentID=B.EquipmentID and A.GpsID='" & flag & "'"
        rs.Open strSql, gblCn, adOpenForwardOnly, adLockOptimistic, adCmdText
        n = rs.RecordCount
        Do Until rs.EOF
            ItemCount = ItemCount + 1
            .ListView1.ListItems.Add , "T_" & CStr(ItemCount), ItemCount
            .ListView1.ListItems(ItemCount).SubItems(1) = rs("TableName")
            .ListView1.ListItems(ItemCount).SubItems(2) = rs("EquipmentID")
            .ListView1.ListItems(ItemCount).SubItems(3) = IIf(IsNull(rs("name")), "", rs("name"))
            .ListView1.ListItems(ItemCount).SubItems(4) = rs("Center_X")
            .ListView1.ListItems(ItemCount).SubItems(5) = rs("Center_Y")
            rs.MoveNext
        Loop
        rs.Close
        .Label3.Caption = "GPS终端号(" & flag & ")已分配的巡检设备为 " & n & " 个"
    End With
    
    '查询GPS终端号的使用者编号和姓名
    Dim sUserID As String, sUserName As String, strMsg As String
    strSql = "select B.UserID,B.UserName from tbl_GPS as A,tbl_User as B where A.UserID=B.UserID and A.GpsID='" & flag & "'"
    rs.Open strSql, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
    If rs.RecordCount > 0 Then
        sUserID = rs("UserID")
        sUserName = rs("UserName")
        strMsg = "GPS终端号(" & flag & ")绑定的使用者编号为 " _
                & sUserID & "   使用者姓名为 " & sUserName
    Else
        strMsg = "GPS终端号(" & flag & ")未绑定给使用者"
    End If
    rs.Close
    Me.StatusBar1.Panels(1).Text = strMsg
    Exit Sub
err_lab:
    MsgBox Err.Description, vbInformation, "提示"
End Sub