代码名称:在VB+Mapx5.0中新建图层及属性的源代码

作者/收集者:giseric

开发环境:VB + MapX

代码:

Private Sub Command1_Click()
 'this sample used the new AddField methods and the LayerInfo object to make a new tab
 'file.  for each record in the Us_Cust table (found in mapstats.mdb) it adds a point
 'feature to the new table.  for each feature added to the table, selected attribute
 'data from Us_Cust is associated with that point (the company name, order ammount, city
 'and state).
  Dim rs As DAO.Recordset
      Dim db As DAO.Database
     
      Dim flds As New MapXLib.Fields

      Dim lyrNew As MapXLib.Layer
      Dim ptNew As New MapXLib.Point
      Dim ftrNew As MapXLib.Feature
      Dim ff As MapXLib.FeatureFactory
      Dim li As New MapXLib.LayerInfo
      Dim rvs As New MapXLib.Rowvalues
      Dim ds As MapXLib.Dataset
     
      'make database connection and get a recordset
      Set db = DBEngine.OpenDatabase("C:\Program Files\MapInfo\MapX 5.0\data\mapstats.mdb")
      Set rs = db.OpenRecordset("US_Cust")
     
      'we'll use feature factory later

      Set ff = Map1.FeatureFactory
     
      'define the columnar structure of the new table we're going to create
      flds.AddStringField "Company", 50
      flds.AddStringField "City", 50
      flds.AddStringField "State", 2
      flds.AddNumericField "Order_Amt", 12, 2
 
      'define the LayerInfo object
      li.Type = miLayerInfoTypeNewTable
      li.AddParameter "FileSpec", App.Path & "\custtab.tab"
      li.AddParameter "Name", "mycustomers"
      li.AddParameter "Fields", flds

     
      'add the new layer to the top of the map
      Map1.Layers.Add li, 1
     
      'make a dataset from the new layer and get its Rowvalues collection
      Set lyrNew = Map1.Layers(1)
      Set ds = Map1.Datasets.Add(miDataSetLayer, lyrNew)
      Set rvs = ds.Rowvalues(0)
     
      'for each records in the Us_Cust table we'll make a point feature and add it
      'to the newly created layer.  Using the Rowvalues object from that layer's
      'dataset we'll supply attribute data for each point feature added

      rs.MoveFirst
     Do While Not rs.EOF
           rvs.Item("Company").value = rs.Fields("Company")
           rvs.Item("City").value = rs.Fields("City")
           rvs.Item("State").value = rs.Fields("State")
           rvs.Item("Order_Amt").value = rs.Fields("Order_Amt")
         
           ptNew.Set rs.Fields("X"), rs.Fields("Y")
           Set ftrNew = ff.CreateSymbol(ptNew)
           Set ftrNew = lyrNew.AddFeature(ftrNew, rvs)
        
           rs.MoveNext

      Loop
     
     'close database connection
      Set rs = Nothing
     Set db = Nothing
 End Sub