〇、下载地址
工程文件下载地址：http://pan.baidu.com/s/1eQowEyQ
一、程序需求
1）一个窗帘由布和纱组成。给出一种窗帘花式，所用布的种类（单价）和纱的种类（单价）可以唯一确定。
2）根据加工方式的不同收取加工费，布和纱可能采用不同的方式加工，但使用同一种加工方式时，加工任何材质的布料、纱料的单位长度加工费都是一定的。
3）布料和纱料的加工方式可能不同。
4）窗帘可以选择多个，程序统计最终的总价格，然后给出计算的详细步骤与说明
5）总结后的计算公式如下：
布总价=(单位布料价格+单位布料加工费)*布料购买单位数
纱总价=(单位纱料价格+单位纱料加工费)*纱布料购买单位数
窗帘价格=布总价+纱总价
总价格=购买窗帘价格的总和
二、程序界面
1）总操作界面
总操作界面是进入程序后的第一个界面，可以对选取的窗帘进行增加、删除和计算总价的操作
单击按钮“添加一条新数据”，可以进入新增窗帘界面
单击按钮“计算总价格”，可以进入输出展示板界面
2）新增窗帘界面
指定窗帘类型、布料加工方式、纱料加工方式、布料购买长度、纱料购买长度，可以新增一个窗帘的数据
3）输出展示板界面
输出展示板，可以将程序生成的窗帘总价格计算信息整理后输出
三、总操作界面（frmMain.frm）的控件及源码
控件信息（采集自用Notepad++打开的frmMain.frm文件）
VERSION 5.00
Begin VB.Form frmMain
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
Caption = "窗帘价格计算程序"
ClientHeight = 7245
ClientLeft = 45
ClientTop = 390
ClientWidth = 8205
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7245
ScaleWidth = 8205
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdCalculate
BackColor = &H00000000&
Caption = "计算总价格"
BeginProperty Font
Name = "宋体"
Size = 24
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 4200
TabIndex = 4
Top = 6240
Width = 3735
End
Begin VB.CommandButton cmdClearAll
Caption = "清空所有的数据"
BeginProperty Font
Name = "宋体"
Size = 18
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 240
TabIndex = 3
Top = 6240
Width = 3735
End
Begin VB.CommandButton cmdDeleteCurrent
Caption = "删除选中的数据"
BeginProperty Font
Name = "宋体"
Size = 18
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 4200
TabIndex = 2
Top = 5280
Width = 3735
End
Begin VB.CommandButton cmdAddNewItem
Caption = "添加一条新数据"
BeginProperty Font
Name = "宋体"
Size = 18
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 240
TabIndex = 1
Top = 5280
Width = 3735
End
Begin VB.ListBox lstDisplay
Height = 4920
ItemData = "Curtain.frx":0000
Left = 240
List = "Curtain.frx":0007
TabIndex = 0
Top = 240
Width = 7695
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False窗体源码
'主窗体初始化
Private Sub Form_Load()
'清空列表
lstDisplay.Clear
End Sub
'按钮：添加一条新数据
Private Sub cmdAddNewItem_Click()
frmAddItem.Show
End Sub
'按钮：删除当前选中数据
Private Sub cmdDeleteCurrent_Click()
'删除当前选中的数据
Dim item As Integer
If lstDisplay.SelCount > 0 Then
For item = lstDisplay.ListCount - 1 To 0 Step -1
If lstDisplay.Selected(item) Then
lstDisplay.RemoveItem item
End If
Next
End If
End Sub
'按钮：清空列表中所有数据
Private Sub cmdClearAll_Click()
'清空列表
lstDisplay.Clear
End Sub
'按钮：计算总价格
Private Sub cmdCalculate_Click()
'根据lstDisplay中的各项计算总价格
Dim c As Currency '统计总价
Dim s As String '输出文本
'题头
s = "价格明细表" & vbCrLf & vbCrLf
s = s & "========================" & vbCrLf & vbCrLf
'输出各个窗帘计算明细
c = 0
Dim i As Integer
For i = 0 To lstDisplay.ListCount - 1
'list中内容分三段 第0段为该项价格，第1段为拆解后各参数，第2段为计算公式
'分别装在 x(0) x(1) x(2)中
Dim x() As String
'MsgBox lstDisplay.List(i)
x = Split(lstDisplay.List(i), "|")
'累计价格
c = c + Val(x(0))
'列出明细和公式
s = s & "布料名称：" & x(1) & vbCrLf
Dim y() As String
y = Split(x(2), ";")
s = s & "-----------" & vbCrLf
s = s & "单位布料价格： " & y(0) & "元" & vbCrLf
s = s & "单位布料加工费： " & y(1) & "元" & vbCrLf
s = s & "布料购买单位数： " & y(2) & vbCrLf
s = s & "单位纱料价格： " & y(3) & "元" & vbCrLf
s = s & "单位纱料加工费： " & y(4) & "元" & vbCrLf
s = s & "纱料购买单位数： " & y(5) & vbCrLf
s = s & "-----------" & vbCrLf
s = s & "计算公式：(" & y(0) & "+" & y(1) & ")*" & y(2) & "+" & _
"(" & y(3) & "+" & y(4) & ")*" & y(5) & "=" & x(0) & vbCrLf & vbCrLf
Next
'价格总计
s = s & "========================" & vbCrLf & vbCrLf
s = s & "价格总计：" & c & vbCrLf & vbCrLf
'结尾部分：公式
s = s & "========================" & vbCrLf & vbCrLf
s = s & "计算公式" & vbCrLf
s = s & "布总价=(单位布料价格+单位布料加工费)*布料购买单位数" & vbCrLf
s = s & "纱总价=(单位纱料价格+单位纱料加工费)*纱料购买单位数" & vbCrLf
s = s & "窗帘价格=布总价+纱总价" & vbCrLf
s = s & "总价格=购买窗帘价格的总和" & vbCrLf & vbCrLf
'时间戳
s = s & Format(Now, "yyyy/MM/dd hh:mm:ss")
frmDisplayResult.Show
frmDisplayResult.txtDisplayBoard.Text = s
End Sub
'关闭主窗体时，关闭所有窗体并退出程序
Private Sub Form_Unload(Cancel As Integer)
MsgBox "谢谢使用 --Tsybius 2014/11/2"
'关闭所有的窗体
Unload frmAddItem
Unload frmDisplayResult
Unload Me
End Sub四、新增窗帘界面（frmAddItem.frm）的控件和源码
注：控件前缀 ①TextBox:txt-②ComboBox:cmb ③Command:btn/cmd
控件信息（采集自用Notepad++打开的frmAddItem.frm文件）
VERSION 5.00
Begin VB.Form frmAddItem
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
Caption = "添加新项"
ClientHeight = 6525
ClientLeft = 45
ClientTop = 390
ClientWidth = 5775
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6525
ScaleWidth = 5775
StartUpPosition = 2 '屏幕中心
Begin VB.ComboBox cmbYarnProcessType
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 3600
Style = 2 'Dropdown List
TabIndex = 17
Top = 2760
Width = 1335
End
Begin VB.ComboBox cmbClothProcessType
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 3600
Style = 2 'Dropdown List
TabIndex = 16
Top = 1560
Width = 1335
End
Begin VB.CommandButton cmdCancel
Caption = "取消"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 2880
TabIndex = 15
Top = 5280
Width = 2055
End
Begin VB.ComboBox cmbCurtainType
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 2400
Style = 2 'Dropdown List
TabIndex = 13
Top = 360
Width = 2535
End
Begin VB.CommandButton btnAddItem
Caption = "添加"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 720
TabIndex = 12
Top = 5280
Width = 2055
End
Begin VB.TextBox txtClothPricePerUnit
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2400
TabIndex = 5
Text = "0.00"
Top = 960
Width = 2535
End
Begin VB.TextBox txtClothLength
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2400
TabIndex = 4
Text = "0"
Top = 3960
Width = 2535
End
Begin VB.TextBox txtClothProcessCost
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2400
TabIndex = 3
Text = "0.00"
Top = 1560
Width = 975
End
Begin VB.TextBox txtYarnPricePerUnit
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2400
TabIndex = 2
Text = "0.00"
Top = 2160
Width = 2535
End
Begin VB.TextBox txtYarnLength
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2400
TabIndex = 1
Text = "0"
Top = 4560
Width = 2535
End
Begin VB.TextBox txtYarnProcessCost
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2400
TabIndex = 0
Text = "0.00"
Top = 2760
Width = 975
End
Begin VB.Shape Shape1
BackColor = &H80000002&
BorderColor = &H80000002&
FillColor = &H0000FF00&
FillStyle = 0 'Solid
Height = 135
Left = 480
Top = 3480
Width = 4815
End
Begin VB.Label Label7
Caption = "窗帘类型"
Height = 375
Left = 720
TabIndex = 14
Top = 480
Width = 1215
End
Begin VB.Label lbl1
Caption = "单位布料价格"
Height = 375
Left = 720
TabIndex = 11
Top = 1080
Width = 1335
End
Begin VB.Label Label1
Caption = "布料裁取宽度"
Height = 375
Left = 720
TabIndex = 10
Top = 4080
Width = 1335
End
Begin VB.Label Label2
Caption = "单位布料加工费"
Height = 375
Left = 720
TabIndex = 9
Top = 1680
Width = 1335
End
Begin VB.Label Label3
Caption = "单位纱料价格"
Height = 255
Left = 720
TabIndex = 8
Top = 2280
Width = 1335
End
Begin VB.Label Label4
Caption = "纱料裁取宽度"
Height = 255
Left = 720
TabIndex = 7
Top = 4680
Width = 1335
End
Begin VB.Label Label5
Caption = "单位纱料加工费"
Height = 375
Left = 720
TabIndex = 6
Top = 2880
Width = 1335
End
End
Attribute VB_Name = "frmAddItem"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False窗体源码
'加工费
Dim gNothingCharge As Currency
Dim gHookChrage As Currency
Dim gPunchCharge As Currency
Dim gSFoldCharge As Currency
'加载窗体
Private Sub Form_Load()
'初始化控件内容
'布加工方式
cmbClothProcessType.AddItem "不加工"
cmbClothProcessType.AddItem "挂钩加工"
cmbClothProcessType.AddItem "打孔加工"
cmbClothProcessType.AddItem "S折加工"
cmbClothProcessType.Text = "不加工"
txtClothProcessCost.Text = gNothingCharge
'纱加工方式
cmbYarnProcessType.AddItem "不加工"
cmbYarnProcessType.AddItem "挂钩加工"
cmbYarnProcessType.AddItem "打孔加工"
cmbYarnProcessType.AddItem "S折加工"
cmbYarnProcessType.Text = "不加工"
txtYarnProcessCost.Text = gNothingCharge
'读取配置文件：从INI配置文件中读取加工费和窗帘类型
Dim i As Integer
'读取纱布加工单价
Dim ProcessingCharge() As String
ProcessingCharge = GetInfoSection("Process", App.Path & "\config.ini")
For i = 1 To UBound(ProcessingCharge)
Dim temp() As String
temp = Split(ProcessingCharge(i), "=")
If temp(0) = "Nothing" Then
gNothingCharge = Trim(temp(1))
End If
If temp(0) = "Hook" Then
gHookChrage = Trim(temp(1))
End If
If temp(0) = "Punch" Then
gPunchCharge = Trim(temp(1))
End If
If temp(0) = "SFold" Then
gSFoldCharge = Trim(temp(1))
End If
Next
'读取各种类窗帘纱布单价
Dim Curtain() As String
Curtain = GetInfoSection("Curtain", App.Path & "\config.ini")
For i = 1 To UBound(Curtain)
'提取每种窗帘的值部分
Dim x As String
x = Mid(Curtain(i), InStr(Curtain(i), "=") + 1)
'提取窗帘名称
Dim item() As String
item = Split(x, ";")
cmbCurtainType.AddItem item(0)
If i = 1 Then
cmbCurtainType.Text = Trim(item(0))
txtClothPricePerUnit.Text = Trim(item(1))
txtYarnPricePerUnit.Text = Trim(item(2))
End If
Next
End Sub
'以下是三个重选下拉菜单触发的事件
'注：(ComboBox)_Change()函数，在vb6.0中，只会在手动输入更改combobox时触发
'重选下拉菜单：布加工方式
Private Sub cmbClothProcessType_Click()
If cmbClothProcessType.Text = "不加工" Then
txtClothProcessCost.Text = gNothingCharge
End If
If cmbClothProcessType.Text = "挂钩加工" Then
txtClothProcessCost.Text = gHookChrage
End If
If cmbClothProcessType.Text = "打孔加工" Then
txtClothProcessCost.Text = gPunchCharge
End If
If cmbClothProcessType.Text = "S折加工" Then
txtClothProcessCost.Text = gSFoldCharge
End If
End Sub
'重选下拉菜单：纱加工方式
Private Sub cmbYarnProcessType_Click()
If cmbYarnProcessType.Text = "不加工" Then
txtYarnProcessCost.Text = gNothingCharge
End If
If cmbYarnProcessType.Text = "挂钩加工" Then
txtYarnProcessCost.Text = gHookChrage
End If
If cmbYarnProcessType.Text = "打孔加工" Then
txtYarnProcessCost.Text = gPunchCharge
End If
If cmbYarnProcessType.Text = "S折加工" Then
txtYarnProcessCost.Text = gSFoldCharge
End If
End Sub
'修改窗帘类型
Private Sub cmbCurtainType_Click()
If cmbCurtainType.Text = "" Then
Exit Sub
End If
'读取配置文件：从XML中读取窗帘类型
Dim i As Integer
Dim Curtain() As String
Curtain = GetInfoSection("Curtain", App.Path & "\config.ini")
For i = 1 To UBound(Curtain)
'提取每种窗帘的值部分
Dim x As String
x = Mid(Curtain(i), InStr(Curtain(i), "=") + 1)
'提取窗帘名称
Dim item() As String
item = Split(x, ";")
If item(0) = cmbCurtainType.Text Then
txtClothPricePerUnit.Text = Trim(item(1))
txtYarnPricePerUnit.Text = Trim(item(2))
End If
Next
End Sub
'以下是两个按钮点击后触发的事件
'按钮：添加一个窗帘的价格
Private Sub btnAddItem_Click()
On Error Resume Next
'总价格为0，则不添加
If Trim(txtClothLength.Text) = "0" And Trim(txtYarnLength.Text) = "0" Then
MsgBox "总价格为0，添加失败"
Unload Me
Exit Sub
End If
'输入合法性校验
'1
If Not IsNumeric(txtClothPricePerUnit.Text) Then
txtResult.Text = "单位布料价格必须为非负数字"
MsgBox "单位布料价格必须为非负数字"
Exit Sub
ElseIf txtClothPricePerUnit.Text < 0 Then
txtResult.Text = "单位布料价格必须为非负数字"
MsgBox "单位布料价格必须为非负数字"
Exit Sub
End If
'2
If Not IsNumeric(txtClothLength.Text) Then
txtResult.Text = "布料宽度必须为非负数字"
MsgBox "布料宽度必须为非负数字"
Exit Sub
ElseIf txtClothLength.Text < 0 Then
txtResult.Text = "布料宽度必须为非负数字"
MsgBox "布料宽度必须为非负数字"
Exit Sub
End If
'3
If Not IsNumeric(txtClothProcessCost.Text) Then
txtResult.Text = "单位布料加工费必须为非负数字"
MsgBox "单位布料加工费必须为非负数字"
Exit Sub
ElseIf txtClothProcessCost.Text < 0 Then
txtResult.Text = "单位布料加工费必须为非负数字"
MsgBox "单位布料加工费必须为非负数字"
Exit Sub
End If
'4
If Not IsNumeric(txtYarnPricePerUnit.Text) Then
txtResult.Text = "单位纱料价格必须为非负数字"
MsgBox "单位纱料价格必须为非负数字"
Exit Sub
ElseIf txtYarnPricePerUnit.Text < 0 Then
txtResult.Text = "单位纱料价格必须为非负数字"
MsgBox "单位纱料价格必须为非负数字"
Exit Sub
End If
'5
If Not IsNumeric(txtYarnLength.Text) Then
txtResult.Text = "纱料宽度必须为非负数字"
MsgBox "纱料宽度必须为非负数字"
Exit Sub
ElseIf txtYarnLength.Text < 0 Then
txtResult.Text = "纱料宽度必须为非负数字"
MsgBox "纱料宽度必须为非负数字"
Exit Sub
End If
'6
If Not IsNumeric(txtYarnProcessCost.Text) Then
txtResult.Text = "单位纱料加工费必须为非负数字"
MsgBox "单位纱料加工费必须为非负数字"
Exit Sub
ElseIf txtYarnProcessCost.Text < 0 Then
txtResult.Text = "单位纱料加工费必须为非负数字"
MsgBox "单位纱料加工费必须为非负数字"
Exit Sub
End If
'布料单价+布料加工费
Dim cClothUnivalence As Currency
cClothUnivalence = Val(txtClothPricePerUnit.Text) + Val(txtClothProcessCost.Text)
'纱料单价+纱料加工费
Dim cYarnUnivalence As Currency
cYarnUnivalence = Val(txtYarnPricePerUnit.Text) + Val(txtYarnPricePerUnit.Text)
'总共价格
Dim cPriceTotal As Currency
cPriceTotal = _
cClothUnivalence * Val(txtClothLength.Text) + _
cYarnUnivalence * Val(txtYarnLength.Text)
'生成信息栏
Dim sItemInfo As String
sItemInfo = cPriceTotal & "|" & Trim(cmbCurtainType.Text) & "|" & _
txtClothPricePerUnit.Text & ";" & txtClothProcessCost.Text & ";" & _
Trim(txtClothLength.Text) & ";" & txtYarnPricePerUnit.Text & ";" & _
txtYarnProcessCost.Text & ";" & Trim(txtYarnLength.Text)
frmMain.lstDisplay.AddItem sItemInfo
'关闭本窗体
Unload Me
End Sub
'按钮：取消添加当前项
Private Sub cmdCancel_Click()
'关闭本窗体
Unload Me
End Sub五、输出展示板界面（frmDisplayResult.frm）的控件和源码
控件信息（采集自用Notepad++打开的frmDisplayResult.frm文件）
VERSION 5.00
Begin VB.Form frmDisplayResult
Caption = "输出展示板"
ClientHeight = 4905
ClientLeft = 120
ClientTop = 465
ClientWidth = 7950
LinkTopic = "Form1"
ScaleHeight = 4905
ScaleWidth = 7950
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox txtDisplayBoard
Height = 4695
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Text = "DisplayResult.frx":0000
Top = 120
Width = 7695
End
End
Attribute VB_Name = "frmDisplayResult"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False窗体源码：无
六、INI配置文件读取模块
INI配置文件读取模块：mdlIniHelper
里面有一个函数GetInfoSection，作用为读取INI配置中指定节中的所有键值对
本函数参考了 这个资源
'下载自：http://download.csdn.net/detail/veron_04/3057337
Option Explicit
Private Declare Function GetPrivateProfileSection _
Lib "KERNEL32" _
Alias "GetPrivateProfileSectionA" ( _
ByVal lpAppName As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) _
As Long
'读取INI配置中指定节中的所有键值对
Public Function GetInfoSection(strSection As String, strIniFile As String) As String()
Dim strReturn As String * 32767
Dim strTmp As String
Dim nStart As Integer
Dim nEnd As Integer
Dim i As Integer
Dim sArray() As String
Call GetPrivateProfileSection(strSection, strReturn, Len(strReturn), strIniFile)
strTmp = strReturn
i = 1
Do While strTmp <> ""
nStart = nEnd + 1
nEnd = InStr(nStart, strReturn, vbNullChar)
strTmp = Mid$(strReturn, nStart, nEnd - nStart)
If Len(strTmp) > 0 Then
ReDim Preserve sArray(1 To i)
sArray(i) = strTmp
i = i + 1
End If
Loop
GetInfoSection = sArray
End Function七、关于配置文件config.ini
#|---------------------------
#|窗帘价格计算程序配置文件
#|注意：不要添加多余的空格
#|---------------------------
#|Process 单位纱布加工价格
#|Nothing 不加工价格
#|Hook 挂钩加工价格
#|Punch 打孔加工价格
#|SFold S折加工价格
#|---------------------------
#|Curtain 窗帘
#|键名任意，值信息依次为 窗帘名称;单位布价格;单位纱价格
#|---------------------------
[Process]
Nothing=0.00
Hook=2.22
Punch=3.33
SFold=4.44
[Curtain]
Curtain1=Tsybius;3.14;6.28
Curtain2=Galatea;1.57;4.71END
扫一扫
1万+
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
