1、申 请 I D：whounknown
2、个人邮箱：648292982@qq.com
3、原创技术文章：VB 编程制作实验数据处理软件。
思路：
（1）读取txt文本。txt文本里为以","隔开的两列数据，前一列为时间，后一列为光电流的值。
（2）提取特征数值，即每隔50 s 提取一个数值，而这一个数值为附近3个数值的平均值。
（3）进一步处理数值。隔100 s的两个数值之和的1/2减去中间50 s 的点的数值，得到一个实验结果数据。以此计算出不同时间的实验数组。
（4）由于数值存在负值和正值，统一对他们求绝对值。
（5）对（4）中求的值，取平均值，得到最终的实验结果。
（6）点击一次txt文本经历（1）-（5）步骤得到一个实验结果。只要依次点击一组txt就能求得一组实验数据。
（7）对于实验数据进行三种显示。1），作点线图（第（4）步数据）；2），在text文本框中集中显示，以便复制与直观比较；3），可以点击保存按钮将一组实验结果保存到以原始数据txt文件名 & 当前时间的为名的txt文件中，以便于在origin 文件中进行作图。操作界面：
代码：Dim A, B, fa, fp, fo, cdlgpath As String, fn, dn, temp, o(1000000), pw As String, S, D, n, i, h, z, nu As Integer
Dim j As String, k(1000), Y As String, la(1000000), ti, cu, cuss(1000000), cus(1000000), po As String, g(30) As Double
Dim num, f, p, r, t, cur(100000), ac(100000), min, max, cmin, cmax, aa, bb, co As Double
Private Sub Combo1_Change()
z = Val(Combo1.Text)
End Sub
Private Sub Command2_Click()
If TextSave.Text = "条件,平均值,最大值" Then
MsgBox "请先处理数据！", vbOKOnly, "胡浩提醒您"
Else
CDLG.Filter = "Text Document(*.txt)|*.txt" '保存格式为txt文本格式
If Right(File1.Path, 1) = "\" Then
File1.Path = File1.Path
Else
File1.Path = File1.Path & "\"
End If
CDLG.FileName = File1.Path & "\手动保存处理结果\" & Val(Str(Year(Now))) & "年" & Val(Str(Month(Now))) & "月" & Val(Str(Day(Now))) & "日" & Val(Str(Hour(Now))) & "时" & Val(Str(Minute(Now))) & "分-" & fn & "等"
CDLG.ShowSave '提示你选择保存文件的路径
Open CDLG.FileName For Output As 1
Print #1, TextSave.Text
Close #1
End If
End Sub
Private Sub File1_Click()
z = Val(Combo1.Text)
S = 0
D = 10
n = 0
h = 0
r = 0
f = 0
t = 0
num = 1
cmax = 0
cmin = 0
au = 0
dn = Dir1.Path
fn = Left(File1.FileName, Len(File1.FileName) - 4) '有光电流曲线数据的文本名
fp = File1.Path + "\" + File1.FileName '文本的路径加文本名
of = Dir2.Path + "\" + Text1.Text + ".txt" '储存处理过程及结果的文本名称，储存在TEXT1所定义的文本里
'打开文本
Open fp For Input As #1
Do While Not EOF(1)
Line Input #1, A
If Len(A) = 18 Then
B = Right(A, 10)
Else
B = Right(A, 9)
End If
If Val(Left(A, 7)) >= 0.1 Then t = Val(Left(A, 8))
cur(num) = Val(B) 'num对应的电流
'If cur(num) < cmin Then cmin = cur(num)
'If cur(num) > cmax Then cmax = cur(num)
num = num + 1
If (S - 24) > 100 And ((S + 20) Mod (z * 10) = 0 Or (S + 10) Mod (z * 10) = 0 Or (S + 25) Mod (z * 10) = 0) Then
l = l + " " + B
n = n + 1
k(n) = B
End If
S = S + 1
Loop
Close #1
Open of For Append As #1
Write #1, fn, "光电流取值:"
Write #1, l
For i = 1 To n
j = k(i)
Write #1, Val(j)
If i Mod 3 = 0 Then
h = h + 1
g(h) = (Val(k(i - 2)) + Val(k(i - 1)) + Val(k(i))) / 3
End If
Next i
Write #1, "进一步值:"
For e = 1 To h
Write #1, g(e)
Next e
Write #1, "光电流结果:"
For w = 2 To h - 1
p = Abs(g(w) - 0.5 * g(w - 1) - 0.5 * g(w + 1))
ac(w - 1) = p
r = r + p
If p > f Then
f = p
End If
Write #1, p
Next w
Write #1, "结果平均值为：", r / (h - 2), "A"
Write #1, "最大值为：", f, "A"
'Write #1, "偏压为为：", Val(Y), "V"
Close #1
'Print fn; "最终结果："
'Print r / (h - 2)
Text2.Text = Text2.Text + vbCrLf + fn + "结果平均值为：" + vbCrLf + Str(r / (h - 2)) + "A" + vbCrLf + "最大值为：" + Str(f) + "A"
TextSave.Text = TextSave.Text & fn & "," & Str(r / (h - 2)) & "," & Str(f) & vbCrLf '将处理结果储存在缓存文本框中文本名称，平均值，最大值
Open "e:\temp.txt" For Append As #1
Write #1, dn
Close #1
'比较ac的最大值和最小值
min = ac(1)
max = ac(1)
For w = 1 To h - 2
If ac(w) < min Then min = ac(w)
If ac(w) > max Then max = ac(w)
Next w
cmin = Val(k(1))
cmax = Val(k(1))
For w = 1 To n
If Val(k(w)) < cmin Then cmin = Val(k(w))
If Val(k(w)) > cmax Then cmax = Val(k(w))
Next w
'画图
'Picture1.Scale(-1，min - (max - min) * 0.2)-(h，max + (max - min) * 0.12)
Picture1.ScaleLeft = 0
Picture1.ScaleWidth = h + 1.5
Picture1.ScaleTop = max + (max - min) * 0.2
Picture1.ScaleHeight = -(max - min) * 1.4
Picture1.Cls
Picture1.DrawWidth = 5
For i = 1 To h - 3
Picture1.Line (i, ac(i))-(i + 1, ac(i + 1)), vbRed
Next i
For i = 1 To h - 2
Picture1.DrawWidth = 20
Picture1.PSet (i, ac(i)), vbGreen
Picture1.CurrentX = i + 0.2
Picture1.CurrentY = ac(i)
Picture1.Print Int(ac(i) * 1000000000) / 1000; "uA"
Next i
Picture2.ScaleLeft = 0
Picture2.ScaleWidth = num
Picture2.ScaleTop = cmax + 0.5 * (cmax - cmin)
Picture2.ScaleHeight = -(cmax - cmin) * 2
Picture2.Cls
Picture2.DrawWidth = 1
'For i = 1 To num - 1
'Picture2.Line (i, ac(i))-(i + 1, ac(i + 1)), vbRed
'Next i
For i = 1 To num
Picture2.DrawWidth = 3
If Picture2.ScaleTop + Picture2.ScaleHeight < cur(i) And cur(i) < Picture2.ScaleTop Then Picture2.PSet (i, cur(i)), vbGreen
Next i
If Dir(File1.Path & "\手动保存处理结果\", vbDirectory) = "" Then MkDir (File1.Path & "\手动保存处理结果\") '判断文件夹是否存在
'将光电流图和中间过程结果保存成BMP图片
End Sub
Private Sub Form_Load()
'pw = InputBox("请输入密码：")
'If pw = "huhao2014" Then
form1.WindowState = 2
'Else
'End
'End If
z = 0
Combo1.Text = 50
Combo1.AddItem 50
Combo1.AddItem 100
Combo1.AddItem 200
Drive1.Drive = Left(App.Path, 3)
Dir1.Path = App.Path
form1.BackColor = vbBlue
form1.FontSize = 10
form1.ForeColor = vbYellow
form1.FontBold = True
Label1.BackColor = vbGreen
Label1.ForeColor = vbBlue
Label1.FontName = "黑体"
Label1.FontSize = 12
Label1.FontBold = True
Text1.BackColor = vbYellow
Text1.ForeColor = vbBlue
Text1.FontName = "黑体"
Text1.FontSize = 12
Text1.FontBold = True
Label2.BackColor = vbRed
Label2.ForeColor = vbBlue
Label2.FontName = "黑体"
Label2.FontSize = 12
Label2.FontBold = True
Text2.Text = " "
Text2.BackColor = RGB(0, 0, 100)
Text2.ForeColor = vbYellow
Text2.FontName = "黑体"
Text2.FontSize = 10
Text2.FontBold = True
File1.Pattern = "*txt"
Label4.BackColor = vbRed
Label4.ForeColor = vbBlue
Label4.FontName = "黑体"
Label4.FontSize = 12
Label4.FontBold = True
Label3.BackColor = vbGreen
Label3.ForeColor = vbBlue
Label3.FontName = "黑体"
Label3.FontSize = 12
Label3.FontBold = True
Label5.BackColor = vbBlue
Label5.ForeColor = vbYellow
Label5.FontName = "黑体"
Label5.FontSize = 25
Label5.FontBold = True
'X和Y轴设定
Picture1.DrawWidth = 20
Picture1.FontSize = 10
Picture1.ForeColor = vbYellow
Picture1.FontBold = True
Picture1.ScaleMode = 0
Picture1.BackColor = RGB(0, 0, 100)
Picture2.BackColor = RGB(0, 0, 100)
'要保存的文本框
TextSave.Text = "条件Condition," & "平均值Average Absolute Value of Current(A)," & "最大值 Max Value of Current(A)(A)"
End Sub
Private Sub Command1_Click()
Text2.Text = ""
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
Dir2.Path = Dir1.Path
End Sub
Private Sub Dir1_GotFocus()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)
CurrentX = Frame1.Width / 2
CurrentY = Frame1.Height / 2
Frame1.Print "huhu"
End Sub
|
吾爱游客
发表于 2016-4-7 12:51
