VB-编程--报销计算器

报销计算器
本程序采用VB语言编写，编程软件为VS2012 本计算器是为了计算出差补助，实现以下功能
1：能够方便的输入省会补助标准（包含:住宿和其他补助项）_高标准、地方补助标准_低标准
2：能够完整的输入车票信息：车票日期时间、出发地点、目的地点、车票价格、以及乘车方式
3：能够准确的计算出各项补助金额，以及补助总金额
4：能够将车票按照时间顺序排序并输出到文本中，并能计算出在各地的住宿天数
具体程序及界面如下：
完整程序如下:
Public Class Form1
Structure chepiao
Dim riq As Date
Dim shij As String
Dim jiag As Single
Dim chufd As String
Dim mudd As String
Dim shengh As Boolean
Dim jiaotfs As String
Dim tians As Integer
End Structure
Private cp(200) As chepiao
Private Ccpq As Single, Ccph As Single, Ccpf As Single, Czs As Integer, Cqt As Integer Private z As Integer, q As Integer
Private i As Integer
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Czs = 0 '为全局数据赋初始值
Cqt = 0
Ccpq = 0
Ccph = 0
Ccpf = 0
i = 0
End Sub
'读取车票信息并对出行方式车票价格求和
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles SR.Click If cfsj.Text <> ""Then
If (Int(cfsj.Text) / 100) > 24 Or (Int(cfsj.Text) Mod 100) >= 60 Then
MsgBox("输入的时间不正确，请重新输入")
Exit Sub
End If
End If
cp(i).riq = Date1.Value '读取车票时间信息If cfsj.Text <> ""Then cp(i).shij = cfsj.Text
cp(i).chufd = cfdd.Text '读取车票地址信息
cp(i).mudd = mddd.Text
cp(i).shengh = sh.Checked '记录车票目的地是否为省会
If shbz1.Text = ""Or shbz2.Text = ""Then
MsgBox("请将省会补助标准正确填写完整，没有填 0") '检查补助标准是否填写正确Exit Sub
End If
If dfbz1.Text = ""Or dfbz2.Text = ""Then
MsgBox("请将地方补助标准正确填写完整，没有填 0")
Exit Sub
End If
If cpjg1.Text = ""Then
MsgBox("请输入车票价格，点击确定继续")
Exit Sub
Else
cp(i).jiag = cpjg1.Text '判断是否为第一天出行If hc.Checked Then'判断车票类型，并对相应车票求和
Ccph = Ccph + cp(i).jiag
cp(i).jiaotfs = "火车"
ElseIf qc.Checked Then
Ccpq = Ccpq + cp(i).jiag
cp(i).jiaotfs = "汽车"
Else
Ccpf = Ccpf + cp(i).jiag
cp(i).jiaotfs = "服务车"
End If
End If
GroupBox1.Enabled = False'保证第一次正确输入后标准不能更改
i = i + 1
Textqc.Text = Ccpq '输出各项费用
Texthc.Text = Ccph
Textglf.Text = Ccpf
MsgBox("输入成功,点击确定继续")
Label12.Text = i & "张"
cpjg1.Focus() '车票价格输入框获得焦点
cpjg1.Text = ""
End Sub
Private Sub JS_Click(sender As Object, e As EventArgs) Handles JS.Click Dim m As Integer, n As Integer
Dim z As Integer, q As Integer
Dim ep As chepiao
Dim jiaoz As Integer
jiaoz = 0
If i = 0 Then
MsgBox("没有数据可供计算，请输入数据后再尝试计算")
Exit Sub
End If
Czs = 0
Cqt = 0
For m = 0 To i - 2 '对车票按时间排序
For n = m + 1 To i - 1
If DateDiff(DateInterval.Day, cp(m).riq, cp(n).riq) < 0 Then
ep = cp(m)
cp(m) = cp(n)
cp(n) = ep
ElseIf DateDiff(DateInterval.Day, cp(m).riq, cp(n).riq) = 0 And cp(m).shij > cp(n).shij Then
ep = cp(m)
cp(m) = cp(n)
cp(n) = ep
End If
Next
Next
For m = 1 To i - 1
n = DateDiff(DateInterval.Day, cp(m - 1).riq, cp(m).riq)
If cp(m - 1).shengh And n <> 0 Then jiaoz = jiaoz + 1
cp(m - 1).tians = n
If cp(m - 1).shengh Then'判断补助标准
z = shbz1.Text
q = shbz2.Text
Else
z = dfbz1.Text
q = dfbz2.Text
End If
Czs = Czs + z * n
Cqt = Cqt + q * n
Next
Textzs.Text = Czs
Textqt.Text = Cqt - jiaoz * (Int(shbz2.Text) - Int(dfbz2.Text))
Textqb.Text = Ccph + Ccpq + Ccpf + Czs + Cqt
End Sub
'数据输出到文本中
Private Sub shuchu_Click(sender As Object, e As EventArgs) Handles shuchu.Click Dim n As Integer, m As Integer
Dim path As String
Dim riqi As String
If i = 0 Then
MsgBox("没有数据可供输出，请输入数据后再尝试输出")
Exit Sub
End If
Save() '打开保存对话框
path = Save
'Open()
'path = Open()
For n = 0 To i - 1
For m = 1 To (10 - Len(cp(n).chufd) * 2) \ 2 '将出发地点标准还为10个字符
cp(n).chufd = " " & cp(n).chufd & " "
Next
For m = 1 To (10 - Len(cp(n).mudd) * 2) \ 2 '将目的地点标准还为10个字符
cp(n).mudd = " " & cp(n).mudd & " "
Next
For m = 1 To (8 - Len(cp(n).jiaotfs) * 2) \ 2 '将交通方式标准化为8个字符
cp(n).jiaotfs = " " & cp(n).jiaotfs & " "
Next
Next
puter.(path, " 日期时间出发地点目的地点交通方式价格住宿
天数" & vbNewLine, True)
For n = 0 To i - 1 '输出车票明细
riqi = Format(cp(n).riq, "yyyyMMdd")
puter.(path, riqi, True)
If cp(n).shij = ""Then'将时间标准化为6个字符长度puter.(path, " " & " ", True)
ElseIf cp(n).shij \ 1000 = 0 Then
puter.(path, " " & cp(n).shij \ 100 & "：" & cp(n).shij Mod 100 & " ", True)
Else
puter.(path, " "& cp(n).shij \ 100 & "："& cp(n).shij Mod100, True) End If
puter.(path, " " & cp(n).chufd, True)
puter.(path, " " & cp(n).mudd, True)
puter.(path, " " & cp(n).jiaotfs, True)
If cp(n).jiag Mod 1 = 0 Then'将车票价格标准化为5个字符并输出
If cp(n).jiag \ 10 = 0 Then
puter.(path, " " & " " & cp(n).jiag & " ", True)
ElseIf cp(n).jiag \ 100 = 0 Then
puter.(path, " " & " " & cp(n).jiag & " ", True)
ElseIf cp(n).jiag \ 1000 = 0 Then
puter.(path, " " & " " & cp(n).jiag & " ", True)
ElseIf cp(n).jiag \ 10000 = 0 Then
puter.(path, " " & cp(n).jiag & " ", True)
Else
puter.(path, " " & cp(n).jiag, True)
End If
Else
If cp(n).jiag \ 10 = 0 Then
puter.(path, " " & " " & cp(n).jiag & " ", True)
ElseIf cp(n).jiag \ 100 = 0 Then
puter.(path, " " & cp(n).jiag & " ", True)
'ElseIf cp(n).jiag \ 1000 = 0 Then
' puter.(path, " " & cp(n).jiag, True)
Else
puter.(path, " " & cp(n).jiag, True)
End If
End If
puter.(path, " " & cp(n).tians & vbNewLine, True)
Next
'输出汇总数据
puter.(path, vbNewLine, True)
If Ccpq Then puter.(path, "汽车票：" & Str(Ccpq) & "元" & vbNewLine, True) If Ccph Then puter.(path, "火车票：" & Str(Ccph) & "元" & vbNewLine, True) If Ccpf Then puter.(path, "过路费：" & Str(Ccpf) & "元" & vbNewLine, True) If Czs Then puter.(path, "住宿补贴：" & Str(Czs) & "元" & vbNewLine, True) If Cqt Then puter.(path, "其他补助：" & Str(Cqt) & "元" & vbNewLine, True) If Int(Textqb.Text) Then puter.(path, "费用总和：" & " " & Textqb.Text & "元" & vbNewLine, True)
Shell("notepad.exe " & path)
End Sub
'清除数据
Private Sub qingchu_Click(sender As Object, e As EventArgs) Handles qingchu.Click If i = 0 Then
MsgBox("没有车票可供清除")
Exit Sub
End If
Czs = 0
Cqt = 0
i = i - 1
If cp(i).jiaotfs = "汽车"Then Ccpq = Ccpq - cp(i).jiag
If cp(i).jiaotfs = "火车"Then Ccph = Ccph - cp(i).jiag
If cp(i).jiaotfs = "服务车"Then Ccpf = Ccpf - cp(i).jiag
MsgBox("清除：" & cp(i).riq & " " & cp(i).chufd & " 到 " & cp(i).mudd & " " & "价格：" & cp(i).jiag)
Label12.Text = i & "张"
Textqc.Text = Ccpq
Texthc.Text = Ccph
Textglf.Text = Ccpf
Textzs.Text = "0"
Textqt.Text = "0"
Textqb.Text = "0"
End Sub
'出发地与目的地地址交换
Private Sub Label11_Click(sender As Object, e As EventArgs) Handles Label11.Click
Dim ddjh As String
ddjh = cfdd.Text
cfdd.Text = mddd.Text
mddd.Text = ddjh
If sh.Checked Then
sh.Checked = Not sh.Checked
fsh.Checked = Not fsh.Checked
Else
fsh.Checked = Not fsh.Checked
sh.Checked = Not sh.Checked
End If
End Sub
'防止输入非法字符
Private Sub shbz1_KeyPress(sender As Object, e As KeyPressEventArgs) Handles shbz1.KeyPress
If Asc(e.KeyChar) = 8 Or Asc(e.KeyChar) = 46 Then Exit Sub
If Asc(e.KeyChar) = 13 Then shbz2.Focus()
If Asc(e.KeyChar) <= 47 Or Asc(e.KeyChar) >= 58 Then e.KeyChar = ""
End Sub
'防止输入非法字符
Private Sub shbz2_KeyPress(sender As Object, e As KeyPressEventArgs) Handles shbz2.KeyPress
If Asc(e.KeyChar) = 8 Or Asc(e.KeyChar) = 46 Then Exit Sub
If Asc(e.KeyChar) = 13 Then dfbz1.Focus()
If Asc(e.KeyChar) <= 47 Or Asc(e.KeyChar) >= 58 Then e.KeyChar = ""
End Sub
'防止输入非法字符
Private Sub dfbz1_KeyPress(sender As Object, e As KeyPressEventArgs) Handles dfbz1.KeyPress
If Asc(e.KeyChar) = 8 Or Asc(e.KeyChar) = 46 Then Exit Sub
If Asc(e.KeyChar) = 13 Then dfbz2.Focus()
If Asc(e.KeyChar) <= 47 Or Asc(e.KeyChar) >= 58 Then e.KeyChar = ""
End Sub
'防止输入非法字符
Private Sub dfbz2_KeyPress(sender As Object, e As KeyPressEventArgs) Handles dfbz2.KeyPress
If Asc(e.KeyChar) = 8 Or Asc(e.KeyChar) = 46 Then Exit Sub
If Asc(e.KeyChar) = 13 Then Date1.Focus()
If Asc(e.KeyChar) <= 47 Or Asc(e.KeyChar) >= 58 Then e.KeyChar = ""
End Sub
'防止输入非法字符
Private Sub cfsj_KeyPress(sender As Object, e As KeyPressEventArgs) Handles cfsj.KeyPress
If Asc(e.KeyChar) = 8 Then Exit Sub
If Asc(e.KeyChar) = 13 Then cpjg1.Focus()
If Asc(e.KeyChar) <= 47 Or Asc(e.KeyChar) >= 58 Then e.KeyChar = ""
End Sub
'防止输入非法字符
Private Sub cpjg1_KeyPress(sender As Object, e As KeyPressEventArgs) Handles cpjg1.KeyPress
If Asc(e.KeyChar) = 8 Or Asc(e.KeyChar) = 46 Then Exit Sub
If Asc(e.KeyChar) = 13 Then cfdd.Focus()
If Asc(e.KeyChar) <= 47 Or Asc(e.KeyChar) >= 58 Then e.KeyChar = ""
End Sub
Private Sub cfdd_KeyPress(sender As Object, e As KeyPressEventArgs) Handles cfdd.KeyPress
If Asc(e.KeyChar) = 13 Then mddd.Focus()
End Sub
Private Sub mddd_KeyPress(sender As Object, e As KeyPressEventArgs) Handles mddd.KeyPress
If Asc(e.KeyChar) = 13 Then SR.Focus()
End Sub
End Class。