clsdistrictsum.cls

FloodEvaluation-程序是gis方面的程序

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsEvaluateSum"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

'************************************************************************************************
'*********************** 统计指定区域内的损失情况                           ***********************
'*********************** The result is raster cells                       ***********************
'*********************** ZHANG Wenjiang, 2004/04/14                       ***********************
'************************************************************************************************

Option Explicit

Dim m_pCommand As ICommand
Dim m_pTool As ITool
Dim m_pSketchTool As ISketchTool
Dim m_pApp As IApplication

Dim pResultShpLyr As IFeatureLayer, indexName1 As Integer, indexLoss1 As Integer
    
Implements ICommand

Private Property Get ICommand_Bitmap() As esriCore.OLE_HANDLE
  ICommand_Bitmap = frmResources.picSum.Picture
End Property

Private Property Get ICommand_Caption() As String
  ICommand_Caption = "受灾损失统计"
End Property

Private Property Get ICommand_Category() As String
  ICommand_Category = "洪损评估"
End Property

Private Property Get ICommand_Checked() As Boolean
  ICommand_Checked = False
End Property

Private Property Get ICommand_Enabled() As Boolean
  ICommand_Enabled = True
End Property

Private Property Get ICommand_HelpContextID() As Long

End Property

Private Property Get ICommand_HelpFile() As String

End Property

Private Property Get ICommand_Message() As String
    ICommand_Message = "受灾损失统计"
End Property

Private Property Get ICommand_Name() As String
    ICommand_Name = "CustomSketch.SketchTool"
End Property

Private Sub ICommand_OnClick()
    Call evaluateSum(m_pApp)
End Sub

Private Sub ICommand_OnCreate(ByVal hook As Object)
On Error GoTo ErrorHandler:
  
    Set m_pApp = hook
    Set m_pCommand = CreateObject("esricore.SketchTool")
    m_pCommand.OnCreate hook
    Set m_pTool = m_pCommand
    Set m_pSketchTool = m_pCommand
    Exit Sub
    
ErrorHandler:
    MsgBox "OnCreate - " & ERR.Description
    Exit Sub
End Sub

Private Property Get ICommand_Tooltip() As String
    ICommand_Tooltip = "受灾损失统计"
End Property


'************************************************************************************************''''''
'''''' evaluateSum,调用createAndPlusFirst、plusAnother创建基于行政区的输出图层并对栅格、矢量评估结果进行统计
'************************************************************************************************''''''
Public Sub evaluateSum(pApp As IApplication)
    On Error GoTo ERH
      
'    Set pResultShpLyr = New FeatureLayer
    Dim bContinue As Boolean
    bContinue = createAndPlusFirst
    
    If Not bContinue Then Exit Sub
    
    Dim nResult As Integer
    nResult = MsgBox("评价其他损失项目", vbYesNo)
    
    While nResult = vbYes
            
        Call plusAnother
        nResult = MsgBox("继续评价其他项目", vbYesNo)

    Wend
    
    Call setFeatureLayerRenderer(pResultShpLyr, vbYellow)
    
    Dim pMxDoc As IMxDocument
    Set pMxDoc = pApp.Document
    pResultShpLyr.name = "洪损统计"
    pMxDoc.FocusMap.AddLayer pResultShpLyr
    pMxDoc.ActiveView.Refresh
    
    Set pResultShpLyr = Nothing
    
    Exit Sub
    
ERH:
    MsgBox "损失统计失败" & Chr(13) & ERR.Description, vbInformation + vbOKOnly, "提示信息"
End Sub


'************************************************************************************************''''''
'''''' polygonSum,先创建输出矢量文件，然后统计第一个图层
'************************************************************************************************''''''
Public Function createAndPlusFirst() As Boolean
    On Error GoTo ERH
    
    Dim strResultPath As String, strResultFile As String, strTemp As String
    Dim pDistrictLyr As IFeatureLayer, inputLyr As ILayer
    Dim fs
    
    frmEvaluateSum.Left = (Screen.Width - frmEvaluateSum.Width) / 2
    frmEvaluateSum.Top = (Screen.Height - frmEvaluateSum.Height) / 2
    frmEvaluateSum.Show vbModal

    If frmEvaluateSum.flagOK Then

        Set fs = CreateObject("Scripting.FileSystemObject")
        
        Set pDistrictLyr = frmEvaluateSum.shpPolygonLyr
        Set inputLyr = frmEvaluateSum.lossLyr
        strResultFile = frmEvaluateSum.txtPathResult

        If fs.FileExists(strResultFile) Then '
             fs.DeleteFile (strResultFile)
        End If
        
        If fs.FileExists(Left(strResultFile, Len(strResultFile) - 4) + ".dbf") Then '
             fs.DeleteFile (Left(strResultFile, Len(strResultFile) - 4) + ".dbf")
        End If
        
        Call SplitPath(strResultFile, strResultPath, strTemp)
        strResultFile = strTemp
        
    Else
        MsgBox "放弃区域统计"
        GoTo ERH
    End If
    
    Dim bRet As Boolean
    
    bRet = createResultLyr(pDistrictLyr, strResultPath, strResultFile)
    If bRet = False Then
        MsgBox "统计出错"
        createAndPlusFirst = False
        Exit Function
    End If
    
    If TypeOf inputLyr Is IFeatureLayer Then
        bRet = plusLossFeatLyr(inputLyr)
    Else
        If TypeOf inputLyr Is IRasterLayer Then
             bRet = plusLossRasterLyr(inputLyr)
        Else
             MsgBox "输入图层有误"
             createAndPlusFirst = False
             Exit Function
        End If
    End If
    
    If bRet = False Then
        MsgBox "统计出错"
        createAndPlusFirst = False
        Exit Function
    End If
    
    createAndPlusFirst = True
    
    Exit Function 'exit sub to avoid error handler

ERH:
    MsgBox "洪损统计失败1" & Chr(13) & ERR.Description, vbInformation + vbOKOnly, "提示信息"
    createAndPlusFirst = False
    
End Function

'************************************************************************************************''''''
'''''' polySumPlus在已有统计的基础上，再加上新的统计值
'************************************************************************************************''''''
Public Function plusAnother() As Boolean
    
    On Error GoTo ERH
    
    ' Create the RasterExtractionOp/MathOps object
    Dim inputLyr As ILayer
    
    frmEvaluateSumPlus.Left = (Screen.Width - frmEvaluateSumPlus.Width) / 2
    frmEvaluateSumPlus.Top = (Screen.Height - frmEvaluateSumPlus.Height) / 2
    frmEvaluateSumPlus.Show vbModal

    If frmEvaluateSumPlus.flagOK Then

        Set inputLyr = frmEvaluateSumPlus.lossLyr
        
    Else
        MsgBox "放弃区域损失统计"
        plusAnother = False
        Exit Function
    End If
   
    Dim bRet As Boolean
        
    If TypeOf inputLyr Is IFeatureLayer Then
        bRet = plusLossFeatLyr(inputLyr)
    Else
        If TypeOf inputLyr Is IRasterLayer Then
             bRet = plusLossRasterLyr(inputLyr)