frmgps.frm

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

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmGPS 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "GPS终端管理"
   ClientHeight    =   5550
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   8370
   Icon            =   "frmGPS.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5550
   ScaleWidth      =   8370
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox Picture1 
      BackColor       =   &H8000000E&
      BorderStyle     =   0  'None
      Height          =   855
      Left            =   0
      ScaleHeight     =   855
      ScaleWidth      =   8385
      TabIndex        =   7
      Top             =   0
      Width           =   8385
      Begin VB.Image Image1 
         Height          =   825
         Left            =   7440
         Picture         =   "frmGPS.frx":030A
         Stretch         =   -1  'True
         Top             =   30
         Width           =   465
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "主要实现GPS终端设备的基本资料管理。"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Left            =   270
         TabIndex        =   8
         Top             =   270
         Width           =   3675
      End
   End
   Begin VB.Frame Frame1 
      Height          =   645
      Left            =   30
      TabIndex        =   5
      Top             =   4890
      Width           =   8325
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "说明：删除操作表示对打钩号的记录进行删除；绑定刷新表示绑定使用者编号后进行刷新数据库操作。"
         Height          =   195
         Left            =   120
         TabIndex        =   6
         Top             =   240
         Width           =   8100
      End
   End
   Begin VB.CommandButton Command4 
      Caption         =   "绑定刷新(&R)"
      Height          =   405
      Left            =   6990
      TabIndex        =   4
      Top             =   3930
      Width           =   1215
   End
   Begin VB.CommandButton Command3 
      Caption         =   "删除(&D)"
      Height          =   405
      Left            =   6990
      TabIndex        =   3
      Top             =   3480
      Width           =   1215
   End
   Begin MSComctlLib.ListView ListView1 
      Height          =   4035
      Left            =   0
      TabIndex        =   2
      ToolTipText     =   "右键相应的记录可以进行绑定使用者编号"
      Top             =   870
      Width           =   6885
      _ExtentX        =   12144
      _ExtentY        =   7117
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      Checkboxes      =   -1  'True
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   4
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "  序号"
         Object.Width           =   1411
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Alignment       =   2
         SubItemIndex    =   1
         Text            =   "GPS终端号"
         Object.Width           =   3175
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Alignment       =   2
         SubItemIndex    =   2
         Text            =   "GPS终端名称"
         Object.Width           =   4410
      EndProperty
      BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Alignment       =   2
         SubItemIndex    =   3
         Text            =   "使用者编号"
         Object.Width           =   2470
      EndProperty
   End
   Begin VB.CommandButton Command2 
      Caption         =   "退出(&E)"
      Height          =   405
      Left            =   6990
      TabIndex        =   1
      Top             =   4470
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "新增(&N)"
      Height          =   405
      Left            =   6990
      TabIndex        =   0
      Top             =   3030
      Width           =   1215
   End
   Begin VB.Menu mnuFile 
      Caption         =   "file"
      Visible         =   0   'False
      Begin VB.Menu mnuFile_Select 
         Caption         =   "绑定使用者"
      End
      Begin VB.Menu mnuFile_sep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFile_UnSelect 
         Caption         =   "撤消使用者"
      End
   End
End
Attribute VB_Name = "frmGPS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs As New ADODB.Recordset

Dim lstItem As ListItem


Private Sub Command1_Click()
    frmGPS_new.Show 1
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Command3_Click()
    Dim I As Integer
    Dim strDelete As String
    Dim curGpsID As String
    Dim blIsCheck As Boolean
    If Me.ListView1.ListItems.Count = 0 Then Exit Sub
        For I = 1 To Me.ListView1.ListItems.Count
        If Me.ListView1.ListItems(I).Checked = True Then
            blIsCheck = True
            Exit For
        End If
    Next
    If Not blIsCheck Then
        MsgBox "没有选择要删除的GPS终端记录！", vbInformation, "提示"
        Exit Sub
    End If
    
    If MsgBox("是否真的删除打钩号的记录！", vbYesNo, "提示") = vbNo Then Exit Sub
    For I = 1 To Me.ListView1.ListItems.Count
        If Me.ListView1.ListItems(I).Checked = True Then
            curGpsID = Me.ListView1.ListItems(I).SubItems(1)
            '检测是否已经绑定设备
            Set rs = Nothing
            rs.Open "select * from tbl_EquipmentToGPS where GPSID='" & curGpsID & "'", gblCn, adOpenKeyset, adLockOptimistic, adCmdText
            If rs.RecordCount > 0 Then
                If MsgBox("此GPS终端已经绑定巡检设备，是否真的要删除所有关联的资料？", vbInformation + vbYesNo, "提示") = vbNo Then
                    rs.Close
                    Exit Sub
                End If
                strDelete = "delete from tbl_Gps where GpsID='" & curGpsID & "'"
                gblCn.Execute strDelete
            Else
                strDelete = "delete from tbl_Gps where GpsID='" & curGpsID & "'"
                gblCn.Execute strDelete
            End If
            rs.Close
        End If
    Next
    '重新刷新数据
    LoadListViewData
End Sub

Private Sub Command4_Click()
    '绑定刷新
    RefreshInfo
End Sub

Private Sub Form_Load()
    LoadListViewData
End Sub

'加载GPS终端信息
Public Sub LoadListViewData()
    Dim strSql As String
    Dim n As Integer
    Me.ListView1.ListItems.Clear
    Set rs = Nothing
    strSql = "select * from tbl_GPS order by GPSID asc"
    rs.Open strSql, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
    Do Until rs.EOF
        n = n + 1
        Me.ListView1.ListItems.Add , , n
        Me.ListView1.ListItems(n).SubItems(1) = IIf(IsNull(rs("GPSId")), "", rs("GPSId"))
        Me.ListView1.ListItems(n).SubItems(2) = IIf(IsNull(rs("GPSName")), "", rs("GPSName"))
        Me.ListView1.ListItems(n).SubItems(3) = IIf(IsNull(rs("userid")), "", rs("userid"))
        rs.MoveNext
    Loop
    rs.Close
End Sub

Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        If ListView1.ListItems.Count = 0 Then
            mnuFile_Select.Enabled = False
        Else
            mnuFile_Select.Enabled = True
        End If
        PopupMenu mnuFile
    End If
End Sub

Private Sub mnuFile_Select_Click()
    If Me.ListView1.ListItems.Count = 0 Then Exit Sub
    frmGPS_UserSelect.Top = (Screen.Height - frmGPS_UserSelect.Height) / 2
    frmGPS_UserSelect.Left = Me.Left + Me.Width
    frmGPS_UserSelect.mRow = Me.ListView1.SelectedItem.Index
    frmGPS_UserSelect.Show
End Sub

Private Sub mnuFile_UnSelect_Click()
    If Me.ListView1.ListItems.Count = 0 Then Exit Sub
    If Me.ListView1.SelectedItem.Index <> 0 Then
        Me.ListView1.SelectedItem.SubItems(3) = ""
        RefreshInfo
        'gblCn.Execute "update tbl_Gps set UserID='' where GpsID='" & Me.ListView1.SelectedItem.SubItems(1) & "'"
    End If
End Sub

'绑定刷新
Sub RefreshInfo()
    Dim strUpdate As String, sGpsID As String, sGPSName As String, sUserID As String
    Dim I As Integer
    On Error GoTo err_lab
    If Me.ListView1.ListItems.Count = 0 Then Exit Sub
'    gblCn.Execute "delete from tbl_Gps"
    For I = 1 To Me.ListView1.ListItems.Count
        sGpsID = Me.ListView1.ListItems(I).SubItems(1)
        sGPSName = Me.ListView1.ListItems(I).SubItems(2)
        sUserID = Me.ListView1.ListItems(I).SubItems(3)
        If Len(sUserID) > 0 Then
            'strUpdate = "insert into tbl_Gps values('" & sGPSID & "','" & sGpsName & "','" & sUserID & "')"
            strUpdate = "Update tbl_Gps set UserID='" & sUserID & "' where GpsID='" & sGpsID & "'"
            gblCn.Execute strUpdate
        Else
            strUpdate = "Update tbl_Gps set UserID='" & sUserID & "' where GpsID='" & sGpsID & "'"
            gblCn.Execute strUpdate
        End If
        
    Next
    'MsgBox "绑定刷新完毕！", vbInformation + vbOKOnly, "提示"
    LoadListViewData
    Exit Sub
err_lab:
    MsgBox Err.Description, vbCritical, "提示"
End Sub