Private Sub Command5_Click()
Dim i
For i = 0 To 1 Step 0.001
Picture1.PSet (i, i), QBColor(4)
Next i
Dim x
For x = 0.35 To 0.88 Step 0.0001
Picture1.PSet (x, 0.5032 * x ^ 2 - 0.0866 * x + 0.5679), QBColor(2)
Next x
Dim j
For j = 0.12 To 0.35 Step 0.0001
Picture1.PSet (j, -1.3928 * j ^ 2 + 1.2302 * j + 0.3364), QBColor(3)
Next j
Dim y
For y = 0 To 0.12 Step 0.0001
Picture1.PSet (y, 289.2 * y ^ 3 - 88.417 * y ^ 2 + 10.312 * y + 0.0013), QBColor(5)
Next y



Picture1.Scale (-0.1, 1)-(1, -0.1)
Picture1.Line (0, 0)-(1, 0)        '画X轴
Picture1.Line (0, 0)-(0, 1)        '画Y轴

Dim Ma
Dim Mb
Ma = 46                           '乙醇的摩尔质量
Mb = 18                           '水的摩尔质量
                                  '原料液、塔顶、塔底产品的摩尔分数
Dim Xf As Double
Dim Xd As Double
Dim Xw As Double
Xf = (Val(Text2.Text) / (100 * Ma)) / (Val(Text2.Text) / (100 * Ma) + (100 - Val(Text2.Text)) / (100 * Mb))
Xd = (Val(Text4.Text) / (100 * Ma)) / (Val(Text4.Text) / (100 * Ma) + (100 - Val(Text4.Text)) / (100 * Mb))
Xw = (Val(Text5.Text) / (100 * Ma)) / (Val(Text5.Text) / (100 * Ma) + (100 - Val(Text5.Text)) / (100 * Mb))
                              '原料液、塔顶、塔底产品的平均摩尔质量
Dim Mf
Dim Md
Dim Mw
Mf = Xf * Ma + (1 - Xf) * Mb
Md = Xd * Ma + (1 - Xd) * Mb
Mw = Xw * Ma + (1 - Xw) * Mb
                                   '物料横算
Dim F As Double   '进料量
Dim D As Double   '塔顶产品量
Dim W As Double   '塔底产品量
F = (Val(Text1.Text) * Val(Text2.Text) * 0.8 + Val(Text1.Text) * (100 - Val(Text2.Text)) * 1) / (100 * Mf)
D = ((Xf - Xw) * F) / (Xd - Xw)
W = F - D
                                 '计算 q
Dim tm, t_                                        '泡点温度,进料板温度
tm = -803.08 * Xf ^ 5 + 2063.4 * Xf ^ 4 - 1985.2 * Xf ^ 3 + 893.91 * Xf ^ 2 - 197.7 * Xf + 99.448
t_ = (tm + Val(Text6.Text)) / 2
Dim c1, c2
c1 = 0.0001 * t_ ^ 2 + 0.0158 * t_ + 5.7111                    '乙醇的比热
c2 = 0.00002 * t_ ^ 2 - 0.0015 * t_ + 4.2075
  
Dim r1, r2
r1 = -0.0108 * t_ ^ 2 - 3.8501 * t_ + 2521.5                            '乙醇的汽化热
r2 = -0.0014 * t_ ^ 2 - 2.1819 * t_ + 2490.7                   '水的汽化热
Dim r_, C
r_ = Xf * r1 * Ma + (1 - Xf) * r2 * Mb           '平均汽化热
C = Xf * c1 * Ma + (1 - Xf) * c2 * Mb           '平均比热容
Dim q
q = (C * (tm - (Val(Text6.Text))) + r_) / r_
Dim t
For t = Xf To Xd Step 0.001
Picture1.PSet (t, (q / (q - 1)) * t - Xf / (q - 1)) 'q线
Next t
                                 '计算 R
Dim Yq, Xq, Rmin
Dim R As Double
Xq = (-(q / (q - 1) - 1.2302) + Sqr((q / (q - 1) - 1.2302) ^ 2 - 4 * 1.3928 * (-Xf / (q - 1) - 0.3364))) / (2 * 1.3928)
Yq = (q / (q - 1)) * Xq - Xf / (q - 1)

Rmin = (Xd - Yq) / (Yq - Xq)
R = 2 * Rmin

Dim L As Double, V As Double
L = R * D
V = (R + 1) * D
            Dim M As Double
            Dim Yd As Double
            Dim Yw
            Yd = Xd
            Yw = Xw
            M = (D * Xd) / V
            Picture1.Line (Xd, 0)-(Xd, Xd)             '画Xd,Xw,Xf线
            Picture1.Line (Xf, 0)-(Xf, Xf)
            Picture1.Line (Xw, 0)-(Xw, Xw)
            Dim X1 As Double, Y1 As Double
            X1 = (M + Xf / (q - 1)) / (q / (q - 1) - R / (R + 1))
            Y1 = q / (q - 1) * X1 - Xf / (q - 1)
            
            Picture1.Line (0, M)-(Xd, Yd)               '精馏线
            Picture1.Line (Xw, Yw)-(X1, Y1)             '画提馏线
            




Dim newXd As Double
newXd = Xd

Dim newY As Double
newY = hanshu(Xd, R, M, newXd, L, F, W, V, Xw, X1)
        Do While newY > Yw
        newY = hanshu(Xd, newY, R, M, newXd, L, F, W, V, Xw, X1)
        Loop



End Sub


Function GetX(oldY As Double) As Double
GetX = (0.0866 + Sqr(0.0866 ^ 2 - 4 * 0.5032 * (0.5679 - oldY))) / (2 * 0.5032)
End Function

Function GetY(oldX As Double, R As Double, M As Double) As Double

GetY = (R * oldX) / (R + 1) + M
End Function


Function GetSecondX(oldY As Double) As Double
Get2X = (1.2302 - Sqr(1.2302 ^ 2 - 4 * 1.3928 * (oldY - 0.3364))) / (2 * 1.3928)            '0.437< Y1 < 0.59
End Function

Function Get2Y(oldX As Double, L As Double, V As Double, W As Double, F As Double, Xw As Double) As Double
Get2Y = ((L + F) * oldX) / V - (W * Xw) / V
End Function


Function Get3X(oldY As Double) As Double
Get3X = (7.542 - Sqr(7.542 ^ 2 - 4 * 31.702 * (oldY - 0.0151))) / (2 * 31.702)         'Xw--0.437
End Function




Private Function hanshu(ByRef newX As Double, newY As Double, newXd As Double, R As Double, M As Double, Xd As Double, L As Double, V As Double, W As Double, F As Double, Xw As Double, X1 As Double) As Double

Dim x As Double
Dim y As Double

If x >= 0.35 Then
x = GetX(newY)
y = GetY(x, R, M)

Else
If x >= X1 Or x < 0.35 Then
x = Get2X(newY)
y = GetY(x, R, M)

Else
If x > 0.12 Or x < X1 Then
x = Get2X(newY)
y = Get2Y(x, L, F, W, V, Xw)
Else
If x > Xw Or x < 0.12 Then
x = Get3X(newY)
y = Get2Y(x, L, F, W, V, Xw)

End If
End If
End If
End If

Picture1.Line (newX, newY)-(x, newY)
Picture1.Line (x, newY)-(x, y)
newX = x
hanshu = y

End Function