VERSION 5.00
Begin VB.Form frmUpdate 
   Caption         =   "Image Update"
   ClientHeight    =   4125
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5490
   LinkTopic       =   "Form1"
   ScaleHeight     =   4125
   ScaleWidth      =   5490
   StartUpPosition =   1  'CenterOwner
   Begin VB.TextBox txtOutRas 
      Height          =   375
      Left            =   3480
      TabIndex        =   14
      Text            =   "Result"
      Top             =   3240
      Width           =   1335
   End
   Begin VB.CheckBox chkLessOrEqual 
      Caption         =   "小于等于"
      Height          =   375
      Left            =   240
      TabIndex        =   13
      Top             =   3240
      Value           =   1  'Checked
      Width           =   1335
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "Cancel"
      Height          =   375
      Left            =   4440
      TabIndex        =   7
      Top             =   3720
      Width           =   855
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "OK"
      Height          =   375
      Left            =   3120
      TabIndex        =   6
      Top             =   3720
      Width           =   1095
   End
   Begin VB.Frame Frame1 
      Caption         =   "精度統計的高程范圍"
      Height          =   1815
      Left            =   240
      TabIndex        =   4
      Top             =   1320
      Width           =   4695
      Begin VB.TextBox txtDGJ 
         Height          =   375
         Left            =   1920
         TabIndex        =   12
         Text            =   "50"
         Top             =   1200
         Width           =   2295
      End
      Begin VB.TextBox txtMinElev 
         Height          =   375
         Left            =   1920
         TabIndex        =   8
         Text            =   "0"
         Top             =   240
         Width           =   2295
      End
      Begin VB.TextBox txtMaxElev 
         Height          =   375
         Left            =   1920
         TabIndex        =   5
         Text            =   "0"
         Top             =   720
         Width           =   2295
      End
      Begin VB.Label lab3 
         Caption         =   "等高距："
         Height          =   255
         Left            =   360
         TabIndex        =   11
         Top             =   1320
         Width           =   1095
      End
      Begin VB.Label Label3 
         Caption         =   "最大高程："
         Height          =   255
         Left            =   360
         TabIndex        =   10
         Top             =   720
         Width           =   1095
      End
      Begin VB.Label lab1 
         Caption         =   "最小高程："
         Height          =   255
         Left            =   360
         TabIndex        =   9
         Top             =   360
         Width           =   1335
      End
   End
   Begin VB.ComboBox cboDEM 
      Height          =   315
      Left            =   1680
      TabIndex        =   3
      Text            =   "Combo2"
      Top             =   840
      Width           =   3255
   End
   Begin VB.ComboBox cboInputDGXBase 
      Height          =   315
      Left            =   1680
      TabIndex        =   2
      Text            =   "Combo1"
      Top             =   360
      Width           =   3255
   End
   Begin VB.Label Label4 
      Caption         =   "輸出的柵格名前綴"
      Height          =   375
      Left            =   1800
      TabIndex        =   15
      Top             =   3360
      Width           =   1455
   End
   Begin VB.Label Label2 
      Caption         =   "DEM柵格"
      Height          =   255
      Left            =   240
      TabIndex        =   1
      Top             =   840
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "基準等高線柵格"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   360
      Width           =   1335
   End
End
Attribute VB_Name = "frmUpdate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_App As IApplication
Private m_pMap As IMap
Private m_ActView As IActiveView
Private m_pMxDoc As IMxDocument
Private m_GeoIn As IGeoDataset

Public Sub init(pApp As IApplication)
    Set m_App = pApp
End Sub

Private Sub cmdCancel_Click()
    Unload frmUpdate
End Sub

Private Sub cmdOK_Click()
    ' Declare the input and output objects
    On Error GoTo ERH
    
    ' Set up cursor
'    Dim pCur As IMouseCursor
'    Set pCur = New MouseCursor
'    pCur.SetCursor 2
    
    Dim pDGXBaseRaster As IRaster ' for input raster
    Dim pDEMRaster As IRaster ' for input raster
    Dim pRepLaceRaster As IRaster ' for raster used to replace with
    Dim pDefinedAreaDS As IGeoDataset ' dataset that defined the area to
                                      ' to be replaced with
    Dim pRasResult As IRaster ' the result
    
    ' Create a Rasterworkspace
    Dim sPath As String
    sPath = Environ("TEMP") ' Get temp directory
    Dim pWS As IWorkspace
    Set pWS = SetRasterWorkspace(sPath)
    
    '基準等高線柵格
    Dim pRasterLy As IRasterLayer
    Dim pFeatureLy As IFeatureLayer
    Dim pLy As ILayer
    Set pLy = m_pMap.Layer(cboInputDGXBase.ItemData(cboInputDGXBase.ListIndex))
    If TypeOf pLy Is IRasterLayer Then
        Set pRasterLy = pLy
        Set pDGXBaseRaster = pRasterLy.Raster
    Else
        MsgBox "基準等高線柵格不能為空."
        Exit Sub
    End If
    
    '待檢查的DEM柵格
    Set pLy = m_pMap.Layer(cboDEM.ItemData(cboDEM.ListIndex))
    If TypeOf pLy Is IRasterLayer Then
        Set pRasterLy = pLy
        Set pDEMRaster = pRasterLy.Raster
    Else
        MsgBox "待檢查的DEM柵格不能為空"
        Exit Sub
    End If
    
    Set m_GeoIn = pRDS.CreateDefaultRaster
    
    '以基準等高線柵格的柵格大小和范圍為環境基礎
    Dim pRasterProp As IRasterProps
    Dim pExtent As IEnvelope
    Dim vCell As Double
    Set pRasterProp = pDGXBaseRaster
    Set pExtent = pRasterProp.Extent
    vCell = (pRasterProp.MeanCellSize.X + pRasterProp.MeanCellSize.Y) / 2
    
    'Check Spatial Analyst license
    CheckSpatialAnalystLicense
    
    ' Create RasterAnalysis environment
    Dim pEnv As IRasterAnalysisEnvironment
    Set pEnv = New RasterAnalysis
    pEnv.SetCellSize esriRasterEnvValue, vCell
    pEnv.SetExtent esriRasterEnvValue, pExtent
    Set pEnv.OutWorkspace = pWS
    ' Set to default so that it work for all the Ops in this session
    pEnv.SetAsNewDefaultEnvironment
    
 
    'Create a conditional raster using ILogicalOp interface
    ' the raster is true for the defined area and false for area that is
    ' within the extent but out side of the defined area.
    ' Create Logical operator
    'Dim pCondRaster As IGeoDataset
    Dim pRasterSum As IRaster
    Dim pDEMRasterFJ As IRaster
    Dim pRasterBaseFJ As IRaster
    Dim pConstRasterDGXFJ As IRaster
    Dim pLogicalOp As ILogicalOp
    Set pLogicalOp = New RasterMathOps
    ' Perform the computation
    
    '構造1/0常數影像
    Dim pRMakerOp As IRasterMakerOp
    Set pRMakerOp = New RasterMakerOp
    Set pRasterSum = pRMakerOp.MakeConstant(0, True)
    
    Dim elevMin As Long
    Dim elevMax As Long
    Dim dgj As Long
    Dim gc As Long
    
    '從Map中獲取存放結果的屬性表
    Dim pStaticTable As ITable
    
    Set pStaticTable = GetResultDataTable()
    If pStaticTable Is Nothing Then
       Exit Sub
    End If
    
    '統計區間
    elevMin = Val(txtMinElev.Text)
    elevMax = Val(txtMaxElev.Text)
    dgj = Val(txtDGJ.Text)
    
    Dim preNameRasOutput As String
    
    preNameRasOutput = Trim(txtOutRas.Text)
    If preNameRasOutput = "" Then preNameRasOutput = "Result"
    
    Dim bLessOrEqual As Boolean
    If (chkLessOrEqual.Value = 1) Then
        bLessOrEqual = True
    Else: bLessOrEqual = False
    End If
    
    If dgj <= 0 Then
        MsgBox "等高距必須大于或等于0"
        Exit Sub
    End If
    
    If elevMin > elevMax Then
        MsgBox "最小和最大高程值填寫錯誤！"
        Exit Sub
    End If
    
    Dim pMathOp As IMathOp
    Set pMathOp = New RasterMathOps

    Dim pRasBandCollect As IRasterBandCollection
    Dim pRasBand As IRasterBand
    Dim pTable As ITable
    Dim m_GeoIn As IGeoDataset
    Dim iZoneCount As Long
    Dim iZoneIndex As Long
    Dim fieldIndexValue, fieldIndexCount As Long
    Dim Count0, Count1 As Long
    Dim pCursor As ICursor
    Dim pRowBuf As IRowBuffer
    Dim fdIdxCount0 As Long
    Dim fdIdxCount1 As Long
    Dim fdIdxElev As Long
    Dim s As String
    
    '插入光標
    Set pCursor = pStaticTable.Insert(True)
     
    If pCursor Is Nothing Then
       Err.Raise vbObjectError + 1, "GetLogRow", "Could not open Cursor"
    End If
  
    fdIdxCount0 = pStaticTable.Fields.FindField("count0")
    fdIdxCount1 = pStaticTable.Fields.FindField("count1")
    fdIdxElev = pStaticTable.Fields.FindField("Elev")
    If fdIdxCount0 < 0 Or fdIdxCount1 < 0 Or fdIdxElev < 0 Then
        MsgBox "結果表中缺少字段count0，count1，Elev"
        Exit Sub
    End If

    ' Change cursor while calculating
    Dim pCur As IMouseCursor
    Set pCur = New MouseCursor
    pCur.SetCursor 2
    
    '逐層次處理等高線
    For gc = elevMin To elevMax Step dgj
    
        '分界線柵格
        Set pConstRasterDGXFJ = pRMakerOp.MakeConstant(gc, False)
        
        '分級的基準等高線柵格,求異或運算,計算面積差異
        Set pRasterBaseFJ = pLogicalOp.GreaterThanEqual(pDGXBaseRaster, pConstRasterDGXFJ)
        Set pDEMRasterFJ = pLogicalOp.GreaterThanEqual(pDEMRaster, pConstRasterDGXFJ)
        
        '為每一個高程帶創建一個臨時柵格，并加入到Map
        Set pRasterSum = pLogicalOp.BooleanXOr(pRasterBaseFJ, pDEMRasterFJ)
        
        '作濾波處理,融合4鄰接像元
        Dim pEnv As IRasterAnalysisEnvironment
        Set pop = New RasterGeneralizeOp
        
        
        Set pRasterLy = New RasterLayer
        pRasterLy.CreateFromRaster pRasterSum
        pRasterLy.Name = preNameRasOutput & gc
        m_pMap.AddLayer pRasterLy
        
        'm_ActView.Refresh
        
        '從分段柵格中取出0-1個數存入表pStaticTable
        Set m_GeoIn = pRasterLy.Raster
        Set pRasBandCollect = m_GeoIn
        Set pRasBand = pRasBandCollect.Item(0)