form1.frm

mapgis二次开发,vb示例 mapgis二次开发,vb示例

VERSION 5.00
Object = "{5A187E03-1FE4-11D3-9C2F-000021DF30C1}#1.0#0"; "EditView.ocx"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5220
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   6255
   LinkTopic       =   "Form1"
   ScaleHeight     =   5220
   ScaleWidth      =   6255
   StartUpPosition =   3  'Windows Default
   Begin EDITVIEWLib.EditView EditView1 
      Height          =   3855
      Left            =   600
      TabIndex        =   0
      Top             =   720
      Width           =   5055
      _Version        =   65536
      _ExtentX        =   8916
      _ExtentY        =   6800
      _StockProps     =   0
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件"
      Begin VB.Menu mnuFileOpen 
         Caption         =   "打开三角剖份文件..."
      End
      Begin VB.Menu mnuFileOpenPnt 
         Caption         =   "打开点文件..."
      End
      Begin VB.Menu mnuFileOpenLin 
         Caption         =   "打开线文件..."
      End
   End
   Begin VB.Menu mnuApp 
      Caption         =   "应用"
      Begin VB.Menu mnuTestInfo 
         Caption         =   "浏览工作区信息"
      End
      Begin VB.Menu mnuGrdIns 
         Caption         =   "任意点的高程值查询"
      End
      Begin VB.Menu mnuAppDtmParam 
         Caption         =   "规则网某点高程、坡度和坡向查询"
      End
      Begin VB.Menu mnuAppTin 
         Caption         =   "点属性数据生成三角网"
      End
      Begin VB.Menu mnuAppGrid 
         Caption         =   "等高线数据栅格化"
      End
      Begin VB.Menu mnuGrdDist 
         Caption         =   "离散点距离幂反比加权网格化"
      End
      Begin VB.Menu mnuGrdASc 
         Caption         =   "高程ASCII数据文件并网格化"
      End
      Begin VB.Menu mnuTraceTin 
         Caption         =   "三角网数据等值线追踪"
      End
      Begin VB.Menu mnuTraceGrd 
         Caption         =   "规则网数据等值线追踪"
      End
      Begin VB.Menu mnuGrd3dEquGra 
         Caption         =   "三维等值立体图绘制"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'===================================================================================================
'主要功能:
'       本例主要演示了DTM分析的一些功能,包括等值线的追踪,三维立体图的绘制等.
'
'
'===================================================================================================



Dim iTinLayer As New MAPGISTINCOMLib.TinLayer
Dim iTinArea As MAPGISTINCOMLib.TinArea
Dim iLin As New LinArea
Dim iPnt As New PntArea
Dim demInfo As New DemInfoStru
Public DspMyDraw As Integer
Dim res As Boolean

Private Sub EditView1_MyDraw(ByVal MpDC As Object)
Dim mdc As MapGisDC
Select Case DspMyDraw
   Case 0:
      Exit Sub
   Case 1:
      If iLin.Empty Then
          MsgBox "未打开线文件"
          Exit Sub
      Else
          Set mdc = MpDC
          mdc.DispArea iLin
      End If
   Case 2:
      Set mdc = MpDC
      iTinLayer.Display mdc
   Case 3:
      If iPnt.Empty Then
          MsgBox "未打开点文件"
          Exit Sub
      Else
          Set mdc = MpDC
          mdc.DispArea iPnt
      End If
   Case Else:
      MsgBox "非法的类型！"
      Exit Sub
End Select
Set mdc = Nothing
End Sub

Private Sub Form_Resize()
EditView1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set iTinLayer = Nothing
Set iLin = Nothing
Set iPnt = Nothing
Set demInfo = Nothing
 Set iTinArea = Nothing
End Sub

Private Sub mnuFileOpen_Click()
Set iTinArea = iTinLayer.TinArea
res = iTinArea.LoadFile()
If res = False Then
   MsgBox "打开高程文件失败!"
   Exit Sub
End If

Dim rect As D_Rect
Set rect = iTinArea.rect
EditView1.SetWinMapRange rect.xmin, rect.ymin, rect.xmax, rect.ymax
EditView1.RestoreWindow
DspMyDraw = 2
End Sub

Private Sub mnuFileOpenLin_Click()
res = iLin.Load()
If res = False Then
   MsgBox "打开线文件失败!"
   Exit Sub
End If
EditView1.SetWinMapRange iLin.rect.xmin, iLin.rect.ymin, iLin.rect.xmax, iLin.rect.ymax
EditView1.RestoreWindow
DspMyDraw = 1
End Sub

Private Sub mnuFileOpenPnt_Click()
res = iPnt.Load()
If res = False Then
   MsgBox "打开点文件失败!"
   Exit Sub
End If
Set iTinArea = iTinLayer.TinArea
DspMyDraw = 3
EditView1.SetWinMapRange iPnt.rect.xmin, iPnt.rect.ymin, iPnt.rect.xmax, iPnt.rect.ymax
EditView1.RestoreWindow
End Sub
'******************************************************************
'***********************获取高程工作区信息****************************
'******************************************************************
Private Sub mnuTestInfo_Click()
Set iTinArea = iTinLayer.TinArea
res = iTinArea.LoadFile()
If res = False Then
   MsgBox "打开高程文件失败!"
   Exit Sub
End If
iTinArea.GetGridTinDatHdInfo demInfo '高程工作区信息在对象demInfo中
iTinArea.ViewTinDatInfo '在对话框中显示高程工作区信息
Set iTinArea = Nothing
End Sub

'******************************************************************
'*****************取已知规则网中当前点的插密高程值*******************
'******************************************************************
Private Sub mnuGrdIns_Click()
Dim insObj As DemInsObj
Set iTinArea = iTinLayer.TinArea
res = iTinArea.LoadFile()
If res = False Then
   MsgBox "打开高程文件失败!"
   Exit Sub
End If
If Not iTinArea.IsGridNet Then
   MsgBox "打开文件不是规则网文件"
   Exit Sub
End If
iTinArea.GetGridTinDatHdInfo demInfo '高程工作区信息在对象demInfo中
Dim PtDemDat
Dim zVal As Double
Dim iTinModel As TinModel
Dim iGrdModel As GridModel
Set iTinModel = iTinArea
Set iGrdModel = iTinArea
'获取规则网所有点的高程值信息
iTinModel.GetAllTinPntDat PtDemDat
'获取规则网格插密对象
Set insObj = iGrdModel.GetDemInsOBJ(demInfo, PtDemDat, gis_4PIN)
zVal = iGrdModel.GetCurPntDemVal(insObj, 8.04, -20#) '获取高程值,后两个数据是当前点的xy值
Set demInfo = Nothing
Set PtDemDat = Nothing
Set iTinArea = Nothing
Set iTinModel = Nothing
Set iAppModel = Nothing
End Sub
'******************************************************************
'*********获取规则网表面模型数据中指定单点的高程、坡度、坡向**********
'******************************************************************
Private Sub mnuAppDtmParam_Click()
Set iTinArea = iTinLayer.TinArea
res = iTinArea.LoadFile()
If res = False Then
   MsgBox "打开高程文件失败!"
   Exit Sub
End If
If Not iTinArea.IsGridNet Then
   MsgBox "打开文件不是规则网文件"
   Exit Sub
End If
Dim demInfo1 As DemInfoStru
iTinArea.GetGridTinDatHdInfo demInfo1 '高程工作区信息在对象demInfo中
Dim PtDemDat
Dim iTinModel As TinModel
Dim iAppModel As AppModel
Set iTinModel = iTinArea
Set iAppModel = iTinArea
iTinModel.GetAllTinPntDat PtDemDat '获取规则网所有点的高程值信息
Dim lNo As New L_Dot
Dim dtmParm As D_3Dot
'存放指定点索引下标
lNo.x = 0
lNo.y = 0
iAppModel.GetPntDtmParamInGrd demInfo1, PtDemDat, lNo, dtmParm '指定单点的高程、坡度、坡向存放在dtmParm中
Set demInfo = Nothing
Set iTinModel = Nothing
Set iAppModel = Nothing
Set iTinArea = Nothing
End Sub

'******************************************************************
'*********************等高线数据栅格化******************************
'******************************************************************
Private Sub mnuAppGrid_Click()
demInfo.nx = 61       '网格化后的横纵分辨率
demInfo.ny = 50
demInfo.xmax = 605    '需要网格化的x值范围
demInfo.xmin = 9
demInfo.ymax = 467    '需要网格化的y值范围
demInfo.ymin = -20
demInfo.zmax = 10     '网格间距
demInfo.zmin = 10
Const fileName = "1.grd"  '网格化后的文件名
Dim iGrd As GridModel
Set iTinArea = iTinLayer.TinArea
Set iGrd = iTinArea
'第一个参数1表示等高线的高程属性域号
iLin.Load
If iLin.Empty Then
   MsgBox "未打开线文件"
Else
   iGrd.ContourLinPntGriding demInfo, , , , iLin, 0, , , , , 1, , fileName
End If
Set demInfo = Nothing
Set iTinArea = Nothing
Set iGrd = Nothing
Set iLin = Nothing
End Sub

'******************************************************************
'*************************点数据三角化******************************
'******************************************************************
Private Sub mnuAppTin_Click()
res = iPnt.Load()
If res = False Then
   MsgBox "打开点文件失败!"
   Exit Sub
End If
Set iTinArea = iTinLayer.TinArea
Dim iTin As TinModel
Set iTin = iTinArea
If Not iTinArea.Empty Then
    MsgBox "高程工作区不空!"
   Exit Sub
Else
    iTin.CreateDelaunayTin , iPnt, 0, , , , , , , 1, 1
End If
iTinArea.SaveFile
Set iTinArea = Nothing
Set iTin = Nothing
Set iPnt = Nothing
End Sub
'******************************************************************
'***************离散点距离幂反比加权网格化处理过程*******************
'******************************************************************
Private Sub mnuGrdDist_Click()
Set iTinArea = iTinLayer.TinArea
res = iTinArea.LoadFile()
If res = False Then
   MsgBox "打开高程文件失败!"
   Exit Sub
End If
If iTinArea.IsGridNet Then
   MsgBox "不是离散点文件"
   Exit Sub
End If
Dim iTinModel As TinModel
Dim iGrdModel As GridModel
Dim count As Long
Dim i As Long
Dim XYZPtr
Dim tmpXPtr() As Double
Dim tmpYPtr() As Double
Dim tmpZPtr() As Double
Dim TinPntSet As TinPntSet
Dim TinPnt As TinPnt
Set iTinModel = iTinArea
Set iGrdModel = iTinArea
'获取非规则网的点信息(X,Y,Z的值)
Set TinPntSet = iTinModel.GetAllTinPntDat1()
count = TinPntSet.count
ReDim tmpXPtr(count - 1) As Double
ReDim tmpYPtr(count - 1) As Double
ReDim tmpZPtr(count - 1) As Double
'把所有点的x,y,z的值放入三个数组中
For i = 0 To count - 1
    Set TinPnt = TinPntSet.GetItem(i)
    tmpXPtr(i) = TinPnt.fDemX
    tmpYPtr(i) = TinPnt.fDemY
    tmpZPtr(i) = TinPnt.fDemZ
Next i
'设置网格化参数
demInfo.nx = 60       '网格化后的横纵分辨率
demInfo.ny = 49
demInfo.xmax = 605    '需要网格化的x值范围
demInfo.xmin = 9
demInfo.ymax = 467    '需要网格化的y值范围
demInfo.ymin = -20
demInfo.zmax = 10     '网格间距
demInfo.zmin = 10
'设置网格化离散数据搜索参数
Dim search As New SearchDataStru
iGrdModel.EditDotSearchParam 11, count, search
'设置网格化离散数据搜索参数
Dim dist As New DistPowGridStru
iGrdModel.EditDistInsParam dist
'网格化
iGrdModel.DistInsGridingToBuf tmpXPtr, tmpYPtr, tmpZPtr, count, demInfo, search, dist, XYZPtr '网格化后数据存放在数组XYZPtr中
iGrdModel.DistInsGriding tmpXPtr, tmpYPtr, tmpZPtr, count, demInfo, search, dist, "2.grd" '网格化后数据存放在文件2.grd中

Set demInfo = Nothing
Set search = Nothing
Set dist = Nothing
Set iTinArea = Nothing
Set iTinModel = Nothing
Set iAppModel = Nothing
End Sub

'*******************************************************************
'*********************高程ASCII数据文件并网格化**********************
'******************************************************************
Private Sub mnuGrdASc_Click()
Dim iGrd As GridModel
Set iTinArea = iTinLayer.TinArea
Set iGrd = iTinArea
iGrd.LoadASCIIDatFileToGriding
Set iTinArea = Nothing
Set iGrd = Nothing
End Sub
'******************************************************************
'***********************规则网等值线追踪****************************
'******************************************************************
Private Sub mnuTraceGrd_Click()
Set iTinArea = iTinLayer.TinArea
res = iTinArea.LoadFile()
If res = False Then
   MsgBox "打开高程文件失败!"
   Exit Sub
End If
If Not iTinArea.IsGridNet Then
   MsgBox "打开文件不是规则网文件"
   Exit Sub
End If
Dim plai As New LinArea
Dim ppai As New PntArea
Dim prai As New RegArea
res = iTinArea.TinGridDemTraceContour(plai, ppai, prai)
If res = False Then
   MsgBox "追踪等值线失败!"
   Set plai = Nothing
   Set ppai = Nothing
   Set prai = Nothing
   Set iTinArea = Nothing
   Exit Sub
End If
plai.Save
ppai.Save
prai.Save
Set plai = Nothing
Set ppai = Nothing
Set prai = Nothing
Set iTinArea = Nothing
End Sub
'******************************************************************
'***********************三角网等值线追踪****************************
'******************************************************************
Private Sub mnuTraceTin_Click()
Set iTinArea = iTinLayer.TinArea
res = iTinArea.LoadFile()
If res = False Then
   MsgBox "打开高程文件失败!"
   Exit Sub
End If
If iTinArea.IsGridNet Then
   MsgBox "打开文件不是三角网文件"
   Exit Sub
End If
Dim plai As New LinArea
Dim ppai As New PntArea
Dim prai As New RegArea
res = iTinArea.TinTriNetTraceContour(prai, plai, ppai)
If res = False Then
   MsgBox "追踪等值线失败!"
   Set plai = Nothing
   Set ppai = Nothing
   Set prai = Nothing
   Set iTinArea = Nothing
   Exit Sub
End If
plai.Save
ppai.Save
prai.Save
Set plai = Nothing
Set ppai = Nothing
Set prai = Nothing
Set iTinArea = Nothing
End Sub
'*****************************************************************
'***********************三维等值立体图绘制************************
'*****************************************************************
Private Sub mnuGrd3dEquGra_Click()
Set iTinArea = iTinLayer.TinArea
res = iTinArea.LoadFile()
If res = False Then
   MsgBox "打开高程文件失败!"
   Exit Sub
End If
If Not iTinArea.IsGridNet Then
   MsgBox "打开文件不是规则网文件"
   Exit Sub
End If
Dim plai As New LinArea
Dim ppai As New PntArea
Dim prai As New RegArea
Dim iAppModel As AppModel
Set iAppModel = iTinArea
iAppModel.TinGridNet3dEquGra plai, ppai, prai
plai.Save
ppai.Save
prai.Save
Set plai = Nothing
Set ppai = Nothing
Set prai = Nothing
Set iAppModel = Nothing
Set iTinArea = Nothing
End Sub