frmr.frm

采用VB和MO二次开发的全国经济地理信息系统 内含开发全过程的详细文档

VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Begin VB.Form FrmR 
   Caption         =   "选择渲染数据"
   ClientHeight    =   5115
   ClientLeft      =   5715
   ClientTop       =   3045
   ClientWidth     =   6210
   LinkTopic       =   "Form1"
   ScaleHeight     =   5115
   ScaleWidth      =   6210
   Begin VB.CommandButton Command2 
      Caption         =   "确定"
      Height          =   495
      Left            =   3480
      TabIndex        =   1
      Top             =   4440
      Width           =   1575
   End
   Begin VB.ComboBox ComboADO 
      Height          =   300
      Left            =   120
      TabIndex        =   0
      Text            =   "请选择渲染数据"
      Top             =   4440
      Width           =   2655
   End
   Begin MapObjects2.Map Map1 
      Height          =   4335
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   6135
      _Version        =   131072
      _ExtentX        =   10821
      _ExtentY        =   7646
      _StockProps     =   225
      BackColor       =   16777215
      BorderStyle     =   1
      Contents        =   "FrmR.frx":0000
   End
End
Attribute VB_Name = "FrmR"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' 引用 ADO 2.5 对象库

Option Explicit

Dim pTable As New MapObjects2.Table '要关联的外部数据表
Dim pLyr As New MapObjects2.MapLayer    '要关联的图层
'Dim oCount As Integer   '字段数
Dim g_symSelection As MapObjects2.Symbol
Dim recSelection As MapObjects2.Recordset
Dim SQLStr As String
Dim rs As Recordset


Function ConnectToTable(connStr As String, SQLStr As String) As Boolean
'*******************************************************************
' 使用 OLE DB 驱动及 ADO 建立到外部数据表的联接
'*******************************************************************
    Dim pConn As New ADODB.Connection
    Dim pCommand As New ADODB.Command
    
    pConn.ConnectionString = connStr
    pConn.Mode = adModeRead '只读方式
    pConn.open  '打开联接.
    
    pCommand.ActiveConnection = pConn
    pCommand.CommandType = adCmdText
    pCommand.CommandText = SQLStr
    
    '设置数据表对象的 Command 属性
    Set pTable = New MapObjects2.Table
    Set pTable.Command = pCommand
    
    '检查是否联接成功
    Dim Recs As MapObjects2.Recordset
    Set Recs = pTable.Records
    If Recs Is Nothing Then
      ConnectToTable = False
    Else
      ConnectToTable = True
    End If
End Function
Sub ConnectToShapefile(databaseStr As String, lyrName As String)
'******************
' 加载图层
'******************
Dim dc As New MapObjects2.DataConnection
Dim gds As MapObjects2.GeoDataset

Set pLyr = New MapObjects2.MapLayer

dc.Database = databaseStr
Set gds = dc.FindGeoDataset(lyrName)
Set pLyr.GeoDataset = gds

Map1.Layers.Add pLyr

End Sub
Function DoAddRelate(lyrFldName As String, tblFldName As String) As Boolean
'*************************************
' 将外部数据表与图层关联
'*************************************
    DoAddRelate = pLyr.AddRelate(lyrFldName, pTable, tblFldName)
End Function


Private Sub ComboADO_Click()
                                                  '将图层与数据表关联
                                          ' 设置 ADO对象的属性： command 与 connection p
    Dim connStr As String
    
    connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\gis.mdb;"
    
   
    
    Select Case Me.ComboADO.ListIndex
        Case 0
            SQLStr = "Select * from [GDP]"
        Case 1
            SQLStr = "Select * from [第一产业增加值]"
        Case 2
            SQLStr = "Select * from [第二产业增加值]"
        Case 3
            SQLStr = "Select * from [第三产业增加值]"
        Case 4
            SQLStr = "Select * from [国内生产总值指数]"
        Case 5
            SQLStr = "Select * from [第一产业增加值指数]"
        Case 6
            SQLStr = "Select * from [第二产业增加值指数]"
        Case 7
            SQLStr = "Select * from [第三产业增加值指数]"
        Case 8
            SQLStr = "Select * from [年底总人口]"
       Case 9
            SQLStr = "Select * from [全部职工平均货币工资]"
       Case 10
            SQLStr = "Select * from [人均国内生产总值]"
       Case 11
            SQLStr = "Select * from [商品零售价格指数]"
            
     End Select
            

    '用于关联的关键字段
    Dim lyrFldName As String
    Dim tblFldName As String
    lyrFldName = "NAME"
    tblFldName = "地区"

    '联接与关联数据
    '通过ADO连接到数据表  (使用 SQL 语句)
    If ConnectToTable(connStr, SQLStr) Then
     '关联数据表与图层
         If DoAddRelate(lyrFldName, tblFldName) Then '将关联成功的图层导入到一个新图层中
                 MsgBox "返回的记录数: " & pLyr.Records.CalculateStatistics("FeatureID").Count
                pLyr.Records.Export App.Path & "\results.shp"
                
        Else
                MsgBox "关联数据表记录操作失败！"
        End If
    Else
        MsgBox "没有成功关联到数据表"
    End If
End Sub




Private Sub Command1_Click()
'创建索引
    If Not pLyr.BuildIndex(True) Then
      MsgBox "不能创建索引"
    Else
      MsgBox "索引已创建"
    End If
End Sub
Private Sub Command2_Click()
   
      Load FrmSubSea
       If Me.ComboADO.Text <> "请选择渲染数据" Then
            FrmRsub.Caption = Me.ComboADO.Text + "渲染"
            
       Else
            FrmRsub.Caption = "基础地理数据渲染"
            
        End If
    Load FrmRsub
      FrmRsub.show
      Unload FrmR
    
End Sub




Private Sub Form_Load()
                            '加入图层
    Dim Recs As New MapObjects2.Recordset
    ConnectToShapefile App.Path, "s省界prj"
    Set Recs = Map1.Layers(0).Records
    Map1.Layers.Item(0).Symbol.color = moGray
    
    
  '  oCount = recs.TableDesc.FieldCount
    
     With ComboADO
         .AddItem "GDP"
         .AddItem "第一产业增加值"
         .AddItem "第二产业增加值"
         .AddItem "第三产业增加值"
         .AddItem "国内生产总值指数"
         .AddItem "第一产业增加值指数"
         .AddItem "第二产业增加值指数"
         .AddItem "第三产业增加值指数"
         .AddItem "年底总人口"
         .AddItem "全部职工平均货币工资"
         .AddItem "人均国内生产总值"
         .AddItem "商品零售价格指数"
    End With
    
                           
   
   '
  ' Set up symbol for drawing selections.
  '
  Set g_symSelection = New MapObjects2.Symbol

  With g_symSelection
    .SymbolType = Map1.Layers(0).Symbol.SymbolType
    .color = moYellow
  End With
    
End Sub


Private Sub Map1_AfterLayerDraw(ByVal index As Integer, ByVal canceled As Boolean, ByVal hdc As stdole.OLE_HANDLE)
  If index > 0 Then Exit Sub
  If recSelection Is Nothing Then Exit Sub
  If Not recSelection.EOF Then
    Map1.DrawShape recSelection, g_symSelection
  End If
  Set recSelection = Nothing
End Sub

'Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 '   pLyr.FilterExpression = ""
  '  Map1.Refresh
'End Sub