frmfloodinfodisplay.frm

FloodEvaluation-程序是gis方面的程序

VERSION 5.00
Begin VB.Form frmFloodInfoDisplay 
   Caption         =   "洪灾受损统计信息"
   ClientHeight    =   3765
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3885
   Icon            =   "frmFloodInfoDisplay.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   3765
   ScaleWidth      =   3885
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame1 
      Height          =   2295
      Left            =   240
      TabIndex        =   1
      Top             =   720
      Width           =   3375
      Begin VB.CommandButton cmdFloodInfo 
         Caption         =   "受灾信息"
         Height          =   375
         Left            =   360
         TabIndex        =   7
         Top             =   240
         Width           =   975
      End
      Begin VB.CommandButton cmdFloodPopu 
         Caption         =   "受灾人口"
         Height          =   375
         Left            =   360
         TabIndex        =   6
         Top             =   960
         Width           =   975
      End
      Begin VB.CommandButton cmdFloodArea 
         Caption         =   "受灾面积"
         Height          =   375
         Left            =   2040
         TabIndex        =   5
         Top             =   960
         Width           =   975
      End
      Begin VB.CommandButton cmdTotalCrop 
         Caption         =   "受灾作物"
         Height          =   375
         Left            =   360
         TabIndex        =   4
         Top             =   1680
         Width           =   975
      End
      Begin VB.CommandButton cmdFloodLoss 
         Caption         =   "损失统计"
         Height          =   375
         Left            =   2040
         TabIndex        =   3
         Top             =   240
         Width           =   975
      End
      Begin VB.CommandButton cmdOneCrop 
         Caption         =   "单项作物"
         Height          =   375
         Left            =   2040
         TabIndex        =   2
         Top             =   1680
         Width           =   975
      End
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "返 回"
      Height          =   375
      Left            =   1560
      TabIndex        =   0
      Top             =   3240
      Width           =   735
   End
   Begin VB.Label Label1 
      Caption         =   "请点击不同的按钮，分别查看洪灾及其评估的有关信息"
      Height          =   495
      Left            =   240
      TabIndex        =   8
      Top             =   120
      Width           =   3375
   End
End
Attribute VB_Name = "frmFloodInfoDisplay"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public m_adoCnn As ADODB.Connection
Public bForModal As Boolean

Private Sub cmdFloodArea_Click()
On Error GoTo ERH
    If m_adoCnn Is Nothing Then
       MsgBox "连接有误" + Chr(13) + ERR.Description, vbInformation + vbYesonly, "信息提示"
       Exit Sub
    End If
   
    Dim areaRS As ADODB.Recordset
    Set areaRS = GetWritableRS("evalArea", m_adoCnn)

    If areaRS Is Nothing Then
       MsgBox "连接有误" + Chr(13) + ERR.Description, vbInformation + vbYesonly, "信息提示"
       Exit Sub
    End If

    Call ShowTable(areaRS, frmFloodTable.lstView)
    
    frmFloodTable.Left = (Screen.Width - frmFloodTable.Width) / 2
    frmFloodTable.Top = (Screen.Height - frmFloodTable.Height) / 2
    frmFloodTable.Caption = "受灾面积统计信息"

    frmFloodTable.Show vbModal
    
    Exit Sub
ERH:
    MsgBox "显示受灾面积失败" + Chr(13) + ERR.Description, vbInformation + vbYesonly, "信息提示"
End Sub

Private Sub cmdFloodInfo_Click()
On Error GoTo ERH
    If m_adoCnn Is Nothing Then
       MsgBox "连接有误" + Chr(13) + ERR.Description, vbInformation + vbYesonly, "信息提示"
       Exit Sub
    End If
   
    Set frmInputFloodInfo.m_adoCnn = m_adoCnn
    frmInputFloodInfo.Left = (Screen.Width - frmInputFloodInfo.Width) / 2
    frmInputFloodInfo.Top = (Screen.Height - frmInputFloodInfo.Height) / 2

    frmInputFloodInfo.Show vbModal
        
    If frmInputFloodInfo.bFlag Then
    End If
        
    Exit Sub
ERH:
    MsgBox "显示受灾信息失败" + Chr(13) + ERR.Description, vbInformation + vbYesonly, "信息提示"
End Sub

Private Sub cmdFloodLoss_Click()
On Error GoTo ERH
    If m_adoCnn Is Nothing Then
       MsgBox "连接有误" + Chr(13) + ERR.Description, vbInformation + vbYesonly, "信息提示"
       Exit Sub
    End If
   
    Dim lossRS As ADODB.Recordset
    Set lossRS = GetWritableRS("evalLoss", m_adoCnn)

    If lossRS Is Nothing Then
       MsgBox "连接有误" + Chr(13) + ERR.Description, vbInformation + vbYesonly, "信息提示"
       Exit Sub
    End If

    Call ShowTable(lossRS, frmFloodTable.lstView)
    
    frmFloodTable.Left = (Screen.Width - frmFloodTable.Width) / 2
    frmFloodTable.Top = (Screen.Height - frmFloodTable.Height) / 2
    frmFloodTable.Caption = "受灾损失统计信息"

    frmFloodTable.Show vbModal
    Exit Sub
ERH:
    MsgBox "显示受灾损失失败" + Chr(13) + ERR.Description, vbInformation + vbYesonly, "信息提示"
End Sub

Private Sub cmdFloodPopu_Click()
On Error GoTo ERH
    If m_adoCnn Is Nothing Then
       MsgBox "连接有误" + Chr(13) + ERR.Description, vbInformation + vbYesonly, "信息提示"
       Exit Sub
    End If
   
    Dim popuRS As ADODB.Recordset
    Set popuRS = GetWritableRS("evalPopu", m_adoCnn)

    If popuRS Is Nothing Then
       MsgBox "连接有误" + Chr(13) + ERR.Description, vbInformation + vbYesonly, "信息提示"
       Exit Sub
    End If

    Call ShowTable(popuRS, frmFloodTable.lstView)
    
    frmFloodTable.Left = (Screen.Width - frmFloodTable.Width) / 2
    frmFloodTable.Top = (Screen.Height - frmFloodTable.Height) / 2
    frmFloodTable.Caption = "受灾人口统计信息"

    frmFloodTable.Show vbModal
    
    
    Exit Sub
ERH:
    MsgBox "显示受灾人口失败" + Chr(13) + ERR.Description, vbInformation + vbYesonly, "信息提示"
End Sub

Private Sub cmdOK_Click()
    bForModal = True
    Unload Me
End Sub


'************************************************************************************************''''''
'''''' 记录作物评估属性
'************************************************************************************************''''''
Public Sub addCropLossInfo(inputRaster As IRaster, _
                           districtLyr As IFeatureLayer, _
                           adoCnn As ADODB.Connection)
On Error GoTo ERH

    Dim cropRS As ADODB.Recordset
    Set cropRS = GetWritableRS("evalTotalCrop", adoCnn)
    
    If Not bFloodInfoOK Then
        frmFloodInfo.Left = (Screen.Width - frmFloodInfo.Width) / 2
        frmFloodInfo.Top = (Screen.Height - frmFloodInfo.Height) / 2
        frmFloodInfo.Show vbModal
    End If

    Dim pExtractionOp As IExtractionOp
    Set pExtractionOp = New RasterExtractionOp
    Dim districtName As String, polySummary As Double, theArea As Long
    Dim pPolygon As IPolygon, pExtractRaster As IRaster

    Dim indexName As Integer
    indexName = districtLyr.FeatureClass.Fields.FindField("地区")
    
    Dim pFilter As IQueryFilter
    Set pFilter = New QueryFilter
    pFilter.WhereClause = ""

    Dim pOutCursor As IFeatureCursor
    Set pOutCursor = districtLyr.Search(pFilter, False)

    Dim polyFeat As IFeature
    Set polyFeat = pOutCursor.NextFeature
    theArea = 2
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Do While Not polyFeat Is Nothing

        Set pPolygon = polyFeat.Shape
        Set pExtractRaster = pExtractionOp.Polygon(inputRaster, pPolygon, True)
        Call rasterSum2(pExtractRaster, polySummary, theArea)
        districtName = polyFeat.Value(indexName)
        Call AppendEvalTotalCropRecord(cropRS, theFloodName, theFloodDate, districtName, theArea, polySummary)
        Set polyFeat = pOutCursor.NextFeature

    Loop '''''''''''''''''''''''''''''''''''''''''''''''''''''''Do While Not polyFeat Is Nothing


'    Set pResultShpLyr = resultLyr
    Set pFilter = Nothing
    Set pOutCursor = Nothing
    Set pExtractionOp = Nothing
MsgBox "finished input"
    Exit Sub      'exit sub to avoid error handler

ERH:
    MsgBox "记录作物损失统计失败" & Chr(13) & ERR.Description, vbInformation + vbOKOnly, "提示信息"
End Sub

Private Sub cmdOneCrop_Click()
On Error GoTo ERH
    If m_adoCnn Is Nothing Then
       MsgBox "连接有误" + Chr(13) + ERR.Description, vbInformation + vbYesonly, "信息提示"
       Exit Sub
    End If
   
    Set frmDisplayCrop.m_adoCnn = m_adoCnn
    frmDisplayCrop.m_theCropTable = "evalOneCrop"
    'm_cropName
    frmDisplayCrop.Left = (Screen.Width - frmDisplayCrop.Width) / 2
    frmDisplayCrop.Top = (Screen.Height - frmDisplayCrop.Height) / 2

    frmDisplayCrop.Show vbModal
        
    Exit Sub
ERH:
    MsgBox "显示受灾信息失败" + Chr(13) + ERR.Description, vbInformation + vbYesonly, "信息提示"
End Sub

Private Sub cmdTotalCrop_Click()
On Error GoTo ERH
    If m_adoCnn Is Nothing Then
       MsgBox "连接有误" + Chr(13) + ERR.Description, vbInformation + vbYesonly, "信息提示"
       Exit Sub
    End If
   
    Set frmDisplayCrop.m_adoCnn = m_adoCnn
    frmDisplayCrop.m_theCropTable = "evalTotalCrop"
    frmDisplayCrop.Left = (Screen.Width - frmDisplayCrop.Width) / 2
    frmDisplayCrop.Top = (Screen.Height - frmDisplayCrop.Height) / 2

    frmDisplayCrop.Show vbModal
        
    Exit Sub
ERH:
    MsgBox "显示受灾信息失败" + Chr(13) + ERR.Description, vbInformation + vbYesonly, "信息提示"
'frmDisplayCrop
End Sub