formmain.frm

vb+mapxvb+mo二次开发实现鹰眼功能

    
    Set lyr = FormMain.Map1.Layers(EditLayer)
    For Each ftr In CopyFtrs
        lyr.AddFeature ftr
    Next
    '注意:若要将属性数据一起拷贝过来，则必须加入rowvalues参数。
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 CloseGeoset_Click()
 FormMain.Map1.GeoSet = ""
    Call ChangeCombo
End Sub

Private Sub CloseTables_Click()
FrmCloseTable.Show 1
End Sub

Private Sub Form_Resize()
FormMain.Map1.Move Map1.Left, Map1.Top, ScaleWidth - Map1.Left, ScaleHeight - Map1.Top
End Sub

Private Sub mnuSaveAs_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
    
    FormMain.Map1.GeoSet = CM1.FileName
End Sub

Private Sub NewTable_Click()
 FrmNewTable.Show
End Sub

Private Sub OpenTable_Click()
  Dim FileName As String, filepath As String, LayerName As String
    Dim lyr As MapXLib.Layer
    Dim LayerInfo As New MapXLib.LayerInfo
    Dim FilterIndex As Integer
    Dim csys As New 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
        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 activeform.Map1.DisplayCoordSys = csys
            'Set activeform.Map1.NumericCoordSys = csys
            'activeform.Map1.NumericCoordSys.PickCoordSys
            'activeform.Map1.DisplayCoordSys.PickCoordSys
            'activeform.Map1.DisplayCoordSys.PickCoordSys
            LayerInfo.Type = miLayerInfoTypeShape
            LayerInfo.AddParameter "FileSpec", filepath + FileName
            LayerInfo.AddParameter "CoordSys", csys
    End Select
    '将新建图层加入到数据集
    LayerInfo.AddParameter "AutoCreateDataset", 1
    LayerInfo.AddParameter "DataSetName", LayerName
  
    Set lyr = FormMain.Map1.Layers.Add(LayerInfo, 1)
  
    Set FormMain.Map1.NumericCoordSys = FormMain.Map1.DisplayCoordSys
    'activeform.Map1.MapUnit = activeform.Map1.NumericCoordSys.Units
    Call ChangeCombo
End Sub

Private Sub ChangeCombo()
    Dim lyr As MapXLib.Layer
    Dim I As Integer, TmpStr As String
    
    I = 0
    For Each lyr In FormMain.Map1.Layers
         I = I + 1
        TmpStr = FormMain.Map1.Layers.Item(I).Name
        If (FormMain.Map1.Layers(TmpStr).Editable = True) Then
            Set EditLayer = lyr
            Exit For
        End If
    Next
End Sub
Private Sub OptionShowHideLegend_Click()
    Dim thm As New MapXLib.Theme
    Set ds = FormMain.Map1.DataSets(ThemeLayer)
    Set thm = ds.Themes.Item(1)
        
    thm.Visible = Not thm.Visible
End Sub

Private Sub OptionStatusBar_Click()
    OptionStatusBar.Checked = Not OptionStatusBar.Checked
    StatusBar1.Visible = OptionStatusBar.Checked
End Sub


Private Sub OptionsTool_Click()
    OptionsTool.Checked = Not OptionsTool.Checked
    Toolbar1.Visible = OptionsTool.Checked
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
    Dim cunit As Integer
    Dim UnitStr As String
    
    cunit = FormMain.Map1.DisplayCoordSys.Units
    
    cunit = FormMain.Map1.NumericCoordSys.Units
    FormMain.Map1.ConvertCoord X, Y, MX, MY, 1
    
    Select Case cunit
        Case 0
            UnitStr = "英里"
        Case 1
            UnitStr = "公里" 'miUnitKilometer = 1
        Case 2
            UnitStr = "英寸" 'miUnitInch = 2
        Case 3
            UnitStr = "英尺" 'miUnitFoot = 3
        Case 4
            UnitStr = "码" 'miUnitYard = 4
        Case 5
            UnitStr = "毫米" 'miUnitMillimeter = 5
        Case 6
            UnitStr = "厘米" 'miUnitCentimeter = 6
        Case 7
            UnitStr = "米" 'miUnitMeter = 7
        Case 8
            UnitStr = "US Survey Feet" 'miUnitSurveyFoot = 8
        Case 9
            UnitStr = "海里" 'miUnitNauticalMile = 9
        Case 10
            UnitStr = "缇" 'miUnitTwip = 10
        Case 11
            UnitStr = "点" 'miUnitPoint = 11
        Case 12
            UnitStr = "Pica" 'miUnitPica = 12
        Case 13
            UnitStr = "度" 'miUnitDegree = 13
        Case 30
            UnitStr = "令" 'miUnitLink = 30
        Case 31
            UnitStr = "链" 'miUnitChain = 31
        Case 32
            UnitStr = "竿" 'miUnitRod = 32
    End Select

   FormMain.StatusBar1.Panels.Item(1).Text = Format(MX, "###0.0000") + UnitStr + "," + Format(MY, "###0.0000") + UnitStr
    If (EditLayerName = "") Then
       FormMain.StatusBar1.Panels.Item(2).Text = "编辑:无"
    Else
        FormMain.StatusBar1.Panels.Item(2).Text = "编辑:" + EditLayerName
    End If
End Sub



Private Sub StatusBar1_Click()
    OptionStatusBar.Checked = Not OptionStatusBar.Checked
    StatusBar1.Visible = OptionStatusBar.Checked
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 pnt As New Point
Dim pnts As New MapXLib.Points
Dim ftrs As Features
Dim ftr As Feature
Dim lyr As Layer
Dim strinfo As String
Dim flds As MapXLib.Fields
Dim fld As MapXLib.Field
Dim ds As MapXLib.Dataset
Select Case ToolNum
Case infotool
   pnt.Set X1, Y1
   For Each lyr In FormMain.Map1.Layers
     Set ftrs = lyr.SearchAtPoint(pnt)
     If ftrs.Count > 0 Then
        strinfo = "layer name:" & lyr.Name & vbCrLf
        strinfo = strinfo & "feature name:" & ftrs.Item(1).Name & vbCrLf
        Set ds = FormMain.Map1.DataSets.Add(miDataSetLayer, lyr)
        For Each fld In ds.Fields
           strinfo = strinfo & fld.Name & ":"
          Set lyr.KeyField = fld
          strinfo = strinfo & ftrs.Item(1).KeyValue & vbCrLf
        Next
        MsgBox strinfo
        Exit For
        End If
        Next
        If ftrs.Count = 0 Then
        MsgBox "没有图元被选中"
        End If
        End Select

End Sub
Private Sub searchattibute_Click()
FormMain.Map1.CurrentTool = infotool
End Sub

Private Sub SqlQuery_Click()
FrmSQL.Show 1
End Sub

Private Sub tbarMain_ButtonClick(ByVal Button As ComctlLib.Button)
    
    On Error Resume Next
    
    Select Case Button.Key
        Case "ZoomIn"
            FormMain.Map1.CurrentTool = miZoomInTool
        Case "ZoomOut"
            FormMain.Map1.CurrentTool = miZoomOutTool
        Case "Move"
           FormMain.Map1.CurrentTool = miPanTool
        Case "Select"
            FormMain.Map1.CurrentTool = miSelectTool
        Case "SelectRect"
           FormMain.Map1.CurrentTool = miRectSelectTool
        Case "SelectCircle"
            FormMain.Map1.CurrentTool = miRadiusSelectTool
        Case "SelectPoly"
            FormMain.Map1.CurrentTool = miPolygonSelectTool
        Case "LayerControl"
           FormMain.Map1.Layers.LayersDlg
        Case "Symbol"
            Set FormMain.Map1.Layers.InsertionLayer = EditLayer
            FormMain.Map1.CurrentTool = miAddPointTool
        Case "Text"
            Set FormMain.Map1.Layers.InsertionLayer = EditLayer
            FormMain.Map1.CurrentTool = miTextTool
        Case "Label"
            FormMain.Map1.CurrentTool = miLabelTool
        Case "AddLine"
            Set FormMain.Map1.Layers.InsertionLayer = EditLayer
            FormMain.Map1.CurrentTool = miAddLineTool
        Case "AddPolyLine"
            Set FormMain.Map1.Layers.InsertionLayer = EditLayer
            FormMain.Map1.CurrentTool = miAddPolylineTool
        Case "AddArc"
            FormMain.Map1.CurrentTool = CreateArcTool
        Case "AddPolygon"
            Set FormMain.Map1.Layers.InsertionLayer = EditLayer
            FormMain.Map1.CurrentTool = miAddRegionTool
         Case "SymbolStyle"
            FormMain.Map1.DefaultStyle.PickSymbol
        Case "LineStyle"
            FormMain.Map1.DefaultStyle.PickLine
        Case "RegionStyle"
            FormMain.Map1.DefaultStyle.PickRegion
        Case "TextStyle"
            FormMain.Map1.DefaultStyle.PickText
    End Select
End Sub