watersecurity.cls

用VB+MO做的北京奥运交通查询系统

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

''/////////////////////////////////////////////

'''首都师范大学北京市地理信息系统重点实验室
'''所属项目：四川西缘山地农村饮水安全决策支持系统
'''CopyRight(C) 2006
                                                
'''Function：饮用水是否安全判断库
'''Author：李家国
'''Date:2006-7-22

''/////////////////////////////////////////////

Dim m_bInitialized As Boolean           '类是否初始化

Dim m_arrWaterQuanlity() As Double      '水质指标植       具体说明见最下方
Dim m_dWaterQuantity As Double          '水量指标植
Dim m_dWaterAssure As Double            '水源保证率值
Dim m_bWaterConvenience As Double       '水源方便程度值   1方便；0不方便
Dim m_bWaterBloodWorm As Double         '吸血虫指标值     0无；1有

Dim m_iSecurityResult As Integer        '总安全结果
Dim m_iSecurityQuanlity As Integer      '水质指标安全结果
Dim m_iSecurityQuantity As Integer      '水量指标安全结果
Dim m_iSecurityAssure As Integer        '水源保证率安全结果
Dim m_iSecurityConvenience As Integer   '用水方便程度安全结果
Dim m_iSecurityBloodWorm As Integer     '吸血虫指标安全结果

''属性：得到水质安全级别：1安全；2基本安全；3不安全；4不确定
Public Property Get QuanlityResult()
    QuanlityResult = m_iSecurityQuanlity
End Property
''属性：得到水量安全级别：1安全；2基本安全；3不安全；4不确定
Public Property Get QuantityResult()
    QuantityResult = m_iSecurityQuantity
End Property
''属性：得到水源保证率安全级别：1安全；2基本安全；3不安全；4不确定
Public Property Get AssureResult()
    AssureResult = m_iSecurityAssure
End Property
''属性：得到用水方便程度安全级别：1安全；2不安全；3不确定
Public Property Get ConvenienceResult()
    ConvenienceResult = m_iSecurityConvenience
End Property
''属性：得到吸血虫安全级别：1安全；2不安全；3不确定
Public Property Get BloodWormResult()
    BloodWormResult = m_iSecurityBloodWorm
End Property

''属性:安全评价结果：1安全；2基本安全；3不安全；4不确定
Public Property Get SecurityResult() As Integer
    
    ''Initilize Check
    If Not m_bInitialized Then
        MsgBox "安全性评价类库没有初始化", vbOKOnly, "动态库错误提示"
        Exit Property
    End If
    
    m_iSecurityResult = WaterSecurity
    SecurityResult = m_iSecurityResult
End Property

''初始化类
Public Function InitializeClass(ByRef WaterQuanlityArray() As Double, ByVal WaterQuantity As Double, ByVal WaterAssure As Double, ByVal WaterConvenience As Double, ByVal WaterBloodWorm As Double) As Boolean
    On Error GoTo EF
    
    m_arrWaterQuanlity = WaterQuanlityArray
    m_dWaterQuantity = WaterQuantity
    m_dWaterAssure = WaterAssure
    m_bWaterConvenience = WaterConvenience
    m_bWaterBloodWorm = WaterBloodWorm
    
    If UBound(m_arrWaterQuanlity) <> 18 Then
        MsgBox "初始化安全性评价类库第一个参数数目不对", vbOKOnly, "动态库错误提示"
        GoTo EF
    End If
    m_bInitialized = True
    InitializeClass = True
    
    Exit Function
EF:
    m_bInitialized = False
    InitializeClass = False
End Function

''*****************************私有方法*****************************


''水资源安全性综合评价：1安全；2基本安全；3不安全；4不确定
Private Function WaterSecurity() As Integer
    
    ''五项指标各自安全级别
    ''1安全；2基本安全；3不安全；4不确定
    m_iSecurityQuanlity = WaterQuanlitySecurity
    m_iSecurityQuantity = WaterQuantitySecurity
    m_iSecurityAssure = WaterAssureSecurity
    ''///////1安全；2不安全；3不确定
    m_iSecurityConvenience = WaterConvenienceSecurity
    m_iSecurityBloodWorm = WaterBloodWormSecurity
    
    Dim iMax1 As Integer, iMax2 As Integer
    iMax1 = MaxValueFrom123
    iMax2 = MaxValueFrom45
    
    ''五项指标综合安全级别
    ''安全:
    If iMax1 = 1 And iMax2 = 1 Then
        WaterSecurity = 1
        Exit Function
    End If
    
    ''基本安全
    If iMax1 <= 2 And iMax2 = 1 Then
        WaterSecurity = 2
        Exit Function
    End If
    
    ''不安全
    If iMax1 = 3 Or iMax2 = 2 Then
        WaterSecurity = 3
        Exit Function
    End If
    
    ''不确定
    If (iMax1 = 4 And iMax2 = 1) Or (iMax2 = 3 And iMax1 <= 2) Then
        WaterSecurity = 4
        Exit Function
    End If
    
EF:
End Function

''找出水质、水量、保证率三个属性中最大的值
Private Function MaxValueFrom123() As Integer
    Dim tmpMax As Integer
    tmpMax = m_iSecurityQuanlity
    
    If m_iSecurityQuantity > tmpMax Then
        tmpMax = m_iSecurityQuantity
    End If
    
    If m_iSecurityAssure > tmpMax Then
        tmpMax = m_iSecurityAssure
    End If
    
    MaxValueFrom123 = tmpMax
End Function

''找出用水方便程度、吸血虫二个属性中最大的值
Private Function MaxValueFrom45() As Integer
    Dim tmpMax As Integer
    tmpMax = m_iSecurityConvenience
    
    If m_iSecurityBloodWorm > tmpMax Then
        tmpMax = m_iSecurityBloodWorm
    End If
    
    MaxValueFrom45 = tmpMax
End Function



''************************************************************
''以下函数按水量、水质、方便程序、保证率指标值对水资源进行安全评价
''无特殊说明时，1：安全；2：基本安全；3：不安全；4:不确定
''************************************************************


''水质安全
Private Function WaterQuanlitySecurity() As Integer
    Dim bGradeResult As Boolean
    ''一级水：安全
    bGradeResult = WaterGrade(1)
    If bGradeResult Then
        WaterQuanlitySecurity = 1
        Exit Function
    End If
    ''二级水：基本安全
    bGradeResult = WaterGrade(2)
    If bGradeResult Then
        WaterQuanlitySecurity = 2
        Exit Function
    End If
    ''三级水及其它：不安全
    bGradeResult = WaterGrade(3)
    If bGradeResult Then
        WaterQuanlitySecurity = 3
        Exit Function
    End If
    ''其它：不确定
    WaterQuanlitySecurity = 4
End Function

''水量安全
Private Function WaterQuantitySecurity() As Integer
    
    If 0 <= m_dWaterQuantity And m_dWaterQuantity < 35 Then
        WaterQuantitySecurity = 3
    ElseIf m_dWaterQuantity >= 35 And m_dWaterQuantity <= 55 Then
        WaterQuantitySecurity = 2
    ElseIf m_dWaterQuantity > 55 Or m_dWaterQuantity = -1 Then
        WaterQuantitySecurity = 1
    Else
        WaterQuantitySecurity = 4
    End If
End Function

''用水保证率安全
Private Function WaterAssureSecurity() As Integer
    If 0 <= m_dWaterAssure And m_dWaterAssure < 90 Then
        WaterAssureSecurity = 3
    ElseIf m_dWaterAssure >= 90 And m_dWaterAssure < 95 Then
        WaterAssureSecurity = 2
    ElseIf m_dWaterAssure >= 95 Or m_dWaterAssure = -1 Then
        WaterAssureSecurity = 1
    Else
        WaterAssureSecurity = 4
    End If
End Function

''///////1安全；2不安全；3不确定
''方便程度安全
Private Function WaterConvenienceSecurity() As Integer
    If m_bWaterConvenience = 0 Then
        WaterConvenienceSecurity = 2
    ElseIf m_bWaterConvenience = 1 Or m_bWaterConvenience = -1 Then
        WaterConvenienceSecurity = 1
    Else
        WaterConvenienceSecurity = 3
    End If
End Function

''///////1安全；2不安全；3不确定
''吸血虫安全
Private Function WaterBloodWormSecurity() As Integer
    If m_bWaterBloodWorm = 0 Or m_bWaterBloodWorm = -1 Then
        WaterBloodWormSecurity = 1
    ElseIf m_bWaterBloodWorm = 1 Then
        WaterBloodWormSecurity = 2
    Else
        WaterBloodWormSecurity = 3
    End If
End Function



''水资源级别综合判断
Private Function WaterGrade(ByVal WhichGrade As Integer) As Boolean
    Dim bGrade As Boolean
    Dim iGrade As Integer: iGrade = WhichGrade
    
    ''色度
    bGrade = ColorGrade(m_arrWaterQuanlity(0)) = iGrade
    If bGrade = False Then GoTo EF
    ''浑浊度
    bGrade = TurbidityGrade(m_arrWaterQuanlity(1)) = iGrade
    If bGrade = False Then GoTo EF
    ''肉眼可见物
    bGrade = VisibleThingsStanded(m_arrWaterQuanlity(2)) = True
    If bGrade = False Then GoTo EF
    ''pH
    If iGrade = 1 Then
        bGrade = PHStanded(m_arrWaterQuanlity(3)) = 0
        If bGrade = False Then GoTo EF
    Else
        bGrade = PHStanded(m_arrWaterQuanlity(3)) <> 2
        If bGrade = False Then GoTo EF
    End If
    ''总硬度
    bGrade = RigidityGrade(m_arrWaterQuanlity(4)) = iGrade
    If bGrade = False Then GoTo EF
    ''Fe
    bGrade = FeGrade(m_arrWaterQuanlity(5)) = iGrade
    If bGrade = False Then GoTo EF
    ''Mn
    bGrade = MnGrade(m_arrWaterQuanlity(6)) = iGrade
    If bGrade = False Then GoTo EF
    ''Cl
    bGrade = ClGrade(m_arrWaterQuanlity(7)) = iGrade
    If bGrade = False Then GoTo EF
    ''SO4
    bGrade = SO4Grade(m_arrWaterQuanlity(8)) = iGrade
    If bGrade = False Then GoTo EF
    ''TDS
    bGrade = TDSGrade(m_arrWaterQuanlity(9)) = iGrade
    If bGrade = False Then GoTo EF
    ''F
    bGrade = FGrade(m_arrWaterQuanlity(10)) = iGrade
    If bGrade = False Then GoTo EF
    ''As
    bGrade = AsStanded(m_arrWaterQuanlity(11)) = True
    If bGrade = False Then GoTo EF