📄 frmpollutedwater1.frm
字号:
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 720
TabIndex = 41
Top = 5250
Width = 1455
End
Begin VB.Label Label6
BackColor = &H00FCB370&
Caption = " 化学需氧量 (铬法)CODCr"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 720
TabIndex = 40
Top = 6000
Width = 1455
End
Begin VB.Label Label14
BackColor = &H00FCB370&
Caption = "请输入每种污染物对不同污染程度的隶属度和该污染物的权重值后进行水污染程度的评价！"
BeginProperty Font
Name = "幼圆"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1440
TabIndex = 39
Top = 600
Width = 9735
End
Begin VB.Label Label7
BackColor = &H00FCB370&
Caption = "清洁隶属度"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2880
TabIndex = 38
Top = 1320
Width = 1095
End
Begin VB.Label Label8
BackColor = &H00FCB370&
Caption = "轻污染隶属度"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 4560
TabIndex = 37
Top = 1320
Width = 1335
End
Begin VB.Label Label9
BackColor = &H00FCB370&
Caption = "中污染隶属度"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 6360
TabIndex = 36
Top = 1320
Width = 1335
End
Begin VB.Label Label10
BackColor = &H00FCB370&
Caption = "重污染隶属度"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 8160
TabIndex = 35
Top = 1320
Width = 1335
End
Begin VB.Label Label11
BackColor = &H00FCB370&
Caption = "污染物权重"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 10080
TabIndex = 34
Top = 1320
Width = 1095
End
Begin VB.Label Label12
BackColor = &H00FCB370&
Caption = "评价结果："
BeginProperty Font
Name = "幼圆"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 840
TabIndex = 33
Top = 7800
Width = 1335
End
Begin VB.Label Label13
BackColor = &H00FCB370&
Caption = " "
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2640
TabIndex = 32
Top = 7800
Width = 5655
End
End
Attribute VB_Name = "FrmPollutedWater1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'定义变量来保存文本框中的各隶属度值和权重值
Dim m1 As Double
Dim m2 As Double
Dim m3 As Double
Dim m4 As Double
Dim m5 As Double
Dim m6 As Double
Dim m7 As Double
Dim m8 As Double
Dim m9 As Double
Dim m10 As Double
Dim m11 As Double
Dim m12 As Double
Dim m13 As Double
Dim m14 As Double
Dim m15 As Double
Dim m16 As Double
Dim m17 As Double
Dim m18 As Double
Dim m19 As Double
Dim m20 As Double
Dim m21 As Double
Dim m22 As Double
Dim m23 As Double
Dim m24 As Double
Dim m25 As Double
Dim m26 As Double
Dim m27 As Double
Dim m28 As Double
Dim m29 As Double
Dim m30 As Double
'定义变量保存归一化权重值
Dim a1 As Double
Dim a2 As Double
Dim a3 As Double
Dim a4 As Double
Dim a5 As Double
Dim a6 As Double
'定义变量保存综合评价结果向量的值
Dim r1 As Double
Dim r2 As Double
Dim r3 As Double
Dim r4 As Double
Dim i As Integer
Dim j As Integer
Private Sub BackG(f As Form, pic As PictureBox) '定义一个根据窗体大小变化而变化的显示背景的过程
For i = 0 To (f.ScaleWidth \ pic.Width)
For j = 0 To (f.ScaleHeight \ pic.Height)
PaintPicture pic.Picture, i * pic.Width, j * pic.Height
Next
Next
End Sub
Private Sub Form_Load()
Me.AutoRedraw = True
Pic1.Visible = False
Pic1.BorderStyle = 0
Pic1.AutoSize = True
Pic1.Picture = LoadPicture(App.Path + "\03.gif")
BackG Me, Pic1
End Sub
Private Sub Form_resize()
BackG Me, Pic1
End Sub
Public Sub ClearText() '这是一个清除窗体上所有文本框的过程
Dim x As Object '声明一个对象型变量x
For Each x In Me.Controls '用for each循环可以对所有对象起作用而不必事先知道共有多少对象
If TypeOf x Is TextBox Then '判断对象的类型是不是文本框
x.Text = "" '如果是就把框中内容清空为空字符串
End If
Next x
End Sub
Private Sub Command1_Click()
Dim x As Object '声明一个对象型变量x
For Each x In Me.Controls '用for each循环可以对所有对象起作用而不必事先知道共有多少对象
If TypeOf x Is TextBox Then '判断对象的类型是不是文本框
If x.Text = "" Then '如果框中内容为空字符串则提示
MsgBox "请将数据全部输入后再进行评价！", vbOKOnly + vbExclamation, "提示"
Exit Sub
'ElseIf Val(x.Text) > 1 Or Val(x.Text) < 0 Then '如果框中内容值>1则提示
'MsgBox "请输入合理的数据！数值的范围是[0,1]", vbOKOnly + vbExclamation, "提示"
'Exit Sub
End If
End If
Next x
'取值保存
m1 = Val(Text1.Text)
m2 = Val(Text2.Text)
m3 = Val(Text3.Text)
m4 = Val(Text4.Text)
m5 = Val(Text5.Text)
m6 = Val(Text6.Text)
m7 = Val(Text7.Text)
m8 = Val(Text8.Text)
m9 = Val(Text9.Text)
m10 = Val(Text10.Text)
m11 = Val(Text11.Text)
m12 = Val(Text12.Text)
m13 = Val(Text13.Text)
m14 = Val(Text14.Text)
m15 = Val(Text15.Text)
m16 = Val(Text16.Text)
m17 = Val(Text17.Text)
m18 = Val(Text18.Text)
m19 = Val(Text19.Text)
m20 = Val(Text20.Text)
m21 = Val(Text21.Text)
m22 = Val(Text22.Text)
m23 = Val(Text23.Text)
m24 = Val(Text24.Text)
m25 = Val(Text25.Text)
m26 = Val(Text26.Text)
m27 = Val(Text27.Text)
m28 = Val(Text28.Text)
m29 = Val(Text29.Text)
m30 = Val(Text30.Text)
If (m5 + m10 + m15 + m20 + m25 + m30) = 0 Then
MsgBox "权重值不合理，请重新输入", vbOKOnly + vbExclamation, "提示"
Exit Sub
End If
'将权重值归一化
a1 = m5 / (m5 + m10 + m15 + m20 + m25 + m30)
a2 = m10 / (m5 + m10 + m15 + m20 + m25 + m30)
a3 = m15 / (m5 + m10 + m15 + m20 + m25 + m30)
a4 = m20 / (m5 + m10 + m15 + m20 + m25 + m30)
a5 = m25 / (m5 + m10 + m15 + m20 + m25 + m30)
a6 = m30 / (m5 + m10 + m15 + m20 + m25 + m30)
'权重矩阵与隶属度矩阵相乘得出综合评价结果向量(r1,r2,r3,r4)
r1 = (a1 * m1) + (a2 * m6) + (a3 * m11) + (a4 * m16) + (a5 * m21) + (a6 * m26)
r2 = (a1 * m2) + (a2 * m7) + (a3 * m12) + (a4 * m17) + (a5 * m22) + (a6 * m27)
r3 = (a1 * m3) + (a2 * m8) + (a3 * m13) + (a4 * m18) + (a5 * m23) + (a6 * m28)
r4 = (a1 * m4) + (a2 * m9) + (a3 * m14) + (a4 * m19) + (a5 * m24) + (a6 * m29)
'取最大值得出评价结果
If r1 >= r2 And r1 >= r3 And r1 >= r4 Then
Label13.Caption = "水污染程度为“清洁”"
ElseIf r2 >= r1 And r2 >= r3 And r2 >= r4 Then
Label13.Caption = "水污染程度为“轻污染”"
ElseIf r3 >= r1 And r3 >= r2 And r3 >= r4 Then
Label13.Caption = "水污染程度为“中污染”"
ElseIf r4 >= r1 And r3 >= r2 And r4 >= r3 Then
Label13.Caption = "水污染程度为“重污染”"
End If
End Sub
Private Sub Command2_Click()
ClearText
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -