formmain.frm

一个vb+oracle的例子

    Unload ODBCLayer

End Sub

Private Sub Form_Resize()
    
      
    Map1.Width = Me.ScaleWidth
    Map1.Height = Me.ScaleHeight

End Sub

Private Sub Map1_DataMismatch(ByVal DataSetName As String, ByVal Row As Long, GeoFieldValue As String)
'MsgBox DataSetName + "," + Str(Row) + "," + GeoFieldValue
End Sub

Private Sub Map1_DragDrop(Source As Control, X As Single, Y As Single)
  MsgBox "dragdrop"
End Sub

Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    Dim MX As Double, MY As Double
    
    Formmain.Map1.ConvertCoord X, Y, MX, MY, 1
    MDIForm1.StatusBar1.Panels.Item(1).Text = Format(Str(MX), "#,##0.000000") + " , " + Format(Str(MY), "#,##0.000000")
    
End Sub

Private Sub Map1_PolyToolUsed(ByVal ToolNum As Integer, ByVal Flags As Long, ByVal Points As Object, ByVal bShift As Boolean, ByVal bCtrl As Boolean, EnableDefault As Boolean)
    
    Dim FtrFac As New MapXLib.FeatureFactory
    Dim ftr As New MapXLib.Feature
    Dim lyr As MapXLib.layer
    Dim i As Integer
        
    Set lyr = Map1.Layers(ToolBars.Combo1.Text)
    Set FtrFac = Map1.FeatureFactory
    ftr.Attach Map1
    Select Case Flags
        Case miPolyToolBegin
        Case miPolyToolInProgress
        Case miPolyToolEnd
          Select Case ToolNum
             Case CreatePolyLineTool
               Set ftr = FtrFac.CreateLine(Points, Map1.DefaultStyle)
                 
             Case CreatePolygonTool
               Set ftr = FtrFac.CreateRegion(Points, Map1.DefaultStyle)
          End Select
          lyr.AddFeature ftr
          Set ftr = Nothing
        Case miPolyToolEndEscaped
    End Select
               
       
End Sub

Private Sub Map1_RequestData(ByVal DataSetName As String, ByVal Row As Long, ByVal Field As Integer, Value As Variant, Done As Boolean)
'***********************************************************
'This is where the unbound data add actaully goes out and gets the data from the array
'***********************************************************
    'Make sure we have the correct dataset and that we are not trying to get too many records
    If DataSetName <> "Zip Data" Or Row > (UBound(zipdata)) Then
        Done = True
    Else
        Value = zipdata(Row, Field)
    End If

End Sub

Private Sub Map1_ResolveDataBind(ByVal Flag As Integer, ByVal NumMatches As Integer, ByVal Matches As Variant, Choice As Integer, Cancel As Boolean)
    
    MsgBox "flag" + Str(Flag)
    MsgBox "nummatch" + Str(NumMatches)
    For i = 1 To 2
      MsgBox Matches(i)
    Next
    MsgBox Str(Choice)
    
    
End Sub

Private Sub odbc_Click()
 
    
End Sub


Private Sub NewTable_Click()
   
   FormNewTable.Show 1
   MsgBox Str(Map1.Datasets.Count)
   
End Sub

Private Sub OpenGeoset_Click()
    Dim filepath As String
    Dim filename As String
    
    On Error Resume Next
    CM1.DialogTitle = "打开文件"
    CM1.DefaultExt = "GeoSet|*.gst"
    CM1.Filter = "GeoSet(*.gst)|*.gst"
    CM1.CancelError = True
    CM1.Action = 1
  
  If Err.Number = 32755 Then Exit Sub
    
  Map1.Geoset = CM1.filename
  
End Sub

Private Sub OpenTable_Click()

'LayerInfo 的Type 属性
'0 - .tab
'1 - User Draw
'2 - self-registering Raster
'3 - Shape
'4 - Server (remote database)
'5 - Geodictionary username
  
' Type 0:
'"FileSpec", Yes, String
'"Name", No, String
'ex: AddParameter("FileSpec", "c:\data\states.tab")
'AddParameter("Name", "MyStatesLayer")
'
'Type 1:
'"Name", Yes, String
'ex: AddParameter("Name", "MyUserDraw")
'
'Type 2:
'"FileSpec", Yes, String
'"Name", No, String
'ex: AddParameter("FileSpec", "c:\raster\rainfall.tif")
'
'Type 3:
'"FileSpec", Yes, String
'"Name", No, String
'"CoordSys", Yes, Object (mapxlib.coordsys; mapx.coordsys.4)
'"Style", No, Object (mapxlib.style; mapx.style.4)
'
'Type 4:
'"Name", Yes, String
'"ConnectString", Yes, String
'"Query", Yes, String
'LayerOptions , No, Numeric
'(Probably in the next Beta refresh, "ToolKit", Yes, String will be recognized to differentiate between ODBC and ORAINET i.e. OCI for Oracle 8i connectivity)
'ex: AddParameter("Name", "RDBMSStates")
'AddParameter("ConnectString", "DSN=MyODBCDataSource")
'AddParameter("Query", "SELECT * FROM STATES")
'AddParameter("ToolKit", "ODBC")
'
'Type 5:
'"Name", Yes, String
'ex: AddParameter("Name", "US Places")

  Dim filename As String
  Dim filepath As String
  Dim LayerName As String
  Dim lyr As MapXLib.layer
  Dim LayerInfo As New MapXLib.LayerInfo
  Dim FilterIndex As Integer
  Dim ftrs As New MapXLib.Features
  Dim csys As MapXLib.CoordSys
  
  On Error Resume Next
  
  CM1.DialogTitle = "打开文件"
  CM1.DefaultExt = "Tab|*.tab"
  CM1.Filter = "表(*.tab)|*.tab|GeoTiff file(*.tif)|*.tif|shapefile(*.tab)|*.tab|ServerLayer(spatialware)"
  CM1.CancelError = True
  CM1.Action = 1
  
  If Err.Number = 32755 Then Exit Sub
    
  filename = CM1.FileTitle
  filepath = CM1.filename
  filepath = Left(filepath, InStr(filepath, filename) - 1)
  LayerName = Left(filename, InStr(filename, ".") - 1)
 
  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.Set 3, 62, 7, -96, 23, 20, 60, , , 0, 0
      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
  
  Map1.Layers.Add LayerInfo
  'Map1.Layers.Add filepath + filename
  MsgBox Str(Map1.Datasets.Count)
  
  '将新建图层加入到数据字典
  If Option_AddToGeoDict = True Then
     LayerInfo.Type = miLayerInfoTypeGeodictUserName
     LayerInfo.AddParameter "Name", LayerName
     Map1.Layers.Add LayerInfo
  End If

End Sub

Private Sub Option_Click()
    FormOptionLayer.Show 1
End Sub

Private Sub project_Click()
   Map1.DisplayCoordSys.PickCoordSys
End Sub

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

Private Sub removelabel_Click()
  Dim lyr As MapXLib.layer
  
  'Clear the label
  For Each lyr In Map1.Layers
      lyr.AutoLabel = False
  Next
  
End Sub

Private Sub SaveTable_Click()
    Dim filepath As String
    Dim filename As String
    
    On Error Resume Next
    CM1.DialogTitle = "保存表文件"
    CM1.DefaultExt = "表文件|*.tab"
    CM1.Filter = "表文件(*.tab)|*.tab"
    CM1.CancelError = True
    CM1.Action = 2
  
    If Err.Number = 32755 Then Exit Sub
    
    Map1.Geoset = CM1.filename

End Sub

Private Sub ssa_Click()
  Dim lyr As layer
  Dim ds As MapXLib.Dataset
  Dim ftr As New MapXLib.Feature
  Dim bindlayer As New MapXLib.bindlayer
  
  Map1.Layers.AddServerLayer "ssa", "DSN=Spatial;HOST=spw;UUID=mapzk;UPWD=mapzk;UID=mapzk;PWD=mapzk;OSID=map", "select * from ""World"""
  Set lyr = Map1.Layers("ssa")
  'lyr.Selection.SelectAll 0
  'lyr.KeyField = "country"
 ' For Each ftr In lyr.Selection
 '     MsgBox ftr.KeyValue
      
 ' Next
  bindlayer.LayerType = miBindLayerTypePointRef
  bindlayer.RefColumn1 = country
  bindlayer.RefColumn2 = continent
  bindlayer.ReferenceLayer = "world"
  bindlayer.LayerName = "ssa"
  
  'Add the Sever layer to dataset -- failed.
  Set ds = Map1.Datasets.Add(miDataSetLayer, lyr, "ssa", "country") ', , bindlayer)
  
 MsgBox Str(ds.RowCount)
  
End Sub

Private Sub stylesample_Click()
Dim rect As New MapXLib.Rectangle
  
  
  ' picturebox's ScaleMode must be 'Pixel' for this code to work
  rect.Set 0, 0, PictureBox.ScaleWidth, PictureBox.ScaleHeight
  ' To draw a line sample:
  Map1.DefaultStyle.DrawLineSample PictureBox.hDC, rect
  ' To draw a region sample:
  Map1.DefaultStyle.DrawRegionSample PictureBox.hDC, rect
  ' To draw a symbol sample:
  Map1.DefaultStyle.DrawSymbolSample PictureBox.hDC, rect
  ' To draw a text sample:
  Map1.DefaultStyle.DrawTextSample PictureBox.hDC, rect, "The Quick Brown Cow"
  
  PictureBox.Refresh

End Sub

Private Sub symbolstyle_Click()
   Map1.DefaultStyle.PickSymbol
   
   'not Vector symbol support in MapX352
   
   'MsgBox Map1.DefaultStyle.MinVectorSymbolCharacter  'mapinfo compatible 3.0 -- Minimum Character value
   'MsgBox Map1.DefaultStyle.MaxVectorSymbolCharacter  'mapinfo compatible 3.0 -- Maximum Character value
   'MsgBox Map1.DefaultStyle.SymbolCharacter

End Sub

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

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
 Dim i As Integer
 
 Select Case Button.Index
    Case 1 ' Arrow
      Map1.CurrentTool = ToolConstants.miArrowTool
    Case 2 ' Zoom In
      Map1.CurrentTool = ToolConstants.miZoomInTool
      Map1.MousePointer = miCustomCursor
      'Map1.MouseIcon = "c:\windows\cursors\globe.ani"
     ' Map1.MouseIcon = "c:\windows\cursors\Help_1.cur"
    Case 3 ' Zoom Out
      Map1.CurrentTool = ToolConstants.miZoomOutTool
    Case 4 ' Pan
      Map1.CurrentTool = ToolConstants.miPanTool
    
  End Select
  For i = 1 To Toolbar1.Buttons.Count
    Toolbar1.Buttons(i).Value = 0
  Next
  Button.Value = 1
End Sub

Private Sub Map1_SelectionChanged()
    
    Dim lyr As MapXLib.layer
    Dim ds As New MapXLib.Dataset
    Dim ftr As New MapXLib.Feature
    Dim ftrs As New MapXLib.Features
    Dim TmpStr As String
    Dim i As Integer
    Dim findone As Boolean
    
    '当前地图窗口与浏览窗口的互动查询
    
    If BrowserFlag = True Then
        findone = False
    
        Set ds = Map1.Datasets(ToolBars.Combo1.Text)
        Set lyr = ds.layer
        For Each ftr In lyr.Selection
          s = ftr.FeatureKey
          For i = 1 To FrmBrowser.Grid1.Rows - 1
           If Trim(FrmBrowser.Grid1.TextArray((i + 1) * FrmBrowser.Grid1.Cols - 1)) = Trim(s) Then
              FrmBrowser.Grid1.TopRow = i
              FrmBrowser.Grid1.Row = i
              FrmBrowser.Grid1.Col = 0
              FrmBrowser.Grid1.RowSel = i
              FrmBrowser.Grid1.ColSel = FrmBrowser.Grid1.Cols - 1
              findone = True
           End If
          Next i
        Next
      
        If findone = False Then
         FrmBrowser.Grid1.Row = 0
         FrmBrowser.Grid1.Col = 0
         FrmBrowser.Grid1.RowSel = 0
         FrmBrowser.Grid1.ColSel = 0
        End If
      
     End If
    
End Sub

Private Sub Map1_ToolUsed(ByVal ToolNum As Integer, ByVal X1 As Double, ByVal Y1 As Double, ByVal X2 As Double, ByVal Y2 As Double, ByVal Distance As Double, ByVal Shift As Boolean, ByVal Ctrl As Boolean, EnableDefault As Boolean)
    
    Dim FtrFac As MapXLib.FeatureFactory
    Dim ftr As New MapXLib.Feature
    Dim Pnt As New Point
    Dim pnts As New Points
    Dim lyr As MapXLib.layer
    
    
    '创建点对象
    Pnt.Set X1, Y1
    '设置编辑层
    If Trim(ToolBars.Combo1.Text) <> "" Then
        Set lyr = Map1.Layers(Trim(ToolBars.Combo1.Text))
    Else
        Exit Sub
    End If
    
    Set FtrFac = Map1.FeatureFactory

    Select Case ToolNum
       
       Case CreateSymbolTool
        
        
         Set ftr = FtrFac.CreateSymbol(Pnt, Map1.DefaultStyle)
         
         lyr.AddFeature ftr
         Set lyr = Nothing
'
       Case CreateTextTool
         Set ftr = FtrFac.CreateText(Pnt, "text", miPositionTL, Map1.DefaultStyle)
         lyr.AddFeature ftr
         Set lyr = Nothing
         
       Case CreateLineTool
          pnts.Add Pnt, 1
          Pnt.Set X2, Y2
          pnts.Add Pnt, 2
          
          Set ftr = FtrFac.CreateLine(pnts, Map1.DefaultStyle)
          lyr.AddFeature ftr
          
       Case CreateArcTool
       
       Case CreateRectTool
       
       Case CreateRectRegionTool
       
       Case CreateCircleRegionTool
              
       Case CreateEllipseRegionTool
       
       Case MoveFeatures
           
                
              Map1.AutoRedraw = False
              xe = X2 - X1
              ye = Y2 - Y1
              For Each ftr In Map1.Layers(ToolBars.Combo1.Text).Selection
                ftr.Offset xe, ye
                ftr.Update
              Next
       
              Map1.AutoRedraw = True
              Map1.Refresh
       
              
    End Select
End Sub

Private Sub zoom_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then
     Map1.zoom = zoom.Text
 End If
End Sub