frmreadequipmentdata.frm

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

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmReadEquipmentData 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "提取巡检目标信息或选择属性表"
   ClientHeight    =   4185
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5925
   Icon            =   "frmReadEquipmentData.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4185
   ScaleWidth      =   5925
   StartUpPosition =   2  '屏幕中心
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   345
      Left            =   0
      TabIndex        =   5
      Top             =   3840
      Width           =   5925
      _ExtentX        =   10451
      _ExtentY        =   609
      Style           =   1
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   1
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
      EndProperty
   End
   Begin VB.CommandButton cmdRead 
      Caption         =   "提取巡检目标"
      Height          =   405
      Left            =   4260
      TabIndex        =   4
      Top             =   2190
      Width           =   1455
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出(&E)"
      Height          =   405
      Left            =   4260
      TabIndex        =   3
      Top             =   3210
      Width           =   1455
   End
   Begin VB.CommandButton cmdView 
      Caption         =   "浏览属性表(&V)"
      Height          =   405
      Left            =   4260
      TabIndex        =   2
      Top             =   2670
      Width           =   1455
   End
   Begin VB.Frame Frame1 
      Caption         =   "[选择图层]"
      Height          =   3705
      Left            =   90
      TabIndex        =   0
      Top             =   90
      Width           =   4005
      Begin VB.ListBox List1 
         Height          =   3300
         Left            =   90
         TabIndex        =   1
         Top             =   270
         Width           =   3825
      End
   End
End
Attribute VB_Name = "frmReadEquipmentData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs As New ADODB.Recordset

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdRead_Click()
    '提取巡检目标信息
    Dim strDelete As String
    Dim TableName As String, iCols As Integer, iRows As Integer, I As Integer, j As Integer
    Dim sName As String
    Dim MultiN As Integer
    Dim mX As Single, mY As Single
    Dim strUpdate As String
    Dim obj_type As Integer
    
    Screen.MousePointer = 11
    TableName = Me.List1.Text
    
    
    ''#########################################刘登杰
    
    If TableName = "" Then
    Screen.MousePointer = 0
    MsgBox "请选择图层！", vbInformation + vbOKOnly, "提示"
    Exit Sub
    
    End If
    
     ''#########################################刘登杰
    
    
    
    '获取表的字段数
    iCols = Val(MapInfo.Eval("TableInfo(" & TableName & "," & TAB_INFO_NCOLS & ")"))
    
    '检测设备层是否存在字段名称：设备名称
    Dim blIsOK As Boolean
    For j = 1 To iCols
        If UCase$(MapInfo.Eval("ColumnInfo(""" & TableName & """,""col" & j & """,1)")) = UCase$("设备名称") Then
            blIsOK = True
            Exit For
        End If
    Next
    
   ''################刘登杰
    If Not blIsOK Then '设置为   没有设备字段的图层不可以提取信息
        Screen.MousePointer = 0
        If MsgBox("欲提取信息图层没有设备名称字段(设备名称)，请正确选择目标图层！", vbInformation + vbOKOnly, "提示") = vbOK Then Exit Sub
    End If
    
    ''################刘登杰
    
     '删除表中的记录
     
    strDelete = "delete * from tbl_Equipment where TableName='" & TableName & "'"
    
    gblCn.Execute strDelete '??????????有什么功能
    
    '紧压表
    MapInfo.Do "Pack Table " & TableName & " Graphic Data"
    
    '表记录数
    iRows = Val(MapInfo.Eval("TableInfo(" & TableName & "," & TAB_INFO_NROWS & ")"))
    
    '循环处理加入数据库中
    For I = 1 To iRows
        MapInfo.Do "Select * From " & TableName & " where RowID=" & I & " into Selection"
'        MultiN = Val(MapInfo.Eval("SelectionInfo(3)"))
        obj_type = MapInfo.Eval("ObjectInfo(" & TableName & ".obj," & OBJ_INFO_TYPE & ")")
        Select Case obj_type
            Case 2, 5, 7, 8, 9 'point,region
                mX = MapInfo.Eval("CentroidX(Selection.obj)")
                mY = MapInfo.Eval("CentroidY(Selection.obj)")
                
            Case 1, 3, 4 'line,polyline
                mX = MapInfo.Eval("ObjectNodeX(Selection.obj,1,1)")
                mY = MapInfo.Eval("ObjectNodeY(Selection.obj,1,1)")
        End Select
        
        '如果表存在字段（设备名称），则从表中提取记录的设备名称
        If blIsOK Then
           sName = MapInfo.Eval(TableName & ".设备名称")
        Else
           sName = ""
        End If
        '更新表的字段：设备号
        MapInfo.Do "Update " & TableName & " set 设备号=" & I & " where RowID=" & I
        
        '表名、RowID,EquipmentID,Name,CentroidX,CentroidY,EntityType,EntityName
        
        strUpdate = "Insert into tbl_Equipment values('" & TableName & "'," & I & "," & I & ",'" & sName & "'," _
           & mX & "," & mY & "," & obj_type & ",'" & Get_ObjectType(obj_type) & "')"
        
        
        gblCn.Execute strUpdate
        
    Next
    '保存表的更新
    SaveTable TableName
    
    '重新加载表名
    GetLayerName Me.List1
    
    Me.StatusBar1.SimpleText = Me.List1.Text & " 共提取目标 " & iRows & " 个"
    Screen.MousePointer = 0
    MsgBox "提取巡检目标数据完毕！", vbInformation + vbOKOnly, "提示"
End Sub

Private Sub cmdView_Click()
''#############刘登杰
Dim TableName As String

TableName = Me.List1.Text

    Load frmViewEquipmentInfo
    
    With frmViewEquipmentInfo
    
        If TableName = "" Then
        
            MsgBox "没有选定浏览表!", vbInformation, "提示"
            
            Exit Sub
            
        End If
        
        .StatusBar1.Panels(2).Text = Me.List1.Text
        
        '读取表的信息
        .ReadTableInfo
        .Show
    End With
    Unload Me
    
  ''#############刘登杰
    
End Sub

Private Sub Form_Load()
    '获取表名
    GetLayerName Me.List1
End Sub

Private Sub List1_Click()
    Me.StatusBar1.SimpleText = Me.List1.Text
End Sub