frmgroundwater1.frm

水质模糊综合评价系统 水质模糊综合评价系统 水质模糊综合评价系统

   
   ElseIf Check15.Value = 1 And Val(Text15.Text) = 0 Then
   MsgBox "请输入合理的锰(Mn)值!注意所输入数据的单位是(mg/L)!", vbOKOnly + vbExclamation, "提示"
   Text15.Text = ""
   Exit Sub
   
   ElseIf Check16.Value = 1 And Val(Text16.Text) = 0 Then
   MsgBox "请输入合理的溶解性总固体值!注意所输入数据的单位是(mg/L)!", vbOKOnly + vbExclamation, "提示"
   Text16.Text = ""
   Exit Sub
   
   ElseIf Check17.Value = 1 And Val(Text17.Text) = 0 Then
   MsgBox "请输入合理的高锰酸盐指数值!注意所输入数据的单位是(mg/L)!", vbOKOnly + vbExclamation, "提示"
   Text17.Text = ""
   Exit Sub
   
   ElseIf Check18.Value = 1 And Val(Text18.Text) = 0 Then
   MsgBox "请输入合理的硫酸盐值!注意所输入数据的单位是(mg/L)!", vbOKOnly + vbExclamation, "提示"
   Text18.Text = ""
   Exit Sub
   
   ElseIf Check19.Value = 1 And Val(Text19.Text) = 0 Then
   MsgBox "请输入合理的氯化物值!注意所输入数据的单位是(mg/L)!", vbOKOnly + vbExclamation, "提示"
   Text19.Text = ""
   Exit Sub
   
   ElseIf Check20.Value = 1 And Val(Text20.Text) = 0 Then
   MsgBox "请输入合理的总大肠菌群值!注意所输入数据的单位是(个/L)!", vbOKOnly + vbExclamation, "提示"
   Text20.Text = ""
   Exit Sub
End If

n = (Check1.Value + Check2.Value + Check3.Value + Check4.Value + Check5.Value + Check6.Value + Check7.Value _
     + Check8.Value + Check9.Value + Check10.Value + Check11.Value + Check12.Value + Check13.Value + Check14.Value _
     + Check15.Value + Check16.Value + Check17.Value + Check18.Value + Check19.Value + Check20.Value)
     If n = 0 Then
     MsgBox "请选择监测项目并输入监测值后再评价!", vbOKOnly + vbExclamation, "提示"
     Exit Sub
     End If

'计算平均值fv
fv = (f1 + f2 + f3 + f4 + f5 + f6 + f7 + f8 + f9 + f10 + f11 + f12 + f13 + f14 + f15 + f16 + f17 + f18 + f19 + f20) / n

'取(f1,f2,f3,f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, f16, f17, f18, f19, f20)的最大值赋给fm

Call Max(f1, f2, fm)
Call Max(f3, fm, fm)
Call Max(f4, fm, fm)
Call Max(f5, fm, fm)
Call Max(f6, fm, fm)
Call Max(f7, fm, fm)
Call Max(f8, fm, fm)
Call Max(f9, fm, fm)
Call Max(f10, fm, fm)
Call Max(f11, fm, fm)
Call Max(f12, fm, fm)
Call Max(f13, fm, fm)
Call Max(f14, fm, fm)
Call Max(f15, fm, fm)
Call Max(f16, fm, fm)
Call Max(f17, fm, fm)
Call Max(f18, fm, fm)
Call Max(f19, fm, fm)
Call Max(f20, fm, fm)

  '将平均值fv和最大值fm的平方代入公式计算综合评价分值f
fv2 = fv ^ 2
fm2 = fm ^ 2

f = Sqr((fv2 + fm2) / 2)

'据综合评价分值f的不同划分地下水质量级别
If f >= 0 And f <= 0.8 Then
 Label25.Caption = "优良" & (Label20.Caption)
ElseIf f > 0.8 And f <= 2.5 Then
 Label25.Caption = "良好" & (Label20.Caption)
 ElseIf f > 2.5 And f <= 4.25 Then
 Label25.Caption = "较好" & (Label20.Caption)
ElseIf f > 4.25 And f <= 7.2 Then
 Label25.Caption = "较差" & (Label20.Caption)
ElseIf f > 7.2 Then
 Label25.Caption = "极差" & (Label20.Caption)
 End If
 '保存当前的时间
 t = Time
 Dim h1 As String
 Dim h2 As String
'连接数据库
 Dim db As Connection
Set db = New Connection
db.CursorLocation = adUseClient
db.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "\db1.mdb;" & "Persist Security Info=False;"
Set rs = New Recordset
Set rs2 = New Recordset
'打开数据表“地下水评价信息表”
rs.Open "select * from 地下水评价信息表 ", db, adOpenStatic, adLockOptimistic
 rs.AddNew   '存入数据表中相应的字段
rs("监测地点") = Trim(Text21.Text)
rs("监测日期") = Label23.Caption
rs("监测时间") = t
rs("监测项目数量") = n
rs("评价结果") = Label25.Caption
 


 '打开数据表“地下水监测值记录表”
rs2.Open "select * from 地下水监测值记录表 ", db, adOpenStatic, adLockOptimistic
 rs2.AddNew    '存入数据表中相应的字段
 
 rs2("PH值") = Trim(Text1.Text)
 rs2("氨氮(NH4)(mg/L)") = Trim(Text2.Text)
 rs2("硝酸盐(以N计)(mg/L)") = Trim(Text3.Text)
 rs2("亚硝酸盐(以N计)(mg/L)") = Trim(Text4.Text)
 rs2("挥发性酚类(以苯酚计)(mg/L)") = Trim(Text5.Text)
 rs2("氰化物(mg/L)") = Trim(Text6.Text)
 rs2("砷(As)(mg/L)") = Trim(Text7.Text)
 rs2("汞(Hg)(mg/L)") = Trim(Text8.Text)
 rs2("铬(六价)(Cr6+)(mg/L)") = Trim(Text9.Text)
 rs2("总硬度(以CaCO3计)(mg/L)") = Trim(Text10.Text)
 rs2("铅(Pb)(mg/L)") = Trim(Text11.Text)
 rs2("氟化物(mg/L)") = Trim(Text12.Text)
 rs2("镉(Cd)(mg/L)") = Trim(Text13.Text)
 rs2("铁(Fe)(mg/L)") = Trim(Text14.Text)
 rs2("锰(Mn)(mg/L)") = Trim(Text15.Text)
 rs2("溶解性总固体(mg/L)") = Trim(Text16.Text)
 rs2("高锰酸盐指数(mg/L)") = Trim(Text17.Text)
 rs2("硫酸盐(mg/L)") = Trim(Text18.Text)
 rs2("氯化物(mg/L)") = Trim(Text19.Text)
 rs2("总大肠菌群(个/L)") = Trim(Text20.Text)
 rs2.Update
 
 
'存入数据表"地下水监测值记录表"中相应的字段
 
rs("监测值记录表编号") = rs2("编号")
rs.Update



End Sub


Private Sub Command2_Click() '清空所有文本框和评价结果
ClearText
Label25.Caption = ""
End Sub

Private Sub Command3_Click() '关闭窗体
Unload Me

End Sub

Private Sub Command4_Click() '显示信息查询窗体
FrmGroundWater2.Show
End Sub

Private Sub Form_Load() '用函数BackG使Pic1的图片随窗体大小的变化而变化,作为窗体背景
Me.AutoRedraw = True
Pic1.Visible = False
Pic1.BorderStyle = 0
Pic1.AutoSize = True
Pic1.Picture = LoadPicture(App.Path + "\03.gif")
BackG Me, Pic1
Label23.Caption = Date

End Sub
Private Sub Form_resize()
BackG Me, Pic1
End Sub

Private Sub Check1_Click() '被选中时显示文本框,否则不显示
If Check1.Value = 1 Then
     Text1.Visible = True
Else
     Text1.Visible = False
     Text1.Text = ""
     Label1.Caption = ""
 f1 = 0
End If
End Sub

Private Sub Check10_Click() '被选中时显示文本框,否则不显示
If Check10.Value = 1 Then
     Text10.Visible = True
Else
     Text10.Visible = False
          Text10.Text = ""
Label10.Caption = ""
f10 = 0
End If
End Sub

Private Sub Check11_Click() '被选中时显示文本框,否则不显示
If Check11.Value = 1 Then
Text11.Visible = True
Else
     Text11.Visible = False
          Text11.Text = ""
Label11.Caption = ""
f11 = 0
End If
End Sub

Private Sub Check12_Click() '被选中时显示文本框,否则不显示
If Check12.Value = 1 Then
Text12.Visible = True
Else
     Text12.Visible = False
          Text12.Text = ""
Label12.Caption = ""
f12 = 0
End If
End Sub

Private Sub Check13_Click() '被选中时显示文本框,否则不显示
If Check13.Value = 1 Then
Text13.Visible = True
Else
     Text13.Visible = False
          Text13.Text = ""
Label13.Caption = ""
f13 = 0
End If
End Sub

Private Sub Check14_Click() '被选中时显示文本框,否则不显示
If Check14.Value = 1 Then
Text14.Visible = True
Else
     Text14.Visible = False
          Text14.Text = ""
Label14.Caption = ""
f14 = 0
End If
End Sub

Private Sub Check15_Click() '被选中时显示文本框,否则不显示
If Check15.Value = 1 Then
Text15.Visible = True
Else
     Text15.Visible = False
          Text15.Text = ""
Label15.Caption = ""
f15 = 0
End If
End Sub

Private Sub Check16_Click() '被选中时显示文本框,否则不显示
If Check16.Value = 1 Then
Text16.Visible = True
Else
     Text16.Visible = False
          Text16.Text = ""
Label16.Caption = ""
f16 = 0
End If
End Sub

Private Sub Check17_Click() '被选中时显示文本框,否则不显示
If Check17.Value = 1 Then
Text17.Visible = True
Else
     Text17.Visible = False
          Text16.Text = ""
Label17.Caption = ""
f17 = 0
End If
End Sub

Private Sub Check18_Click() '被选中时显示文本框,否则不显示
If Check18.Value = 1 Then
Text18.Visible = True
Else
     Text18.Visible = False
          Text18.Text = ""
Label18.Caption = ""
f18 = 0
End If
End Sub

Private Sub Check19_Click() '被选中时显示文本框,否则不显示
If Check19.Value = 1 Then
Text19.Visible = True
Else
     Text19.Visible = False
          Text19.Text = ""
Label19.Caption = ""
f19 = 0
End If
End Sub

Private Sub Check2_Click() '被选中时显示文本框,否则不显示
If Check2.Value = 1 Then
Text2.Visible = True
Else
     Text2.Visible = False
          Text2.Text = ""
Label2.Caption = ""
f2 = 0
End If
End Sub

Private Sub Check20_Click() '被选中时显示文本框,否则不显示
If Check20.Value = 1 Then
Text20.Visible = True
Else
     Text20.Visible = False
          Text20.Text = ""
Label20.Caption = ""
f20 = 0
End If
End Sub

Private Sub Check3_Click() '被选中时显示文本框,否则不显示
If Check3.Value = 1 Then
Text3.Visible = True
Else
     Text3.Visible = False
          Text3.Text = ""
Label3.Caption = ""
f3 = 0
End If
End Sub

Private Sub Check4_Click() '被选中时显示文本框,否则不显示
If Check4.Value = 1 Then
Text4.Visible = True
Else
     Text4.Visible = False
          Text4.Text = ""
Label4.Caption = ""
f4 = 0
End If
End Sub

Private Sub Check5_Click() '被选中时显示文本框,否则不显示
If Check5.Value = 1 Then
Text5.Visible = True
Else
     Text5.Visible = False
          Text5.Text = ""
Label5.Caption = ""
f5 = 0
End If
End Sub

Private Sub Check6_Click() '被选中时显示文本框,否则不显示
If Check6.Value = 1 Then
Text6.Visible = True
Else
     Text6.Visible = False
          Text6.Text = ""
Label6.Caption = ""
f6 = 0
End If
End Sub

Private Sub Check7_Click() '被选中时显示文本框,否则不显示
If Check7.Value = 1 Then
Text7.Visible = True
Else
     Text7.Visible = False
          Text7.Text = ""
Label7.Caption = ""
f7 = 0
End If
End Sub

Private Sub Check8_Click() '被选中时显示文本框,否则不显示
If Check8.Value = 1 Then
Text8.Visible = True
Else
     Text8.Visible = False
          Text8.Text = ""
Label8.Caption = ""
f8 = 0
End If
End Sub

Private Sub Check9_Click() '被选中时显示文本框,否则不显示
If Check9.Value = 1 Then
Text9.Visible = True
Else
     Text9.Visible = False
          Text9.Text = ""
        Label9.Caption = ""
        f9 = 0
End If
End Sub





Private Sub Text1_Change()
'根据不同的文本框输入值标签显示不同的水质类别,以下其他文本框相似
If Val(Text1.Text) < 0 Then
   MsgBox "请输入合理的ph值!", vbOKOnly + vbExclamation, "提示"
   Exit Sub
ElseIf Val(Text1.Text) >= 6.5 And Val(Text1.Text) <= 8.5 Then
     Label1.Caption = "Ⅰ类"
     f1 = 0
ElseIf Val(Text1.Text) >= 5.5 And Val(Text1.Text) < 6.5 Then
     Label1.Caption = "Ⅳ类"
     f1 = 6