mdiform.frm

一个vb+oracle的例子

  FilterIndex = CM1.FilterIndex
  
  Select Case FilterIndex
    
    Case 1:  '*.tab
      LayerInfo.Type = miLayerInfoTypeTab
      LayerInfo.AddParameter "FileSpec", filepath + filename
      LayerInfo.AddParameter "Name", LayerName
    
    Case 2:  'You must use Geotiff file.
'GeoTiff and Tiff:GeoTiff is a raster TIFF file that has stored the geographical coordinates
'of where it belongs on the earth.  A TIFF is a regular raster file that need to
'be registered in Mi Pro.
      LayerInfo.Type = miLayerInfoTypeRaster
      LayerInfo.AddParameter "FileSpec", filepath + filename
      LayerInfo.AddParameter "Name", LayerName
    
    Case 3:  '*.shp --- Failed
       
      'csys.PickCoordSys
      csys.Set 1, 0
      'Set Formmain.Map1.DisplayCoordSys = csys
      'Set Formmain.Map1.NumericCoordSys = csys
      'Formmain.Map1.NumericCoordSys.PickCoordSys
      'Formmain.Map1.DisplayCoordSys.PickCoordSys
      'Formmain.Map1.DisplayCoordSys.PickCoordSys
      LayerInfo.Type = miLayerInfoTypeShape
      LayerInfo.AddParameter "FileSpec", filepath + filename
      LayerInfo.AddParameter "CoordSys", csys
    
  End Select
  
  '将新建图层加入到数据集
  If Option_AddToDataset = True Then
     LayerInfo.AddParameter "AutoCreateDataset", 1
     LayerInfo.AddParameter "datasetname", LayerName
  End If
  
  Set lyr = Formmain.Map1.Layers.Add(LayerInfo, 1)
 
  
'  '将新建图层加入到数据字典
'  If Option_AddToGeoDict = True Then
'     LayerInfo.Type = miLayerInfoTypeGeodictUserName
'     LayerInfo.AddParameter "Name", LayerName
'     Formmain.Map1.Layers.Add LayerInfo
'  End If

    ChangeCombo
    
End Sub

Private Sub Option_Click()
    
    FormOptionLayer.Show 1

End Sub

Private Sub paste_Click()
    Dim lyr As MapXLib.layer
    Dim ftr As New MapXLib.Feature
    
    Set lyr = Formmain.Map1.Layers(ToolBars.Combo1.Text)
    For Each ftr In CopyFtrs
      lyr.AddFeature ftr
    Next
    
End Sub

Private Sub PointSelect_Click()
  Formmain.Map1.CurrentTool = miSelectTool
End Sub


Private Sub ProjectCoord_Click()
Dim csys As New MapXLib.CoordSys

    Set csys = Formmain.Map1.NumericCoordSys.PickCoordSys
    Set csys.Bounds = Formmain.Map1.Layers.Bounds
    Set Formmain.Map1.NumericCoordSys = csys

End Sub

Private Sub RDOType_Click()
    '用对象和控件两种方式实现
    '使用控件时,需在属性框填写Connect;DataSourceName;SQL三项.
    Dim bindlayer As New bindlayer
    
    bindlayer.LayerName = "us_cust3"
    bindlayer.LayerType = miBindLayerTypeXY
    bindlayer.RefColumn1 = "x"
    bindlayer.RefColumn2 = "y"
    
    Formmain.Map1.Datasets.Add miDataSetRDO, Formmain.MSRDC1.Resultset, "us_cust3", "company", , bindlayer
    
    ChangeCombo
    Set bindlayer = Nothing

End Sub

Private Sub RectSelect_Click()
  Formmain.Map1.CurrentTool = miRectSelectTool
End Sub

Private Sub regionstyle_Click()
    Formmain.Map1.DefaultStyle.PickRegion
End Sub

Private Sub rot_Click()
Dim ftr As New MapXLib.Feature
Dim lyr As MapXLib.layer
Dim t As Integer
Dim ftrs As New MapXLib.Features

Set lyr = Formmain.Map1.Layers.Item(1)
lyr.Selection.SelectAll 0
Set ftrs = lyr.NoFeatures
Set ftr = lyr.Selection.Item(1)
t = Val(InputBox("shuru", ""))
ftr.Style.TextFontRotation = t
ftr.Update
ftrs.Add ftr
End Sub

Private Sub SafeArrayType_Click()

Dim objBindLayer As New MapXLib.bindlayer
'Dim fldFieldsToAdd As New MapXLib.Fields
Dim bZipcodeLayer As Boolean
Dim zipdata(1 To 5, 1 To 5) As Variant

    zipdata(1, 1) = "12054"
    zipdata(1, 2) = 27391
    zipdata(1, 3) = "Jim"
    zipdata(1, 4) = -118.111
    zipdata(1, 5) = 33.82
 
    zipdata(2, 1) = "12304"
    zipdata(2, 2) = 38943
    zipdata(2, 3) = "John"
    zipdata(2, 4) = -104.86
    zipdata(2, 5) = 38.76
    
    zipdata(3, 1) = "12210"
    zipdata(3, 2) = 45663
    zipdata(3, 3) = "Tanya"
    zipdata(3, 4) = -107.07
    zipdata(3, 5) = 38.49
    
    zipdata(4, 1) = "12180"
    zipdata(4, 2) = 22447
    zipdata(4, 3) = "Carlene"
    zipdata(4, 4) = -71.79
    zipdata(4, 5) = 40.04
    
    zipdata(5, 1) = "12012"
    zipdata(5, 2) = 66152
    zipdata(5, 3) = "Jeff"
    zipdata(5, 4) = -111.89
    zipdata(5, 5) = 40.71
    
    'Create the fields collection to bring in
    '   fldFieldsToAdd.Add "Zip", "Zip", miAggregationIndividual, miTypeString
    '   fldFieldsToAdd.Add "Sales", "Sales", miAggregationSum, miTypeNumeric
    '   fldFieldsToAdd.Add "SalesRep", "SalesRep", miAggregationIndividual, miTypeString
   
    'Set up the BindLayerObject
    With objBindLayer
        .LayerName = "Zip Data1"                                'The name of the new layer
        .LayerType = miBindLayerTypeXY                   'Match up my data against a map layer
        .RefColumn1 = 4
        .RefColumn2 = 5
    End With
    
    'Add the dataset
    Formmain.Map1.Datasets.Add miDataSetSafeArray, zipdata, "Zip Data1", 1, , objBindLayer
    
    '出错原因:1.使用fldFieldsToAdd作为Add方法的Fields参数.
    '         2.用bindlayer时一定要设置GeoField参数.这里须设为列号.
    '错误用法: Formmain.Map1.Datasets.Add miDataSetSafeArray, zipdata, "Zip Data1", 1, , objBindLayer , fldFieldsToAdd
    
    ChangeCombo
    Set objBindLayer = Nothing
    
End Sub

Private Sub SaveGeoset_Click()
    
    Dim filepath As String
    Dim filename As String
    
    On Error Resume Next
        
    CM1.DialogTitle = "保存地图集"
    CM1.DefaultExt = "gst"
    CM1.Filter = "GeoSet(*.gst)|*.gst"
    CM1.CancelError = True
    CM1.Flags = &H2
    CM1.Action = 2
  
    If Err.Number = 32755 Then Exit Sub
  
    filename = CM1.FileTitle
    filepath = CM1.filename
    
    filename = Left(filename, InStr(filename, ".") - 1)
    
    Formmain.Map1.SaveMapAsGeoset filename, filepath
     
End Sub

Private Sub SelectAll_Click()
    Dim lyr As MapXLib.layer
    
    If Trim(ToolBars.Combo1.Text) <> "" Then
       Set lyr = Formmain.Map1.Layers.Item(ToolBars.Combo1.Text)
       lyr.Selection.SelectAll 0
    Else
       MsgBox "请先选择数据集.", , "错误提示"
    End If
        
    Set lyr = Nothing
End Sub

Private Sub SelectAnnotation_Click()
    Formmain.Map1.CurrentTool = miArrowTool
End Sub

Private Sub showctr_Click()
Dim layer As MapXLib.layer
For Each layer In Formmain.Map1.Layers
   layer.ShowCentroids = True
Next
End Sub

Private Sub SQLQuery_Click()
    FrmSQL.Show 1
End Sub

Private Sub ssa_Click()
  
  Dim queryodbc As New OdbcQueryInfo
  Dim bindlayer As New MapXLib.bindlayer
  
  Formmain.Map1.Layers.AddServerLayer "ssa", "DSN=Spatial;HOST=spw;UUID=mapzk;UPWD=mapzk;UID=mapzk;PWD=mapzk;OSID=map", "select * from ""sloil"""
  
  queryodbc.connectstring = "odbc;"
  queryodbc.DataSource = "spatial"
  queryodbc.SqlQuery = "select * from ""MAPZK"".""sloil2"""
  
  bindlayer.LayerType = miBindLayerTypePointRef
  bindlayer.RefColumn1 = "Jh"
  'bindlayer.RefColumn2 = "country"
  bindlayer.ReferenceLayer = "ssa"
  bindlayer.Filespec = "c:\sloil8.tab"
  
  
  Set ds = Formmain.Map1.Datasets.Add(miDataSetODBC, queryodbc, "oil", "sl", , bindlayer)
End Sub

Private Sub SymbolAnnotation_Click()
    Formmain.Map1.CurrentTool = miSymbolTool
End Sub

Private Sub symbolrotate_Click()
    Dim angle As Integer
    Dim ftr As New MapXLib.Feature
    
   angle = Val(InputBox("请输入旋转角度", "输入"))
      
            
     Set ftr = Formmain.Map1.Layers(ToolBars.Combo1.Text).Selection.Item(1)
     ftr.Style.SymbolType = miSymbolTypeTrueTypeFont
     ftr.Style.SymbolFont.name = "Map Symbols"
     ftr.Style.SymbolFont.Size = 48
     ftr.Style.SymbolCharacter = 66
     ftr.Style.SymbolFontRotation = angle
     Formmain.Map1.Layers(ToolBars.Combo1.Text).AddFeature ftr
     
     

End Sub

Private Sub symbolstyle_Click()
    Formmain.Map1.DefaultStyle.PickSymbol

End Sub

Private Sub TextAnnotation_Click()
    Formmain.Map1.CurrentTool = miTextTool
End Sub

Private Sub textstyle_Click()
    Formmain.Map1.DefaultStyle.PickText
End Sub

Private Sub UnboundType_Click()
Dim lyr As MapXLib.layer
Dim objBindLayer As New MapXLib.bindlayer
Dim fldFieldsToAdd As New MapXLib.Fields
Dim bZipcodeLayer As Boolean
Dim zipdata(10, 3) As String
    
    'zip code points layer
    'You may have to change the path, if you installed MapX somewhere else
    bZipcodeLayer = False
    For Each lyr In Map1.Layers
        If lyr.name = "US 5 Digit Zipcode Centers" Then
            bZipcodeLayer = True
            Exit For
        End If
    Next
    If bZipcodeLayer = False Then
        Set lyr = Map1.Layers.Add("ZipCodes.tab", 1)
        lyr.Visible = False
    End If
    
    'Set up an array of data
    'Each zipcode has a numeric field associated with it
    '(Zipcodes need to be string fields [for zips like 00123, if stored as a number, it would erase leading zeros and be '123']
    zipdata(1, 1) = "12054"
    zipdata(1, 2) = 27391
    zipdata(1, 3) = "Jim"
    
    zipdata(2, 1) = "12304"
    zipdata(2, 2) = 38943
    zipdata(2, 3) = "John"
    
    zipdata(3, 1) = "12210"
    zipdata(3, 2) = 45663
    zipdata(3, 3) = "Tanya"
    
    zipdata(4, 1) = "12180"
    zipdata(4, 2) = 22447
    zipdata(4, 3) = "Carlene"
    
    zipdata(5, 1) = "12012"
    zipdata(5, 2) = 66152
    zipdata(5, 3) = "Jeff"
    
    zipdata(6, 1) = "10116"
    zipdata(6, 2) = 444534
    zipdata(6, 3) = "Guy"
    
    zipdata(7, 1) = "22514"
    zipdata(7, 2) = 65690
    zipdata(7, 3) = "Christine"
    
    zipdata(8, 1) = "48109"
    zipdata(8, 2) = 45663
    zipdata(8, 3) = "Andy"
    
    zipdata(9, 1) = "92180"
    zipdata(9, 2) = 98454
    zipdata(9, 3) = "Brother"
    
    zipdata(10, 1) = "90210"
    zipdata(10, 2) = 58945
    zipdata(10, 3) = "Dick"
    
    'Create the fields collection to bring in
       fldFieldsToAdd.Add "Zip", "Zip", miAggregationIndividual, miTypeString
       fldFieldsToAdd.Add "Sales", "Sales", miAggregationSum, miTypeNumeric
       fldFieldsToAdd.Add "SalesRep", "SalesRep", miAggregationIndividual, miTypeString
    
    'Set up the BindLayerObject
    With objBindLayer
        .LayerName = "Zip Data"                                'The name of the new layer
        .LayerType = miBindLayerTypePointRef                   'Match up my data against a map layer
        .RefColumn1 = 1                                        'The column in my data that contains matchable field (zipcode)
        .ReferenceLayer = "US 5 Digit Zipcode Centers"         'The map layer to bind to
    End With
    
    'Add the dataset
    Map1.Datasets.Add miDataSetUnbound, Nothing, "Zip Data", "Zip", , objBindLayer, fldFieldsToAdd
    
    'Change the symbol style
    'Call ChangeSymbol(Map1.Layers("Zip Data"), "Courier", 88, 255, 22)
End Sub

Private Sub UnselectAll_Click()
    Dim lyr As MapXLib.layer
    
    If Trim(ToolBars.Combo1.Text) <> "" Then
       Set lyr = Formmain.Map1.Layers.Item(ToolBars.Combo1.Text)
       lyr.Selection.ClearSelection
    Else
       MsgBox "请先选择数据集.", , "错误提示"
    End If
        
    Set lyr = Nothing
    
End Sub