imageupdate.frm

栅格数据处理程序

        Set pTable = pRasBand.AttributeTable
   
        '从栅格表中字段Value/Count取出差值栅格：Count0/Count1
        iZoneCount = pTable.RowCount(New QueryFilter)
        fieldIndexValue = pTable.FindField("Value")
        fieldIndexCount = pTable.FindField("Count")
    
        If iZoneCount > 0 Then
          For iZoneIndex = 0 To iZoneCount - 1
            Dim pRow As IRow
            Set pRow = pTable.GetRow(iZoneIndex)
            s = CStr(pRow.Value(fieldIndexValue))
            If (s = "0") Then
              Count0 = pRow.Value(fieldIndexCount)
            ElseIf (s = "1") Then
             Count1 = pRow.Value(fieldIndexCount)
            End If
         Next iZoneIndex
        End If
    
        '在pStaticTable
        Set pRowBuf = pStaticTable.CreateRowBuffer
        pRowBuf.Value(fdIdxCount0) = Count0
        pRowBuf.Value(fdIdxCount1) = Count1
        pRowBuf.Value(fdIdxElev) = gc 'elevstr
        pCursor.InsertRow pRowBuf

   
   Next gc
    
    ' Create conditional operator
    'Dim pConOp As IConditionalOp
    'Set pConOp = New RasterConditionalOp
        
   ' Set pRasResult = pLogicalOp.BooleanXOr(pRasterBaseFJ, pDEMRasterFJ)
        
        ' Using a specified constant to replace the defined area
        ' Create a constant raster using RasterMaker object
        ' Get the constant raster
        ' Perform Con operation
    'pConOp.Con(pCondRaster, pConstRaster, pDGXBaseRaster)
    'Set pConstRaster1 = Nothing
    Set pConstRasterDGXFJ = Nothing
    Set pRMakerOp = Nothing
    
    ' End session
    pEnv.RestoreToPreviousDefaultEnvironment

    ' create a raster layer and add into Map for display
'    Set pRasterLy = New RasterLayer
'    pRasterLy.CreateFromRaster pRasterSum
'    pRasterLy.Name = "Result"
'    m_pMap.AddLayer pRasterLy
'    m_ActView.Refresh
    'pCur.SetCursor 0
    Set pRasterSum = Nothing
    'Set pConOp = Nothing
    'Set pCur = Nothing
    
    m_ActView.Refresh
    
  '  StaticDataToTable (Trim(txtOutRas.Text))
    
    Unload frmUpdate
    Exit Sub
ERH:
    MsgBox Err.Description
End Sub
Private Sub Form_Load()
    ' when loading the form, get Map and ActiveView object
    ' for displaying the result. Add layers in ArcMap to the
    ' Combo box
'    Dim pMxDoc As IMxDocument
    Set m_pMxDoc = m_App.Document
    Set m_pMap = m_pMxDoc.FocusMap
    Set m_ActView = m_pMxDoc.ActiveView
    ' adding layers to each comb box
    AddLayerToComboBox cboInputDGXBase, m_pMap, "raster"
    AddLayerToComboBox cboDEM, m_pMap, "raster"
    'AddLayerToComboBox cboImage, m_pMap, "raster"
    ' set default to be using NoData and disable others
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set m_pMap = Nothing
    Set m_App = Nothing
    Set m_ActView = Nothing
End Sub

'从Map中获取存放统计结果的表，表名固定为“Elev_Static”
'获取表后立即清除已有数据
Private Function GetResultDataTable() As ITable

    'Get the input raster from the first layer in ArcMap
    
    Set GetResultDataTable = Nothing
    
    If m_pMap Is Nothing Then
        Exit Function
    End If
    
    Dim pTblColl As ITableCollection
    Dim pStaticTable As ITable
    Dim pDS As IDataset
    Dim oldRecordsNum, m As Integer
    Dim elevtemp As Long
    Dim strElev As String
    Dim i As Long
    
    Dim pRow As IRow
    Dim pRowEdit As IRowEdit
    Dim pCursor As ICursor
    Dim pQuery As QueryFilter
    Dim pDeleteSet As ISet

    Set pQuery = New QueryFilter
    
    Set pTblColl = m_pMap
    For i = 0 To pTblColl.TableCount - 1
     
      Set pDS = pTblColl.Table(i)
      If pDS.BrowseName = "Elev_Static" Then
            Set pStaticTable = pDS
            oldRecordsNum = pStaticTable.RowCount(Nothing)
            Exit For
      End If
    Next i
            
    If pStaticTable Is Nothing Then
        MsgBox "你还没有装载存放结果的属性表Elev_Static"
        Exit Function
    End If
    
    '如果表中有数据,则删除之
    If (oldRecordsNum > 0) Then
        If MsgBox("程序将删除表Elev_Static中原有数据，是否继续？", vbYesNo, "操作提示：") = vbNo Then
          Set GetResultDataTable = Nothing
          Exit Function
        End If
             
        '删除已有表中的所有记录 elevtemp = pStaticTable.OIDFieldName
        Dim deleteCount As Long
        deleteCount = 0
        Set pDeleteSet = New esrisystem.Set
        Set pCursor = pStaticTable.Search(pQuery, True)
        Set pRow = pCursor.NextRow
        Do While Not pRow Is Nothing
            pDeleteSet.Add pRow
            deleteCount = deleteCount + 1
            Set pRow = pCursor.NextRow
        Loop
        
        'MsgBox "删除之前的行数:" & deleteCount
        deleteCount = 0
        
        pDeleteSet.Reset
        Set pRowEdit = pDeleteSet.Next
        Do While Not pRowEdit Is Nothing
            pRowEdit.DeleteSet pDeleteSet
            Set pRowEdit = pDeleteSet.Next
            deleteCount = deleteCount + 1
        Loop
        
        'MsgBox "删除的行数:" & deleteCount

    End If
    
    Set GetResultDataTable = pStaticTable

End Function

Public Sub SaveToTable(ByVal strName As String, pStaticTable As ITable)
   '???????,??????????
   
  If m_pMxDoc Is Nothing Then Exit Sub
    
  Dim pMap As IMap
  Set pMap = m_pMxDoc.FocusMap
        
    Dim pLayer As ILayer
    Dim pRasLayer As IRasterLayer
    Dim pInRaster As IRaster
    Dim m_GeoIn As IGeoDataset
        
   Dim Lcount, k As Integer
   Dim Lname, elevstr As String
   Dim strIn1, strIn2, Lenstr As Integer
   Lenstr = Len(strName)
   Lcount = pMap.LayerCount
   For k = 0 To Lcount - 1
    Lname = pMap.Layer(k).Name
    strIn1 = InStr(Lname, strName)
    If (strIn1 > 0) Then
       elevstr = Mid(Lname, strIn1 + Lenstr)
       Set pLayer = pMap.Layer(k)
       
       
       
       
       If Not TypeOf pLayer Is IRasterLayer Then Exit Sub
    
       Dim s As String
     '????,????????
  
    Set pRasLayer = pLayer
    Set m_GeoIn = pRasLayer.Raster
    
    Dim pRasBandCollect As IRasterBandCollection
    Dim pRasBand As IRasterBand
    Dim pTable As ITable
    
    Set pRasBandCollect = m_GeoIn
    Set pRasBand = pRasBandCollect.Item(0)
    Set pTable = pRasBand.AttributeTable
    
     '???,???????,????????
    Dim iZoneCount As Long
    Dim iZoneIndex As Long
    iZoneCount = pTable.RowCount(New QueryFilter)
    Dim fieldIndexValue, fieldIndexCount As Long
    fieldIndexValue = pTable.FindField("Value")
    fieldIndexCount = pTable.FindField("Count")
    Dim Count0, Count1 As Long
    If iZoneCount > 0 Then
        For iZoneIndex = 0 To iZoneCount - 1
            Dim pRow As IRow
            Set pRow = pTable.GetRow(iZoneIndex)
            s = CStr(pRow.Value(fieldIndexValue))
            If (s = "0") Then
              Count0 = pRow.Value(fieldIndexCount)
            ElseIf (s = "1") Then
             Count1 = pRow.Value(fieldIndexCount)
            End If
        Next iZoneIndex
    End If
        
    '???????
  Dim pCursor As ICursor
  Set pCursor = pStaticTable.Insert(True)
     
  If pCursor Is Nothing Then
    Err.Raise vbObjectError + 1, "GetLogRow", "Could not open Cursor"
  End If
  
      Dim pRowBuf As IRowBuffer
      Set pRowBuf = pStaticTable.CreateRowBuffer
      pRowBuf.Value(pStaticTable.Fields.FindField("count0")) = Count0
      pRowBuf.Value(pStaticTable.Fields.FindField("count1")) = Count1
      pRowBuf.Value(pStaticTable.Fields.FindField("Elev")) = elevstr
      pCursor.InsertRow pRowBuf
 
  End If
Next
   

End Sub

Public Function SetRasterWorkspace(ByVal PathName As String) As IWorkspace
    ' Given a pathname, returns the raster workspace object for that path
    On Error GoTo ERH
    Dim pWSF As IWorkspaceFactory
    Set pWSF = New RasterWorkspaceFactory
    Dim pWS As IWorkspace
    Set pWS = pWSF.OpenFromFile(PathName, 0)
    Set SetRasterWorkspace = pWS
    Exit Function
ERH:
    Set SetRasterWorkspace = Nothing
End Function
Function CheckSpatialAnalystLicense()
    ' This module is used to check in SpatialAnalyst license
    ' in a standalone VB application.
    On Error GoTo ERH
    Dim pLicManager As IExtensionManager
    Dim pLicAdmin As IExtensionManagerAdmin
    Set pLicManager = New ExtensionManager
    Set pLicAdmin = pLicManager
    
    ' Add license for Spatial Analyst
    Dim pUID As New UID
    pUID.Value = "esriCore.SAExtension.1"
    Dim v As Variant
    Call pLicAdmin.AddExtension(pUID, v)
    
    ' Enable the license
    Dim pExtension As IExtension
    Dim pExtensionConfig As IExtensionConfig
    Set pExtension = pLicManager.FindExtension(pUID)
    Set pExtensionConfig = pExtension
    pExtensionConfig.State = esriESEnabled
    Exit Function
ERH:
    MsgBox "Failed in License Checking" & Err.Description
End Function
Public Sub AddLayerToComboBox(cboBox As ComboBox, pMap As IMap, sLayerType As String)
    ' This function search for layers in ArcMap and add them
    ' to the Combo box
    On Error GoTo ERH
    Dim iLyrIndex As Long
    Dim iLayerCount As Integer
    Dim pLyr As ILayer
    
    cboBox.Clear
    ' get the number of layers in ArcMap
    iLayerCount = pMap.LayerCount
    If iLayerCount > 0 Then
        ' add those layers into combo box
        cboBox.Enabled = True
        For iLyrIndex = 0 To iLayerCount - 1
            Set pLyr = pMap.Layer(iLyrIndex)
            If sLayerType = "raster" Then
                If (TypeOf pLyr Is IRasterLayer) Then
                    cboBox.AddItem pLyr.Name
                    cboBox.ItemData(cboBox.ListCount - 1) = iLyrIndex
                End If
            ElseIf sLayerType = "feature" Then
                If (TypeOf pLyr Is IFeatureLayer) Then
                    cboBox.AddItem pLyr.Name
                    cboBox.ItemData(cboBox.ListCount - 1) = iLyrIndex
                End If
            Else
                cboBox.AddItem pLyr.Name
            End If
        Next iLyrIndex
        ' specify the default text shown in the combo box
        If (cboBox.ListCount > 0) Then
            cboBox.ListIndex = 0
            cboBox.Text = cboBox.List(0)
        End If
    End If
    Exit Sub
ERH:
    MsgBox "Add Layer to ComboBox:" & Err.Description
End Sub


'        Set pConstRasterDGXFJ = pRMakerOp.MakeConstant(gc, False)
'
'        '降低一个等高距作为DEM的分界线
'        '分级的DEM栅格
'        'Set pDEMRasterFJ = pLogicalOp.LessThan(pDEMRaster, pConstRasterDGXFJ)
'        If bLessOrEqual Then
'            Set pDEMRasterFJ = pLogicalOp.BooleanNot(pLogicalOp.GreaterThan(pDEMRaster, pConstRasterDGXFJ))
'        Else
'            Set pDEMRasterFJ = pLogicalOp.LessThan(pDEMRaster, pConstRasterDGXFJ)
'        End If
        
        '求异或图像
        'Set pRasterSum = pLogicalOp.BooleanXOr(pRasterBaseFJ, pDEMRasterFJ)
        'Set pRasterSum = pMathOp.Plus(pRasterSum, pMathOp.Times(pLogicalOp.BooleanXOr(pRasterBaseFJ, pDEMRasterFJ), pConstRasterDGXFJ))