frmw1.frm

主要用作环境影响评价中高架点源烟气预测模拟。运行前需要修改frmw1窗体中date1控件的datebasename属性

  End Function
Public Sub ar(w, X, a1, a2, r1, r2)                                       '有风时根据稳定度选择参数a1,a2,r1,r2
If w = "D" Or w >= "E" Then
  If X < 1000 Then
   a1 = txtFields(8): r1 = txtFields(10): a2 = txtFields(12): r2 = txtFields(15)
   ElseIf X >= 1000 And X < 10000 Then
   a1 = txtFields(9): r1 = txtFields(11): a2 = txtFields(13): r2 = txtFields(16)
   Else: a1 = txtFields(9): r1 = txtFields(11): a2 = txtFields(14): r2 = txtFields(17)
   End If
ElseIf w = "D-E" Or w = "C-D" Then
   If X < 1000 Then
   a1 = txtFields(8): r1 = txtFields(10): a2 = txtFields(12): r2 = txtFields(15)
   ElseIf X >= 1000 And X < 2000 Then
   a1 = txtFields(9): r1 = txtFields(11): a2 = txtFields(12): r2 = txtFields(15)
   ElseIf X >= 2000 And X < 10000 Then
   a1 = txtFields(9): r1 = txtFields(11): a2 = txtFields(13): r2 = txtFields(16)
   Else: a1 = txtFields(9): r1 = txtFields(11): a2 = txtFields(14): r2 = txtFields(17)
   End If
ElseIf w = "C" Then
   If X < 1000 Then
   a1 = txtFields(8): r1 = txtFields(10): a2 = txtFields(12): r2 = txtFields(15)
   Else: a1 = txtFields(9): r1 = txtFields(11): a2 = txtFields(12): r2 = txtFields(15)
   End If
ElseIf w = "A" Then
    If X < 300 Then
   a1 = txtFields(8): r1 = txtFields(10): a2 = txtFields(12): r2 = txtFields(15)
   ElseIf X >= 300 And X < 500 Then
   a1 = txtFields(8): r1 = txtFields(10): a2 = txtFields(13): r2 = txtFields(16)
   ElseIf X >= 500 And X < 1000 Then
   a1 = txtFields(8): r1 = txtFields(10): a2 = txtFields(14): r2 = txtFields(17)
   Else: a1 = txtFields(9): r1 = txtFields(11): a2 = txtFields(14): r2 = txtFields(17)
   End If
Else
    If X < 500 Then
    a1 = txtFields(8): r1 = txtFields(10): a2 = txtFields(12): r2 = txtFields(15)
    ElseIf X >= 500 And X < 1000 Then
    a1 = txtFields(8): r1 = txtFields(10): a2 = txtFields(13): r2 = txtFields(16)
    Else: a1 = txtFields(9): r1 = txtFields(11): a2 = txtFields(13): r2 = txtFields(16)
    End If
End If
End Sub

Public Function taisheng(h, pa, qv, ts, ta, vs, w2, u, d)                      '有风时烟羽有效高度的计算
qh = 0.35 * pa * qv * (ts - ta) / ts
If txtFields(0) <> "D-E" And txtFields(0) <= "D" Then
 If qh >= 2100 And t1 >= 35 Then
   If Option1 And qh < 21000 Then
    n0 = txtFields(22): n1 = txtFields(24): n2 = txtFields(26)
   ElseIf Option1 And qh >= 21000 Then
    n0 = txtFields(23): n1 = txtFields(25): n2 = txtFields(27)
   ElseIf Option2 And qh < 21000 Then
    n0 = txtFields(28): n1 = txtFields(30): n2 = txtFields(32)
   Else: n0 = txtFields(29): n1 = txtFields(31): n2 = txtFields(33)
   End If
    h2 = n0 * qh ^ n1 * h ^ n2 / u
 ElseIf 1700 < qh < 2100 And t1 >= 35 Then
   h3 = 2 * (1.5 * vs * d + 0.01 * qh) / u - 0.048 * (qh - 1700) / u
   h4 = n0 * qh ^ n1 * h ^ n2 / u: h2 = h3 + (h4 - h3) * (qh - 1700) / 400
 Else: h2 = 2 * (1.5 * vs * d + 0.01 * qh) / u
 End If
Else: h2 = qh ^ (1 / 3) * (w2 + 0.0098) ^ (1 / 3) * u ^ -(1 / 3)
End If
 he = h + h2
taisheng = he
End Function

  Public Sub draw(c, X, Y) '图形绘制操作
   If Label23.Caption = 1 Then
    If c > 0.7 Then Form3.Picture1.PSet (X, Y), RGB(1, 1, 1)
    If c > 0.5 And c <= 0.7 Then Form3.Picture1.PSet (X, Y), RGB(250, 0, 0)
    If c > 0.15 And c <= 0.5 Then Form3.Picture1.PSet (X, Y), QBColor(14)
    If c > 0.01 And c <= 0.15 Then Form3.Picture1.PSet (X, Y), RGB(0, 0, 250)
   ElseIf Label23.Caption = 2 Then
    If c > 1.5 Then Form3.Picture1.PSet (X, Y), RGB(1, 1, 1)
    If c > 1 And c <= 1.5 Then Form3.Picture1.PSet (X, Y), RGB(250, 0, 0)
    If c > 0.3 And c <= 1 Then Form3.Picture1.PSet (X, Y), QBColor(14)
    If c > 0.01 And c <= 0.3 Then Form3.Picture1.PSet (X, Y), RGB(0, 0, 250)
   Else:
    If c > 0.3 Then Form3.Picture1.PSet (X, Y), RGB(1, 1, 1)
    If c > 0.15 And c <= 0.3 Then Form3.Picture1.PSet (X, Y), RGB(250, 0, 0)
    If c > 0.1 And c <= 0.15 Then Form3.Picture1.PSet (X, Y), QBColor(14)
    If c > 0.01 And c <= 0.1 Then Form3.Picture1.PSet (X, Y), RGB(0, 0, 250)
   End If
End Sub

Public Sub canshu(q, h, u10, pa, w1, pa1, cp, qv, ts, ta, t1, vs, d, w2, w, a, b)   '获取参数
q = txtFields(1):     h = txtFields(2):    u10 = txtFields(3): pa = txtFields(4)
a = txtFields(7):    b = txtFields(36)
qv = txtFields(37): ts = txtFields(38):  ta = txtFields(39): t1 = txtFields(40)
vs = txtFields(41): d = txtFields(42):   w2 = txtFields(43): w = txtFields(0)
End Sub

Private Sub cmdAdd_Click()
  Data1.Recordset.AddNew
End Sub

Private Sub cmdDelete_Click()
  '如果删除记录集的最后一条记录
  '记录或记录集中唯一的记录
  Data1.Recordset.Delete
  Data1.Recordset.MoveNext
End Sub

Private Sub cmdRefresh_Click()
  frmw1.Hide: Form1.Show
End Sub

Private Sub cmdUpdate_Click()
  Data1.UpdateRecord
  Data1.Recordset.Bookmark = Data1.Recordset.LastModified
End Sub

Private Sub cmdClose_Click()
 End
End Sub

Private Sub Command1_Click() '有风时地面浓度图绘制
Call canshu(q, h, u10, pa, w1, pa1, cp, qv, ts, ta, t1, vs, d, w2, w, a, b)
Form3.Picture1.Scale (0, 3000)-(60000, -3000)                                      '建立坐标系


If Option1 Then p = txtFields(34) Else p = txtFields(35)                           '计算烟气出口处风速
u = u10 * (h / 10) ^ p

he = taisheng(h, pa, qv, ts, ta, vs, w2, u, d)

frmw1.Hide: Form3.Show
 For X = 100 To 60000 Step 120
  For Y = -3000 To 3000 Step 25
  Call ar(w, X, a1, a2, r1, r2)
   Y1 = r1 * X ^ a1: z1 = r2 * X ^ a2
   f = 2 * 2.7183 ^ -(he ^ 2 / (2 * z1 ^ 2))
   c = q / (2 * 3.1416 * u * Y1 * z1) * Exp(-Y ^ 2 * 0.5 / Y1 ^ 2) * f
   Call draw(c, X, Y)
  Next Y
 Next X

End Sub

Private Sub Command2_Click() '小风静风时地面浓度图绘制

Form3.Picture1.Scale (0, 3000)-(60000, -3000)
Call canshu(q, h, u10, pa, w1, pa1, cp, qv, ts, ta, t1, vs, d, w2, w, a, b)

If Option1 Then p = txtFields(34) Else p = txtFields(35)
u = u10 * (h / 10) ^ p

If u10 < 0.5 Then
r01 = txtFields(18): r02 = txtFields(20)                                          '根据风速选择r01,r02
Else: r01 = txtFields(19): r02 = txtFields(21)
End If

qh = 0.35 * pa * qv * (ts - ta) / ts
h2 = 5.5 * qh ^ 0.25 * (w2 + 0.0098) ^ -0.375                                     '计算烟羽有效高度
he = h + h2

frmw1.Hide: Form3.Show
For X = 0.1 To 60000 Step 150
 For Y = -5000 To 5000 Step 50
 n = Sqr(X ^ 2 + Y ^ 2 + (r01 / r02) ^ 2 * he ^ 2)
 s = u * X / (r01 * n)
  h3 = (s + 5) / 50
  s1 = 0.5 * h3 * (ff(-5) + ff(s))
  For i = 1 To 49
    s1 = s1 + ff(-5 + i * h3) * h3
   Next i
  g = Exp(-u ^ 2 / (2 * r01 ^ 2)) * (1 + Sqr(2 * 3.1416) * s * Exp(s ^ 2 * 0.5))
  c = 20 * q * g / (6.2832 ^ 1.5 * r02 * n ^ 2)
 
  Call draw(c, X, Y)
  
  Next Y
Next X
End Sub

Private Sub Command3_Click()  '熏烟模式地面浓度图的绘制
Form3.Picture1.Scale (0, 3000)-(60000, -3000)

Call canshu(q, h, u10, pa, w1, pa1, cp, qv, ts, ta, t1, vs, d, w2, w, a, b)

If Option1 Then p = txtFields(34) Else p = txtFields(35)
u = u10 * (h / 10) ^ p

qh = 0.35 * pa * qv * (ts - ta) / ts
If u10 >= 1.5 Then
  h2 = qh ^ (1 / 3) * (w2 + 0.0098) ^ (1 / 3) * u ^ -(1 / 3)
Else: h2 = 5.5 * qh ^ 0.25 * (w2 + 0.0098) ^ -0.375
End If
he = h + h2

frmw1.Hide: Form3.Show
 For X = 0.1 To 60000 Step 120
  For Y = -3000 To 3000 Step 25
   If X < 1000 Then
   a1 = txtFields(8): r1 = txtFields(10): a2 = txtFields(12): r2 = txtFields(15)
   ElseIf X >= 1000 And X < 10000 Then
   a1 = txtFields(9): r1 = txtFields(11): a2 = txtFields(13): r2 = txtFields(16)
   Else: a1 = txtFields(9): r1 = txtFields(11): a2 = txtFields(14): r2 = txtFields(17)
   End If
 Y1 = r1 * X ^ a1: z1 = r2 * X ^ a2
 y1f = Y1 + he / 8
 hf = he + 2.15 * z1
 c = q * Exp(-0.5 * Y ^ 2 / y1f ^ 2) / (Sqr(2 * 3.1416) * u * hf * y1f)
  Call draw(c, X, Y)
  Next Y
 Next X

End Sub

Private Sub Command4_Click()  '有风时的浓度列表
frmw1.Hide: Form2.Show: Form2.Cls
Call canshu(q, h, u10, pa, w1, pa1, cp, qv, ts, ta, t1, vs, d, w2, w, a, b)
Dim c As Single
If Option1 Then p = txtFields(34) Else p = txtFields(35)
u = u10 * (h / 10) ^ p

he = taisheng(h, pa, qv, ts, ta, vs, w2, u, d)

Form2.Print: Form2.Print: Form2.Print "     X\Y",
For j = 0 To 10
 Form2.Print j * b; "(m)",
Next j
Form2.Print: Form2.Print
For i = 0 To 25
  Form2.Print "  "; i * a; "(m)",
 For j = 0 To 10
   Y = j * b: X = i * a + 0.1
   Call ar(w, X, a1, a2, r1, r2)
   Y1 = r1 * X ^ a1: z1 = r2 * X ^ a2
   f = 2 * Exp(-he ^ 2 / (2 * z1 ^ 2))
   c = q / (2 * 3.1416 * u * Y1 * z1) * Exp(-Y ^ 2 * 0.5 / Y1 ^ 2) * f
   Form2.Print Int(c * 1000000) / 1000000,
 Next j
  Form2.Print: Form2.Print
 Next i

End Sub

Private Sub Command5_Click()  '小风静风时的浓度列表
frmw1.Hide: Form2.Show: Form2.Cls
Call canshu(q, h, u10, pa, w1, pa1, cp, qv, ts, ta, t1, vs, d, w2, w, a, b)

If Option1 Then p = txtFields(34) Else p = txtFields(35)
u = u10 * (h / 10) ^ p

If u10 < 0.5 Then r01 = txtFields(18): r02 = txtFields(20) Else r01 = txtFields(19): r02 = txtFields(21)

qh = 0.35 * pa * qv * (ts - ta) / ts
h2 = 5.5 * qh ^ 0.25 * (w2 + 0.0098) ^ -0.375
he = h + h2

Form2.Print: Form2.Print: Form2.Print "     X\Y",
For j = 0 To 10
 Form2.Print j * b; "(m)",
Next j
Form2.Print: Form2.Print
For i = 0 To 25
  Form2.Print "  "; i * a; "(m)",
 For j = 0 To 10
   Y = j * b: X = i * a + 0.1
   n = Sqr(X ^ 2 + Y ^ 2 + (r01 / r02) ^ 2 * he ^ 2)
   s = u * X / (r01 * n)
   h3 = (s + 5) / 70
   s1 = (Exp(-0.5 * s ^ 2) + Exp(-0.5 * 5 ^ 2)) * h3 / 2
  For k = 1 To 69
   s1 = s1 + Exp(-0.5 * (-5 + k * h3) ^ 2) * h3
   Next k
  s1 = 6.2832 ^ -0.5 * s1
 g = Exp(-u ^ 2 / (2 * r01 ^ 2)) * (1 + Sqr(2 * 3.1416) * s * Exp(s * s * 0.5) * s1)
 c = 20 * q * g / (6.2832 ^ 1.5 * r02 * n ^ 2)
  Form2.Print Int(c * 1000000) / 1000000,
  Next j
  Form2.Print: Form2.Print
 Next i
End Sub

Private Sub Command6_Click()  '熏烟模式的浓度列表
frmw1.Hide: Form2.Show: Form2.Cls
Call canshu(q, h, u10, pa, w1, pa1, cp, qv, ts, ta, t1, vs, d, w2, w, a, b)

If Option1 Then p = txtFields(34) Else p = txtFields(35)
u = u10 * (h / 10) ^ p

qh = 0.35 * pa * qv * (ts - ta) / ts
If u10 >= 1.5 Then
  h2 = qh ^ (1 / 3) * (w2 + 0.0098) ^ (1 / 3) * u ^ -(1 / 3)
Else: h2 = 5.5 * qh ^ 0.25 * (w2 + 0.0098) ^ -0.375
End If
he = h + h2

Form2.Print: Form2.Print: Form2.Print "     X\Y",
For j = 0 To 10
 Form2.Print j * b; "(m)",
Next j
Form2.Print: Form2.Print
For i = 0 To 25
  Form2.Print "  "; i * a; "(m)",
 For j = 0 To 10
  Y = j * b: X = i * a + 0.1
  If X < 1000 Then
   a1 = txtFields(8): r1 = txtFields(10): a2 = txtFields(12): r2 = txtFields(15)
   ElseIf X >= 1000 And X < 10000 Then
   a1 = txtFields(9): r1 = txtFields(11): a2 = txtFields(13): r2 = txtFields(16)
   Else: a1 = txtFields(9): r1 = txtFields(11): a2 = txtFields(14): r2 = txtFields(17)
   End If
  Y1 = r1 * X ^ a1: z1 = r2 * X ^ a2
  y1f = Y1 + he / 8
  hf = he + 2.15 * z1
  c = q * Exp(-0.5 * Y ^ 2 / y1f ^ 2) / (Sqr(2 * 3.1416) * u * hf * y1f)
  Form2.Print Int(c * 1000000) / 1000000,
  Next j
  Form2.Print: Form2.Print
 Next i

End Sub

Private Sub Command7_Click()  '有风时某点浓度
frmw1.Hide: Form4.Show
txtFields(6) = 1
End Sub

Private Sub Command8_Click()  '小风静风时某点浓度
frmw1.Hide: Form4.Show
txtFields(6) = 2
End Sub

Private Sub Command9_Click()  '熏烟时某点浓度
frmw1.Hide: Form4.Show
txtFields(6) = 3
End Sub

Private Sub Data1_Error(DataErr As Integer, Response As Integer)
  '这就是放置错误处理代码的地方
  '如果想忽略错误，注释掉下一行代码
  '如果想捕捉错误，在这里添加错误处理代码
  MsgBox "数据错误事件命中错误：" & Error$(DataErr)
  Response = 0  '忽略错误
End Sub

Private Sub Data1_Reposition()
  Screen.MousePointer = vbDefault
  On Error Resume Next
  '这将显示当前记录位置
  '为动态集和快照
  Data1.Caption = "记录：" & (Data1.Recordset.AbsolutePosition + 1)
  '对于 Table 对象，当记录集创建后并使用下面的行时，
  '必须设置 Index 属性
  'Data1.Caption = "记录：" & (Data1.Recordset.RecordCount * (Data1.Recordset.PercentPosition * 0.01)) + 1
End Sub

Private Sub Data1_Validate(Action As Integer, Save As Integer)
  '这是放置验证代码的地方
  '当下面的动作发生时，调用这个事件
  Select Case Action
    Case vbDataActionMoveFirst
    Case vbDataActionMovePrevious
    Case vbDataActionMoveNext
    Case vbDataActionMoveLast
    Case vbDataActionAddNew
    Case vbDataActionUpdate
    Case vbDataActionDelete
    Case vbDataActionFind
    Case vbDataActionBookmark
    Case vbDataActionClose
  End Select
  Screen.MousePointer = vbHourglass
End Sub

Private Sub txtFields_Change(Index As Integer)  'a1,a2,r1,r2在程序中标签的变化
If (frmw1.txtFields(0) = "D" Or frmw1.txtFields(0) = "E") Or frmw1.txtFields(0) >= "F" Then
 frmw1.Label14.Caption = "x=0-1000m": frmw1.Label15.Caption = "x=1000-10000m": frmw1.Label16.Caption = "x>=10000m"
 frmw1.Label17.Caption = "x=0-1000m": frmw1.Label18.Caption = "x=1000-10000m": frmw1.Label19.Caption = "x>=10000m"
ElseIf frmw1.txtFields(0) = "C-D" Or frmw1.txtFields(0) = "D-E" Then
 frmw1.Label14.Caption = "x=0-2000m": frmw1.Label15.Caption = "x=2000-10000m": frmw1.Label16.Caption = "x>=10000m"
 frmw1.Label17.Caption = "x=0-2000m": frmw1.Label18.Caption = "x=2000-10000m": frmw1.Label19.Caption = "x>=10000m"
ElseIf frmw1.txtFields(0) = "A" Then
 frmw1.Label14.Caption = "x=0-300m": frmw1.Label15.Caption = "x=300-500m": frmw1.Label16.Caption = "x>=500m"
 frmw1.Label17.Caption = "x=0-300m": frmw1.Label18.Caption = "x=300-500m": frmw1.Label19.Caption = "x>=500m"
ElseIf frmw1.txtFields(0) = "C" Then
 frmw1.Label14.Caption = "x>0": frmw1.Label15.Caption = "": frmw1.Label16.Caption = ""
 frmw1.Label17.Caption = "x>0": frmw1.Label18.Caption = "": frmw1.Label19.Caption = ""
Else: frmw1.Label14.Caption = "x=0-500m": frmw1.Label15.Caption = "x>=500m": frmw1.Label16.Caption = ""
      frmw1.Label17.Caption = "x=0-500m": frmw1.Label18.Caption = "x>=500m": frmw1.Label19.Caption = ""
End If
End Sub