frmmain.frm

通过对空间数据的分析

VERSION 5.00
Object = "{7050C1F5-2AD0-4857-9480-458BE223F568}#1.0#0"; "TGLayers.ocx"
Object = "{2704699B-9858-4640-8F41-69297C60A6A9}#1.0#0"; "TGMAPX.ocx"
Object = "{48AAD5DE-2BDA-4523-AC7E-2E46AC078D21}#1.0#0"; "TGBirdseye.ocx"
Begin VB.Form frmMain 
   Caption         =   "雨水量分布图"
   ClientHeight    =   8745
   ClientLeft      =   165
   ClientTop       =   855
   ClientWidth     =   9000
   LinkTopic       =   "Form1"
   ScaleHeight     =   8745
   ScaleWidth      =   9000
   StartUpPosition =   3  '窗口缺省
   WindowState     =   2  'Maximized
   Begin TGBirdseyeLib.TGBirdseye TGBirdseye1 
      Height          =   3255
      Left            =   0
      TabIndex        =   3
      Top             =   4680
      Width           =   2655
      _Version        =   65536
      _ExtentX        =   4683
      _ExtentY        =   5741
      _StockProps     =   0
   End
   Begin TGLAYERSLib.TGLayers TGLayers1 
      Height          =   4575
      Left            =   0
      TabIndex        =   2
      Top             =   120
      Width           =   2655
      _Version        =   65536
      _ExtentX        =   4683
      _ExtentY        =   8070
      _StockProps     =   0
   End
   Begin VB.Frame Frame1 
      Height          =   8775
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   16215
      Begin TGMAPXLib.TGMAPX TGMAPX1 
         Height          =   10815
         Left            =   960
         TabIndex        =   1
         Top             =   -480
         Width           =   18015
         _Version        =   65536
         _ExtentX        =   31776
         _ExtentY        =   19076
         _StockProps     =   0
      End
   End
   Begin VB.Menu file 
      Caption         =   "文件"
      Begin VB.Menu open 
         Caption         =   "打开"
      End
      Begin VB.Menu exit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu tools 
      Caption         =   "工具"
      Begin VB.Menu zk 
         Caption         =   "置空"
      End
      Begin VB.Menu fd 
         Caption         =   "放大"
      End
      Begin VB.Menu sx 
         Caption         =   "缩小"
      End
      Begin VB.Menu my 
         Caption         =   "漫游"
      End
      Begin VB.Menu qt 
         Caption         =   "全图"
      End
   End
   Begin VB.Menu tx 
      Caption         =   "图选"
      Begin VB.Menu dx 
         Caption         =   "点选"
      End
      Begin VB.Menu jxkx 
         Caption         =   "矩形框选"
      End
      Begin VB.Menu dbxx 
         Caption         =   "多边形选"
      End
   End
   Begin VB.Menu tc 
      Caption         =   "图层"
      Begin VB.Menu tckzq 
         Caption         =   "图层控制器"
      End
      Begin VB.Menu cjdzxfb 
         Caption         =   "创建等值线分布"
      End
      Begin VB.Menu cjmfb 
         Caption         =   "创建面分布"
      End
      Begin VB.Menu mjtj 
         Caption         =   "面积统计"
      End
   End
   Begin VB.Menu cl 
      Caption         =   "测量"
      Begin VB.Menu jlcl 
         Caption         =   "距离测量"
      End
      Begin VB.Menu micl 
         Caption         =   "面积测量"
      End
   End
   Begin VB.Menu view 
      Caption         =   "视图"
      Begin VB.Menu yy 
         Caption         =   "关闭鹰眼"
      End
      Begin VB.Menu gbtckz 
         Caption         =   "关闭图层控制"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
  Sub cjdzx(dzx1, dzx2, dzx3)
 '创建等值线图层
    '由特定图层的某字段动态创建等值线图层.由用户输入3个数值
     '等值线，以红、绿、蓝三种颜色表示：
    Dim iLayerIndex As Long, iNewLayer As Long, iBorderIndex As Long, iFieldIndex As Long
    Dim MapPath As Variant
    Dim color As New TGOValuesLong  'TGOValuesLong是整数集合对象，用于保存一个整数数组，用于需要传入整数数组的函数
    Dim val As New TGOValuesDouble  'TGOValuesDouble是实数集合对象，用于保存一个实数数组，用于需要传入或传出实数数组的函数。
    TGMAPX1.LayerIndexGet "雨量测站图", iLayerIndex '根据图层的名字获取图层在地图上的索引
    TGMAPX1.LayerSet iLayerIndex, ETGLayerVisibleStatus, False '设置图层属性,获取/设置图层是否可见,不可见
    
    '删除已经存在的等值线/面分布图及其图层, 如果图层在地图中已经存在或者存在相应的图层目录, 创建图层将失败
    Call ClearLayers
    
    '从点图层创建等值线图层:
    '自定义等值线大小：
    val.Add 0, dzx1
    val.Add 1, dzx2
    val.Add 2, dzx3
    '指定三个等值线的颜色:
    Dim crColor As New TGOColor  'TGOColor是颜色对象，用于设置或者获取颜色信息。
    Dim iValue As Long
    crColor.SetColorCOLORREF 255, RGB(255, 0, 0) '设置颜色的透明度为不透明、RGB值为红色
    crColor.GetColorLong iValue '获取颜色的RGB值
    color.Add 0, iValue
    crColor.SetColorCOLORREF 255, RGB(0, 255, 0) '设置颜色的透明度为不透明、RGB值为绿色
    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
    '以“地级行政区矢量图”为边界（边界图层矢量图）
    '把作为边界的图层中的所有面实体组合成一个面实体，生成的等值线只截取在边界图层范围内的部分
    '进行分析的字段：
    TGMAPX1.FieldIndexGet iLayerIndex, "平均雨量一", iFieldIndex '平均雨量一
    
    '如果“雨量测站图”和边界图层都存在：
    If iLayerIndex >= 0 And iBorderIndex >= 0 Then
        '生成等值线图层，图层的索引号为iNewLayer
        'LayerCreateISOLine是从点层及其数据形成等值线的函数
        'ETGISOCreatFlagMQ是多面函数算法
        TGMAPX1.LayerCreateISOLine "雨量等值线", 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 'ETGLayerIndex表示设置图层位置

        End If
    End If
    TGMAPX1.DrawMap  '重新绘制地图
    '释放资源
    Set color = Nothing
    Set val = Nothing
    Set crColor = Nothing
End Sub

Private Sub cjdzxfb_Click()
    Dim dzx1, dzx2, dzx3
    A = val(InputBox("请输入任意数1："))
    B = val(InputBox("请输入任意数2："))
    C = val(InputBox("请输入任意数3："))
    cjdzx A, B, C
End Sub

    Sub cjdzm(dzm1, dzm2)
    
    '由特定图层的某字段动态创建矢量面分布图层.
    '由用户输入3个数值, 分别以红、黄、绿三种颜色表示：
    Dim iLayerIndex As Long, iNewLayer As Long, iBorderIndex As Long, iFieldIndex As Long
    Dim MapPath As Variant
    Dim color As New TGOValuesLong
    Dim val As New TGOValuesDouble
    
    '删除已经存在的等值线/面分布图及其图层, 如果图层在地图中已经存在或者存在相应的图层目录, 创建图层将失败
    Call ClearLayers
    
    '从点图层创建面分布图层:
    '在建立的新图层中，小于dVals(0)值的为第0个实体，大于dVals(0) 且 小于dVals(1)的为第1个实体，
    '大于dVals(1)的为第3个实体
    val.Add 0, dzm1
    val.Add 1, dzm2
    '指定三个面的颜色:
    Dim crColor As New TGOColor
    Dim iValue As Long