📄 form1.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 4020
ClientLeft = 60
ClientTop = 390
ClientWidth = 5925
LinkTopic = "Form1"
ScaleHeight = 4020
ScaleWidth = 5925
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command8
Caption = "Command8"
Height = 615
Left = 4920
TabIndex = 14
Top = 960
Width = 855
End
Begin VB.CommandButton Command7
Caption = "非均质参数输出"
Height = 375
Left = 1920
TabIndex = 13
Top = 2040
Width = 1455
End
Begin VB.CommandButton Command6
Caption = "计算"
Height = 375
Left = 1080
TabIndex = 12
Top = 2040
Width = 855
End
Begin VB.CommandButton Command5
Caption = "孔渗读数"
Height = 375
Left = 240
TabIndex = 11
Top = 2040
Width = 855
End
Begin VB.CommandButton Command10
Caption = "回 0"
BeginProperty Font
Name = "黑体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3960
TabIndex = 10
Top = 1080
Width = 975
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 4440
Top = 2760
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.TextBox Text4
Height = 375
Left = 2160
TabIndex = 7
Text = "0"
Top = 1440
Width = 975
End
Begin VB.TextBox Text3
Height = 375
Left = 840
TabIndex = 6
Text = "10000"
Top = 1440
Width = 975
End
Begin VB.TextBox Text2
Height = 375
Left = 2160
TabIndex = 5
Text = "0"
Top = 840
Width = 975
End
Begin VB.TextBox Text1
Height = 375
Left = 840
TabIndex = 4
Text = "10000"
Top = 840
Width = 975
End
Begin VB.CommandButton Command4
Caption = "孔渗结果输出"
Height = 375
Left = 3120
TabIndex = 3
Top = 120
Width = 1455
End
Begin VB.CommandButton Command3
Caption = "计算"
Height = 375
Left = 2160
TabIndex = 2
Top = 120
Width = 975
End
Begin VB.CommandButton Command2
Caption = "读测井"
Height = 375
Left = 1200
TabIndex = 1
Top = 120
Width = 975
End
Begin VB.CommandButton Command1
Caption = "读分层"
Height = 375
Left = 240
TabIndex = 0
Top = 120
Width = 975
End
Begin VB.Label Label1
BackColor = &H0080C0FF&
Caption = "e1f3顶底"
Height = 375
Left = 0
TabIndex = 9
Top = 840
Width = 735
End
Begin VB.Label Label2
BackColor = &H0080C0FF&
Caption = "e1f1顶底"
Height = 375
Left = 0
TabIndex = 8
Top = 1440
Width = 735
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim t(300000), h(300000), h1(300000), h2(300000), p(300000), k(300000), c(300000), xc(300000) As Single
Dim m1, m2, m3, m4, m5, m6, g1, g2, g3, g4 As Single
Dim hh1, hh2, s As Single
Dim mx(60), md(60), mj(60), mz(60), k1(55, 200), p1(55, 200), kp(55, 200) As Single
Dim n1, n2, n11, n12, n13, w As Integer
Dim kuc2(55, 200), kuc3(55), kluc(60) As Single
Dim pp(60), kk(60), ppp(60), kkk(60), kh(60), kb(60), m(300), klup(60), k11(300) As Single
Private Sub Command1_Click()
Cls
CommonDialog1.Filter = "(*.txt)|*.txt"
CommonDialog1.ShowOpen
On Error GoTo trip
Open CommonDialog1.FileName For Input As #1
n1 = 1
Do While Not EOF(1)
Input #1, c(n1), h1(n1), h2(n1)
n1 = n1 + 1
Loop
Close #1
trip: End Sub
Private Sub Command10_Click()
For i = 1 To n2 - 1
p(i) = 0
k(i) = 0
xc(i) = 0
Next i
Cls
Form1.Cls
trip: End Sub
Private Sub Command2_Click()
Cls
CommonDialog1.Filter = "(*.txt)|*.txt"
CommonDialog1.ShowOpen
On Error GoTo trip
Open CommonDialog1.FileName For Input As #2
n2 = 1
Do While Not EOF(2)
Input #2, h(n2), t(n2)
n2 = n2 + 1
Loop
Close #2
trip: End Sub
Private Sub Command3_Click()
For i = 1 To n2 - 1
For j = 1 To n1 - 1
If h(i) > h1(j) And h(i) < h2(j) Then
p(i) = (t(i) - 180) / 6.0293
k(i) = Exp(0.4699 * p(i) - 8.3188)
xc(i) = c(j)
End If
Next j
Next i
End Sub
Private Sub Command4_Click()
CommonDialog1.Filter = "(*.txt)|*.txt"
CommonDialog1.ShowSave
On Error GoTo trip
file1 = CommonDialog1.FileName
Open file1 For Output As #3
For i = 1 To n2 - 1
If xc(i) = 0 Then
Print #3, 0, Format(h(i), "####.00"), 0, 0
Else
Print #3, xc(i), Format(h(i), "####.00"), Format(p(i), "##0.00"), Format(k(i), "##0.00")
End If
Next i
Close #3
trip: End Sub
Private Sub Command5_Click()
Cls
CommonDialog1.Filter = "(*.txt)|*.txt"
CommonDialog1.ShowOpen
On Error GoTo trip
Open CommonDialog1.FileName For Input As #11
n11 = 1
Do While Not EOF(11)
Input #11, xc(n11), h(n11), p(n11), k(n11)
n11 = n11 + 1
Loop
Close #11
trip: End Sub
Private Sub Command6_Click()
For j = 1 To 51
For i = 1 To n11 - 1
If xc(i) = j Then
m(j) = m(j) + 1
pp(j) = pp(j) + p(i)
kk(j) = kk(j) + k(i)
p1(j, m(j)) = p(i)
k1(j, m(j)) = k(i)
Else
End If
Next i
Next j
For j = 1 To 51
For o = 1 To m(j) - 1
For w = o + 1 To m(j)
If k1(j, o) > k1(j, w) Then
GoTo 100
Else
s = k1(j, o)
k1(j, o) = k1(j, w)
k1(j, w) = s
100 End If
Next w
Next o
Next j
For j = 1 To 51
If m(j) > 1 Then
ppp(j) = pp(j) / m(j)
kkk(j) = kk(j) / m(j)
Else
ppp(j) = 0
kkk(j) = 0
End If
Next j
For j = 1 To 51
For o = 1 To m(j)
kp(j, o) = (k1(j, o) - kkk(j)) ^ 2
Next o
Next j
For j = 1 To 51
For o = 1 To m(j)
kh(j) = kh(j) + kp(j, o)
Next o
Next j
For j = 1 To 51
If kkk(j) > 0.001 Then
kb(j) = (Sqr(kh(j) / (m(j) - 1))) / kkk(j)
Else
kb(j) = 0
End If
Next j
For j = 1 To 51
mx(j) = kkk(j)
md(j) = kkk(j)
Next j
For j = 1 To 51
For o = 1 To m(j)
If mx(j) > k1(j, o) Then
mx(j) = k1(j, o)
Else
End If
Next o
Next j
For j = 1 To 51
For o = 1 To m(j)
If md(j) < k1(j, o) Then
md(j) = k1(j, o)
Else
End If
Next o
Next j
For j = 1 To 51
If kkk(j) = 0 Then
mz(j) = 0
mj(j) = 0
Else
mz(j) = md(j) / kkk(j)
mj(j) = md(j) / (mx(j) + 0.001)
End If
Next j
For j = 1 To 51
For o = 1 To m(j)
kuc2(j, o) = k1(j, o) * (m(j) + 1 - o)
Next o
Next j
For j = 1 To 51
For o = 1 To m(j)
kuc3(j) = kuc3(j) + kuc2(j, o)
Next o
Next j
For j = 1 To 51
If kkk(j) = 0 Then
kluc(j) = 0
Else
kluc(j) = 2 * kuc3(j) / (kk(j) * (m(j) - 1)) - 1
End If
Next j
For j = 1 To 51
For o = 1 To m(j) - 1
For w = o + 1 To m(j)
If k1(j, o) < k1(j, w) Then
GoTo 200
Else
s = k1(j, o)
k1(j, o) = k1(j, w)
k1(j, w) = s
200 End If
Next w
Next o
Next j
For j = 1 To 51
For o = 1 To m(j)
k11(j) = k11(j) + k1(j, o)
klup(j) = klup(j) + (Abs((o / (m(j))) - k11(j) / kk(j))) / (o / (m(j)))
Next o
Next j
For j = 1 To 51
If m(j) = 0 Then
klup(j) = 0
Else
klup(j) = klup(j) / m(j)
End If
Next j
End Sub
Private Sub Command7_Click()
CommonDialog1.Filter = "(*.txt)|*.txt"
CommonDialog1.ShowSave
On Error GoTo trip
file1 = CommonDialog1.FileName
Open file1 For Output As #23
Print #23, "N", "P", "K", "σ", "Jca", "Jxs", "lunc", "lup"
For i = 1 To 51
If ppp(i) = 0 Then
Print #23, i, 0, 0, 0, 0, 0, 0, 0
Else
Print #23, i, Format(ppp(i), "##0.00"), Format(kkk(i), "##0.00"), Format(kb(i), "##0.00"), Format(mj(i), "##0.00"), Format(mz(i), "##0.00"), Format(kluc(i), "##0.00"), Format(klup(i), "##0.00")
End If
Next i
Close #23
trip: End Sub
Private Sub Command8_Click()
CommonDialog1.Filter = "(*.txt)|*.txt"
CommonDialog1.ShowSave
On Error GoTo trip
file1 = CommonDialog1.FileName
Open file1 For Output As #24
For i = 1 To 51
Print #24, i, Format(mx(i), "##0.00"), Format(md(i), "##0.00"), Format(kkk(i), "##0.00")
Next i
Close #24
trip: End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -