frmmain.frm

通过对空间数据的分析

    crColor.SetColorCOLORREF 255, RGB(255, 0, 0)
    crColor.GetColorLong iValue
    color.Add 0, iValue
    crColor.SetColorCOLORREF 255, RGB(0, 255, 0)
    crColor.GetColorLong iValue
    color.Add 1, iValue
    crColor.SetColorCOLORREF 255, RGB(0, 0, 255)
    crColor.GetColorLong iValue
    color.Add 2, iValue
    TGMAPX1.LayerIndexGet "雨量测站图点", iLayerIndex '数据图层
    TGMAPX1.LayerIndexGet "地级行政区矢量图面", iBorderIndex
    '以“省级行政区栅格图”为边界（边界图层矢量图，TopMap 把作为边界的图层中的
    '所有面实体组合成一个面实体），生成的等值面只截取范围在边界图层中的部分。
    TGMAPX1.FieldIndexGet iLayerIndex, "平均雨量一", iFieldIndex '平均雨量一
     '如果“雨量测站图”和边界图层都存在：
    If iLayerIndex >= 0 And iBorderIndex >= 0 Then
        '生成等值面图层，图层的索引号为iNewLayer
        iNewLayer = TGMAPX1.LayerCreateISOSurface("雨量面分布", iLayerIndex, _
            iBorderIndex, 0, ETGISOCreatFlagMQ, True, 4#, -1#, -1#, iFieldIndex, val, color)
        TGMAPX1.LayerIndexGet "雨量面分布", iNewLayer
        '如果图层创建成功：
        If iNewLayer >= 0 Then
            '使新建矢量面图层不可选择、不可编辑：
            TGMAPX1.LayerSet iNewLayer, ETGLayerSelectStatus, False
            TGMAPX1.LayerSet iNewLayer, ETGLayerEditStatus, False
            '使新图层置于次顶层（雨量点之下）：
            TGMAPX1.LayerSet iNewLayer, ETGLayerIndex, 1
            '“面积统计”按钮有效：
            cjdzxfb.Enabled = True
        End If
    End If
    TGMAPX1.DrawMap   '重新绘制地图
     '释放资源
    Set color = Nothing
    Set val = Nothing
    Set crColor = Nothing
End Sub

Private Sub cjmfb_Click()
   Dim dzm1, dzm2
   A = val(InputBox("请输入任意数1："))
   B = val(InputBox("请输入任意数2："))
   cjdzm A, B
End Sub

Private Sub dbxx_Click()
'多边形选
    TGMAPX1.ToolSet ETGToolPolySelect
End Sub

Private Sub dx_Click()
'设置鼠标为“点选”状态
    TGMAPX1.ToolSet ETGToolPointSelect
End Sub

Private Sub exit_Click()
End
End Sub

Private Sub fd_Click()
 '设置工具状态为"放大"
    TGMAPX1.ToolSet ETGToolZoomIn
End Sub

Private Sub gbtckz_Click()
'关闭显示图层
    If TGLayers1.Visible = True Then
         TGLayers1.Visible = False
         gbtckz.Caption = "显示图层控制"
    Else
         TGLayers1.Visible = True
         gbtckz.Caption = "关闭图层控制"
    End If
End Sub

Private Sub jlcl_Click()
 '获取轨迹距离
   TGMAPX1.ToolSet ETGToolGetDistance
End Sub

Private Sub jxkx_Click()
 '矩形框选
    TGMAPX1.ToolSet ETGToolRectSelect
End Sub



Private Sub micl_Click()
 '获取轨迹面积
    TGMAPX1.ToolSet ETGToolGetArea
End Sub

Private Sub mjtj_Click()
 '“面积统计”必须在创建面分布图层之后运行
    Dim iLayerIndex As Long
    TGMAPX1.LayerIndexGet "雨量面分布", iLayerIndex
    If iLayerIndex < 0 Then
        MsgBox "面分布没有形成，请首先点击“创建面分布图层”"
    Else '雨量面分布
        '求个区域面积
        Dim Count
        Dim dTotalArea As Double, dArea(3) As Double, dRatio(3) As Double
        Dim i As Long
        Dim value As Variant, strInformation As String
        dTotalArea = 0
        For i = 0 To 2
            'TGMAPX1.LayerStyleGet  iLayerIndex,
            TGMAPX1.FeatureAttribGet iLayerIndex, i, ETGFeatureArea, value
            dArea(i) = value
            dTotalArea = dTotalArea + dArea(i)
        Next
        For i = 0 To 1
            dRatio(i) = Int((dArea(i) / dTotalArea * 100000) / 100) / 10
        Next
        dRatio(2) = 100 - dRatio(0) - dRatio(1)
       
        strInformation = "面分布中:" & vbCr & vbCr & _
            "红色部分占总面积比例为: " & dRatio(0) & "%" & vbCr & _
            "黄色部分占总面积比例为: " & dRatio(1) & "%" & vbCr & _
            "绿色部分占总面积比例为: " & dRatio(2) & "%"
        MsgBox strInformation, vbInformation
       
    End If
End Sub

Private Sub my_Click()
 '设置工具状态为"漫游
    TGMAPX1.ToolSet ETGToolPan
End Sub

Private Sub open_Click()
'空字符串显示打开TopMap GIS地图工程对话框
TGMAPX1.MapLoad ""
End Sub




Private Sub qt_Click()
 '显示全图
    TGMAPX1.DrawMapFull
End Sub

Private Sub sx_Click()
'设置工具状态为"缩小"
    TGMAPX1.ToolSet ETGToolZoomOut
End Sub

Private Sub tckzq_Click()
'设置图层控制器
TGMAPX1.LayerCtrlDlg
End Sub

Private Sub yy_Click()
 '关闭显示鸟瞰图
    If TGBirdseye1.Visible = True Then
         TGBirdseye1.Visible = False
         yy.Caption = "显示鸟瞰图"
    Else
         TGBirdseye1.Visible = True
         yy.Caption = "关闭鸟瞰图"
    End If

   
End Sub

Private Sub zk_Click()
'置空工具状态
    TGMAPX1.ToolSet ETGToolNull
End Sub
Private Sub ClearLayers()
    '删除已经存在的等值线/面分布图及其图层, 如果图层在地图中已经存在或者存在相应的图层目录, 创建图层将失败
    Dim iLayerIndex As Long
    Dim strmappath As String
    
    '等值线图层:
    'LayerIndexGet是根据图层的名字获取图层在地图上的索引
    TGMAPX1.LayerIndexGet "雨量等值线", iLayerIndex
    If iLayerIndex >= 0 Then TGMAPX1.LayerDelete iLayerIndex  '如果图层已经存在，删除

    '面分布图层:
    TGMAPX1.LayerIndexGet "雨量面分布", iLayerIndex
    If iLayerIndex >= 0 Then TGMAPX1.LayerDelete iLayerIndex  '如果图层已经存在，删除
    
End Sub
Private Sub TGMAPX1_AfterTracingFeature(ByVal FeatureType As Long, ByVal DistanceOrPerimeter As Double, ByVal Area As Double)
   'AfterTracingFeature方法为当控件工具状态为"获取长度"、"获取面积"时，双击鼠标按键完成查询时发生
 
    Dim tool As emTools
    tool = TGMAPX1.ToolSet(-1) '操作类型返回值为原来类型的
    If tool = ETGToolGetDistance Then
       '当前工具状态为“取得轨迹距离”
        MsgBox "路线距离为：" & DistanceOrPerimeter
    ElseIf tool = emTools.ETGToolGetArea Then
        '当前工具状态为“取得轨迹面积”
        MsgBox "区域面积为：" & Area & vbCr & _
                "区域周长为：" & DistanceOrPerimeter
    End If
End Sub

Private Sub Form_Load()
    Dim X0 As Long
   Dim Y0 As Long
   '让窗体居中
   X0 = Screen.Width
   Y0 = Screen.Height
   X0 = (X0 - Me.Width) / 2
   Y0 = (Y0 - Me.Height) / 2
   Me.Move X0, Y0
   '显示鸟瞰图
   TGBirdseye1.MapSource = TGMAPX1
    TGBirdseye1.FeatureType = ETGFeatureTypePolygon + ETGFeatureTypePolyline
    TGLayers1.MapSource = TGMAPX1
    
    
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  If MsgBox("真的要退出本系统吗？", vbQuestion + vbYesNo + vbDefaultButton2, "退出") = vbNo Then
    Cancel = 1
  End If
End Sub