vb药品管理系统课程设计报告
1. 系统开发背景
随着科技的不断进步，企业都在不断的注重管理的信息化以完善企业管理，增强企业自身的竞争力。药品销售业也不例外，通过较完善的信息系统实现自身企业对内部管理的方便性、合理性、快捷性、高效性等要求。
以前的手工管理效率低使最明显的缺陷，另外，数据的一致性不好维护，如某个药品信息的记录有所改动（如更改编号），那么该要品的其他记录就与此不一致，造成查询的费时费力。要把全部数据都更改又相当不方便。对药品库存的盘点也很不方便，而且需要较多的人来进行管理操作，而且容易出错，造成数据的不一致。而药品业是关民生的行业，错误信息可能会造成不可收拾的严重后果。因此，运用高效、准确的信息管理系统来替代手工管理是完善药品销售业管理的有效手段。
2. 系统开发意义
利用数据库系统可以很好的对数据进行维护，减少由于数据不一致等错误带来的麻烦。方便数据的更新和查询，降低错误率，方便药品信息的维护及库存的盘点。还可以运用较少的人员，高效的完成对药品销售的管理。
由于社会的发展不断趋于信息化，各个行业都要加强自身的信息化程度以适应社会的发展。而管理信息化正迎合了这个趋势，数据库系统在药品销售业的应用业实现了药品销售业执行工具、业务管理等的信息化，在这个信息化社会为药品销售业的发展增加了新的动力。相信随着社会的不断发展对该类系统的需求会越来越高。
药品销售管理信息系统，即服务于个人，又服务于企业，并最终服务于社会，这是让科技为人类服务的最好例证，其开发意义显而易见。
. 各实例的E-R 图
★整体实体E-R 图：
药品 管理 系 统
系统管理
出库入库
药物详况
药物汇总
用户密码出库入库货物药物日期客户货号综合
管理 管理 管理 管理 管理 查询 汇总 汇总 汇总 汇总
★ 出入库信息实体E-R 图：
★ 货物信息实体E-R 图：
★ 用户信息实体E-R 图：
2
★ 人员配置E-R 图：
3. 结构设计
★入库出库模块: 用来实现货物流通的查询。 ★货物详况模块: 用来实现货物浏览的查询。
★货物汇总模块：用来实现货物质料的增加、删除、修改等操作。
★系统管理模块：用来实现客户的增加、删除以及用户信息和密码的修改等操作。
4. 数据库设计
这里的数据库采用access ，用ADO 作为连接数据对象。
★ 启动access 建立一个数据库如图所示
3
★货源地表格： ★ 客户名表格：
★货物详况表：
★入库表：
★系统管理表：
★数据连接。在vb 环境下连接数据：
4
★在程序设计的公共模块中，先定义ADO 连接对象。语句如下：
Public conn new ADODB connection
然后在子程序中，用如下的语句即可打开数据库 Dim connectionstring as string
Connectionstring=“provider=microsoft.jet.oledb.4.0；&-data source=cangku.mdb” Conn.open connectionstring
4. 界面设计
设计好的界面如图所示：
5
菜单程序中，有5个菜单选项你，每个菜单选项对应着E-R 图的一个子项目。
首先创建一个工程，命名为药品管理系统，选择 工程-添加MDI 窗体 命令，
则在项目中添加了子窗体该窗体属性如下表所示：
创建各菜单项的属性如下表所示：
选择 工程-添加窗体 命令，添加子窗体，其属性如下：
6
★入库子窗体如下图所示：
各控件属性如下表：
7
★增加用户子窗体如下图所示：
8
其各控件属性如下表所示：
★修改密码窗体如下图所示：
★库房管理子窗体如下图所示：
9
库房管理子窗体控件如下表所示：
★查询子窗体及其控件如下所示：
10
★货物汇总子窗体及其属性如下：
关于窗体主要是列出关于系统的版本信息如下图
5. 建立公共模块
在菜单中选择 工程-添加模块 命令，则出现添加模块对话框，选中模块后单击打开，则模块添加到目录中，在模块中定义整个项目的公共变量。 Option Explicit
Public conn As New ADODB.Connection Public userID As String Public userpow As String Public find As Boolean Public sqlfind As String Public rs_data1 As New ADODB.Recordset Public findok As Boolean
Public summary_menu As String Public frmdata As Boolean
Public Const keyenter = 13
6. 代码设计
子窗体中都是click 事件
1. 主窗体代码如下：
Private Sub about_Click() frmabout.Show End Sub
Private Sub add_user_Click() adduser.Show End Sub
Private Sub check_find_Click()
chaxun.Show End Sub
Private Sub data_manage_Click() sqlfind = "select * from 入出库"
rs_data1.Open sqlfind, conn, adOpenKeyset, adLockPessimistic kumanage.Show End Sub
Private Sub exit_Click() Unload Me End Sub
Private Sub in_check_Click() jinku.Caption = "入库" jinku.Show End Sub
在MIDFORM1中主要代码如下： Private Sub MDIForm_Load() frmdata = False find = False End Sub
Private Sub modify_pw_Click() changpwd.Show End Sub
Private Sub out_check_Click() jinku.Caption = "出库" jinku.Show End Sub
Private Sub sum_check_date_Click() summary_menu = "check_date" huizong.Show 1 End Sub
Private Sub sum_date_custom_Click() summary_menu = "date_custom" huizong.Show 1 End Sub
Private Sub summary_check_Click() summary_menu = "check"
huizong.Show 1 End Sub
Private Sub summary_custom_Click() summary_menu = "custom" huizong.Show 1 End Sub
Private Sub summary_date_Click() summary_menu = "date" huizong.Show 1 End Sub
Private Sub Timer1_Timer() End Sub
2. 各子窗体代码：
★入库子窗体代码。本窗体用来查询货物入库的信息，下面的代码是定义几个变量：
Option Explicit
Dim rs_checkname As New ADODB.Recordset Dim rs_custom As New ADODB.Recordset Const row_num = 10 Const col_num = 6 确定按钮代码;
Private Sub Command1_Click()
Dim rs_save As New ADODB.Recordset Dim sql As String Dim i As Integer
Dim s As String On Error GoTo saveerror
If Trim(Text1.Text) = "" Then
MsgBox "货单不能为空!", vbOKOnly + vbExclamation, "" Text1.SetFocus Exit Sub End If
If Combo1.Text = "" Then
MsgBox "请选择货源地！", vbOKOnly + vbExclamation, "" Combo1.SetFocus Exit Sub End If
If comboy.Text = "" Then
MsgBox "请选择年份！", vbOKOnly + vbExclamation, "" comboy.SetFocus
Exit Sub End If
If combom.Text = "" Then
MsgBox "请选择月份！", vbOKOnly + vbExclamation, "" combom.SetFocus Exit Sub End If
If combod.Text = "" Then
MsgBox "请选择日期！", vbOKOnly + vbExclamation, "" combod.SetFocus Exit Sub End If
If Text2.Text = "" Then
MsgBox "请填写凭证号！", vbOKOnly + vbExclamation, "" Text2.SetFocus Exit Sub End If
If Text3.Text = "" Then
MsgBox "请填写经手人！", vbOKOnly + vbExclamation, "" Text3.SetFocus Exit Sub End If
If MSFlexGrid1.Col 0 Then
MsgBox "请输入完整的物品信息！", vbOKOnly + vbExclamation, "" MSFlexGrid1.SetFocus Exit Sub End If
数据库比较代码：
sql = "select * from 入出库 where 货单号='" & Text1.Text & "'" rs_save.Open sql, conn, adOpenKeyset, adLockPessimistic If rs_save.EOF Then rs_save.AddNew
rs_save.Fields(0) = Trim(Text1.Text)
rs_save.Fields(1) = CDate(Trim(comboy.Text) & "-" & Trim(combom.Text) & "-" & Trim(combod.Text))
rs_save.Fields(2) = Trim(Combo1.Text) rs_save.Fields(3) = Trim(Text2.Text) rs_save.Fields(4) = Trim(Text3.Text) rs_save.Fields(5) = Trim(Text4.Text)
If jinku.Caption = "入库" Then rs_save.Fields(6) = True Else
rs_save.Fields(6) = False End If
rs_save.Update rs_save.Close Else
MsgBox "货单号重复！", vbOKOnly + vbExclamation, "" Text1.SetFocus Text1.Text = "" rs_save.Close Exit Sub End If
sql = "select * from 货物详况"
rs_save.Open sql, conn, adOpenKeyset, adLockPessimistic For i = 1 To MSFlexGrid1.Row - 1 rs_save.AddNew
rs_save.Fields(0) = Trim(Text1.Text)
rs_save.Fields(1) = CDate(Trim(comboy.Text) & "-" & Trim(combom.Text) & "-" & Trim(combod.Text))
rs_save.Fields(2) = Trim(Combo1.Text) MSFlexGrid1.Row = i MSFlexGrid1.Col = 0
rs_save.Fields(3) = Trim(MSFlexGrid1.Text) MSFlexGrid1.Col = 1
If jinku.Caption = "出库" Then
s = "-" & Trim(MSFlexGrid1.Text) rs_save.Fields(4) = CDbl(s) Else
rs_save.Fields(4) = CDbl(Trim(MSFlexGrid1.Text)) End If
MSFlexGrid1.Col = 2
rs_save.Fields(5) = Trim(MSFlexGrid1.Text) MSFlexGrid1.Col = 3
rs_save.Fields(6) = Trim(MSFlexGrid1.Text) MSFlexGrid1.Col = 4
If jinku.Caption = "出库" Then
s = "-" & Trim(MSFlexGrid1.Text) rs_save.Fields(7) = CDbl(s) Else
rs_save.Fields(7) = CDbl(Trim(MSFlexGrid1.Text)) End If
MSFlexGrid1.Col = 5
rs_save.Fields(8) = Trim(MSFlexGrid1.Text) Next i
rs_save.Update rs_save.Close
MsgBox "添加成功！", vbOKOnly + vbExclamation, ""
Unload Me Exit Sub saveerror:
MsgBox Err.Description End Sub
Private Sub Command2_Click() Unload Me End Sub
Private Sub Form_Load() Dim sql As String Dim i As Integer
On Error GoTo loaderror
sql = "select * from 货源地"
rs_checkname.CursorLocation = adUseClient
rs_checkname.Open sql, conn, adOpenKeyset, adLockPessimistic sql = "select * from 客户名"
rs_custom.CursorLocation = adUseClient
rs_custom.Open sql, conn, adOpenKeyset, adLockPessimistic While Not rs_custom.EOF
Combo2.AddItem rs_custom.Fields(0) rs_custom.MoveNext Wend
If Not rs_checkname.EOF Then rs_checkname.MoveFirst
While Not rs_checkname.EOF Combo1.AddItem rs_checkname.Fields(0) rs_checkname.MoveNext Wend End If
comboy.AddItem 2002 comboy.AddItem 2003 comboy.AddItem 2004 comboy.AddItem 2005 comboy.AddItem 2006 comboy.AddItem 2007 comboy.AddItem 2008 comboy.AddItem 2009 comboy.AddItem 2010 comboy.AddItem 2011
For i = 1 To 12 combom.AddItem i Next i
For i = 1 To 31 combod.AddItem i Next i setgrid
setgrid_head
Text5.Visible = False clear_grid Exit Sub loaderror:
MsgBox Err.Description End Sub
Private Sub Form_Unload(Cancel As Integer) ' 关闭数据对象
rs_checkname.Close rs_custom.Close End Sub
Public Sub setgrid() Dim i As Integer
On Error GoTo seterror
MSFlexGrid1.ScrollBars = flexScrollBarBoth MSFlexGrid1.FixedCols = 0 MSFlexGrid1.Rows = row_num MSFlexGrid1.Cols = col_num
MSFlexGrid1.SelectionMode = flexSelectionByRow For i = 0 To row_num - 1
MSFlexGrid1.RowHeight(i) = 315 Next
For i = 0 To col_num - 1
MSFlexGrid1.ColWidth(i) = 1300 Next i Exit Sub seterror:
MsgBox Err.Description End Sub
Public Sub setgrid_head() On Error GoTo setheaderror MSFlexGrid1.Row = 0 MSFlexGrid1.Col = 0
MSFlexGrid1.Text = "物品名称" MSFlexGrid1.Col = 1
MSFlexGrid1.Text = " 单价" MSFlexGrid1.Col = 2
MSFlexGrid1.Text = "数量"
MSFlexGrid1.Col = 3
MSFlexGrid1.Text = "单位" MSFlexGrid1.Col = 4
MSFlexGrid1.Text = " 金额" MSFlexGrid1.Col = 5
MSFlexGrid1.Text = "客户名" Exit Sub
setheaderror:
MsgBox Err.Description End Sub
Public Sub clear_grid()
Dim i As Integer, j As Integer For i = 1 To row_num - 1 MSFlexGrid1.Row = i
For j = 0 To col_num - 1 MSFlexGrid1.Col = j MSFlexGrid1.Text = "" Next j Next i End Sub
Public Sub nextposition(ByVal r As Integer, ByVal c As Integer) On Error GoTo nexterror
Text5.Width = MSFlexGrid1.CellWidth Text5.Height = MSFlexGrid1.CellHeight
Text5.Left = MSFlexGrid1.Left + MSFlexGrid1.ColPos(c) Text5.Top = MSFlexGrid1.Top + MSFlexGrid1.RowPos(r) Text5.Text = MSFlexGrid1.Text Text5.Visible = True Text5.SetFocus Exit Sub nexterror:
MsgBox Err.Description End Sub
Private Sub MSFlexGrid1_Click() If Combo2.Visible = True Then Exit Sub End If
nextposition MSFlexGrid1.Row, MSFlexGrid1.Col End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
Dim i As Integer, j As Integer
Dim price As Double, coun As Integer
On Error GoTo texterror
If KeyAscii = keyenter Then
MSFlexGrid1.Text = Text5.Text
i = MSFlexGrid1.Row
j = MSFlexGrid1.Col
If j = 0 And Trim(Text5.Text) = "" Then
MsgBox "物品名称不能为空", vbOKOnly + vbExclamation, ""
Text5.SetFocus
Exit Sub
End If
If j = 1 And Not IsNumeric(Text5.Text) Then
MsgBox "单价请输入数字！", vbOKOnly + vbExclamation, ""
Text5.SetFocus
Exit Sub
End If
If j = 2 And Not IsNumeric(Text5.Text) Then
MsgBox "数量请输入数字！", vbOKOnly + vbExclamation, ""
Text5.SetFocus
Exit Sub
End If
If j = 3 And Trim(Text5.Text) = "" Then
MsgBox "单位不能为空！", vbOKOnly + vbExclamation, ""
Text5.SetFocus
Exit Sub
End If
If j = 3 And Not IsNull(Text5.Text) Then
MSFlexGrid1.Col = 1
price = CDbl(MSFlexGrid1.Text)
MSFlexGrid1.Col = 2
coun = CInt(MSFlexGrid1.Text)
MSFlexGrid1.Col = 4
MSFlexGrid1.Text = price * coun
MSFlexGrid1.Col = MSFlexGrid1.Col + 1
Text5.Visible = False
setcombo2 MSFlexGrid1.Row, MSFlexGrid1.Col
KeyAscii = 0
Exit Sub
End If
MSFlexGrid1.Col = MSFlexGrid1.Col + 1
KeyAscii = 0
nextposition MSFlexGrid1.Row, MSFlexGrid1.Col
End If
Exit Sub
texterror:
MsgBox Err.Description
End Sub
Public Sub setcombo2(ByVal r As Integer, ByVal c As Integer)
On Error GoTo seterror
Combo2.Width = MSFlexGrid1.CellWidth
Combo2.Left = MSFlexGrid1.Left + MSFlexGrid1.ColPos(c)
Combo2.Top = MSFlexGrid1.Top + MSFlexGrid1.RowPos(r)
Combo2.Text = MSFlexGrid1.Text
Combo2.Visible = True
Combo2.SetFocus
Exit Sub
seterror:
MsgBox Err.Description
End Sub
★增加用户子窗体代码
If Trim(Text1.Text) = "" Then
MsgBox "用户名不能为空", vbOKOnly + vbExclamation, ""
Exit Sub
Text1.SetFocus
Else
If Trim(Text2.Text) = "" Then
MsgBox "密码不能为空", vbOKOnly + vbExclamation, ""
Exit Sub
Text2.SetFocus
Else
sql = "select * from 系统管理"
rs_add.Open sql, conn, adOpenKeyset, adLockPessimistic
While (rs_add.EOF = False)
If Trim(rs_add.Fields(0)) = Trim(Text1.Text) Then
MsgBox "已有这个用户", vbOKOnly + vbExclamation, ""
Text1.SetFocus
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Combo1.Text = ""
Exit Sub
Else
rs_add.MoveNext
End If
Wend
If Trim(Text2.Text) Trim(Text3.Text) Then
MsgBox "两次密码不一致", vbOKOnly + vbExclamation, ""
Text2.SetFocus
Text2.Text = ""
Text3.Text = ""
Exit Sub
ElseIf Trim(Combo1.Text) "system" And Trim(Combo1.Text) "guest" Then MsgBox "请选择正确的用户权限", vbOKOnly + vbExclamation, ""
Combo1.SetFocus
Combo1.Text = ""
Exit Sub
Else
rs_add.AddNew
rs_add.Fields(0) = Text1.Text
rs_add.Fields(1) = Text2.Text
rs_add.Fields(2) = Combo1.Text
rs_add.Update
rs_add.Close
下面是返回成功信息对话框的代码
MsgBox "添加用户成功", vbOKOnly + vbExclamation, ""
Unload Me
End If
End If
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Combo1.AddItem "system"
Combo1.AddItem "guest"
End Sub
★修改密码子窗体代码
Private Sub Command1_Click()
'Dim rs_chang As New ADODB.Recordset
'Dim sql As String
If Trim(Text3.Text = "") Then
MsgBox "旧密码不能为空，请重新输入！", vbOKOnly + vbExclamation, "警告" Text3.SetFocus
Text3.Text = ""
Exit Sub
End If
If Trim(Text1.Text = "") Then
MsgBox "新密码不能为空，请重新输入！", vbOKOnly + vbExclamation, "警告" Text1.SetFocus
Text1.Text = ""
Exit Sub
End If
If Text1.Text Text2.Text Then
MsgBox "两次输入的新密码不同，请重新输入！", vbOKOnly + vbExclamation, "警告"
Text1.SetFocus
Text1.Text = ""
Text2.Text = ""
Exit Sub
End If
Dim strSql As String
Dim rs As New ADODB.Recordset
strSql = "Select * from 系统管理 where 用户名 = '" & userID & "'"
rs.Open strSql, conn, adOpenForwardOnly, adLockReadOnly
If Trim(rs.Fields("密码")) Trim(Text3.Text) Then
MsgBox "旧密码不对，请重新输入！", vbOKOnly + vbExclamation, "警告" Text3.SetFocus
Text3.Text = ""
Else
strSql = "Update 系统管理 set 密码 = '" & Text2.Text & "' where 用户名 = '" & userID & "'"
conn.Execute strSql
MsgBox "密码修改成功！", vbOKOnly + vbInformation, "提示"
Text3.Text = ""
Text1.Text = ""
Text2.Text = ""
Unload Me
End If
rs.Close
Set rs = Nothing
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
★库房管理子窗体代码：
检查代码如下：
Public Sub displaygrid1()
Dim i As Integer
On Error GoTo displayerror
setgrid
setgridhead
MSFlexGrid1.Row = 0
If Not rs_data1.EOF Then
rs_data1.MoveFirst
Do While Not rs_data1.EOF
MSFlexGrid1.Row = MSFlexGrid1.Row + 1
MSFlexGrid1.Col = 0
If Not IsNull(rs_data1.Fields(0)) Then MSFlexGrid1.Text = rs_data1.Fields(0) Else MSFlexGrid1.Text = ""
MSFlexGrid1.Col = 1
If Not IsNull(rs_data1.Fields(1)) Then MSFlexGrid1.Text = rs_data1.Fields(1) Else MSFlexGrid1.Text = ""
MSFlexGrid1.Col = 2
If Not IsNull(rs_data1.Fields(2)) Then MSFlexGrid1.Text = rs_data1.Fields(2) Else MSFlexGrid1.Text = ""
MSFlexGrid1.Col = 3
If Not IsNull(rs_data1.Fields(3)) Then MSFlexGrid1.Text = rs_data1.Fields(3) Else MSFlexGrid1.Text = ""
MSFlexGrid1.Col = 4
If Not IsNull(rs_data1.Fields(4)) Then MSFlexGrid1.Text = rs_data1.Fields(4) Else MSFlexGrid1.Text = ""
MSFlexGrid1.Col = 5
If Not IsNull(rs_data1.Fields(5)) Then MSFlexGrid1.Text = rs_data1.Fields(5) Else MSFlexGrid1.Text = ""
MSFlexGrid1.Col = 6
If rs_data1.Fields(6) = True Then MSFlexGrid1.Text = "入库" Else MSFlexGrid1.Text = "出库"
rs_data1.MoveNext
Loop
End If
displayerror:
If Err.Number 0 Then
MsgBox Err.Description
End If
End Sub
下面是增加明细按钮的click 事件：
Private Sub cmdmodify_Click()
On Error GoTo modifyerror
Dim i As Integer
Dim j As Integer
If rs_data2.BOF = True Then
MsgBox "没有明细记录无法修改！", vbOKOnly
Exit Sub
Else
If modify = False Then
MsgBox "无法修改, 请选择货物!", vbOKOnly + vbExclamation, "" Exit Sub
Else
If cmdmodify.Caption = "修改明细" Then
cmdmodify.Caption = "确定"
cmdexit.Enabled = False
cmdadd.Enabled = False
cmddel.Enabled = False
cmdcancel.Enabled = True
MSFlexGrid2.Row = 1
MSFlexGrid2.Col = 3
Text1.Text = MSFlexGrid2.Text
nextpos MSFlexGrid2.Row, MSFlexGrid2.Col
Else
MSFlexGrid2.Row = 1
For i = 0 To rs_data2.RecordCount - 1
MSFlexGrid2.Row = i + 1
For j = 0 To 8
MSFlexGrid2.Col = j
If j = 4 Or j = 7 Then
If jinchu = "出库" Then
rs_data2.Fields(j) = -CDbl(Trim(MSFlexGrid2.Text)) Else
rs_data2.Fields(j) = CDbl(Trim(MSFlexGrid2.Text)) End If
Else
rs_data2.Fields(j) = MSFlexGrid2.Text
End If
Next j
Next i
rs_data2.Update
MsgBox "修改信息成功！", vbOKOnly + vbExclamation, ""
cmdmodify.Caption = "修改明细"
cmdadd.Enabled = True
cmddel.Enabled = True
cmdexit.Enabled = True
cmdcancel.Enabled = False
Combo1.Visible = False
Text1.Visible = False
End If
End If
End If
modifyerror:
If Err.Number 0 Then
MsgBox Err.Description
End If
End Sub
下面是各个明细显的代码：
If Not rs_data2.EOF Then
rs_data2.MoveFirst
Do While Not rs_data2.EOF
.Row = .Row + 1
.Col = 0
If Not IsNull(rs_data2.Fields(0)) Then .Text = rs_data2.Fields(0) Else .Text = ""
.Col = 1
If Not IsNull(rs_data2.Fields(1)) Then .Text = rs_data2.Fields(1) Else .Text = ""
.Col = 2
If Not IsNull(rs_data2.Fields(2)) Then .Text = rs_data2.Fields(2) Else .Text = ""
.Col = 3
If Not IsNull(rs_data2.Fields(3)) Then .Text = rs_data2.Fields(3) Else .Text = ""
.Col = 4
If Not IsNull(rs_data2.Fields(4)) And CDbl(rs_data2.Fields(4))
.Text = -CDbl(rs_data2.Fields(4))
Else
.Text = rs_data2.Fields(4)
End If
.Col = 5
If Not IsNull(rs_data2.Fields(5)) Then .Text = rs_data2.Fields(5) Else .Text = ""
.Col = 6
If Not IsNull(rs_data2.Fields(6)) Then .Text = rs_data2.Fields(6) Else .Text = ""
.Col = 7
If Not IsNull(rs_data2.Fields(7)) And CDbl(rs_data2.Fields(4))
.Text = -CDbl(rs_data2.Fields(7))
Else
.Text = rs_data2.Fields(7)
End If
.Col = 8
If Not IsNull(rs_data2.Fields(8)) Then .Text = rs_data2.Fields(8) Else .Text = ""
rs_data2.MoveNext
Loop
下面是输入不规范时给出的信息提示代码：
Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim i As Integer, j As Integer
Dim price As Double, coun As Integer
On Error GoTo texterror
If KeyAscii = 13 Then
MSFlexGrid2.Text = Text1.Text
i = MSFlexGrid2.Row
j = MSFlexGrid2.Col
If j = 3 And Trim(Text1.Text) = "" Then
MsgBox "物品名称不能为空", vbOKOnly + vbExclamation, ""
Text1.SetFocus
Exit Sub
End If
If j = 4 And Not IsNumeric(Text1.Text) Then
MsgBox "单价请输入数字！", vbOKOnly + vbExclamation, ""
Text1.SetFocus
Exit Sub
End If
If j = 5 And Not IsNumeric(Text1.Text) Then
MsgBox "数量请输入数字！", vbOKOnly + vbExclamation, ""
Text1.SetFocus
Exit Sub
End If
If j = 6 And Trim(Text1.Text) = "" Then
MsgBox "单位不能为空！", vbOKOnly + vbExclamation, ""
Text1.SetFocus
Exit Sub
End If
If j = 6 And Not IsNull(Text1.Text) Then
MSFlexGrid2.Col = 4
price = CDbl(MSFlexGrid2.Text)
MSFlexGrid2.Col = 5
coun = CInt(MSFlexGrid2.Text)
MSFlexGrid2.Col = 7
MSFlexGrid2.Text = price * coun
MSFlexGrid2.Col = MSFlexGrid2.Col + 1
Text1.Visible = False
Combo1.Width = MSFlexGrid2.CellWidth
Combo1.Left = MSFlexGrid2.Left + MSFlexGrid2.ColPos(8)
Combo1.Top = MSFlexGrid2.Top + MSFlexGrid2.RowPos(MSFlexGrid2.Row) Combo1.Text = MSFlexGrid2.Text
Combo1.Visible = True
Combo1.SetFocus
KeyAscii = 0
Exit Sub
End If
MSFlexGrid2.Col = MSFlexGrid2.Col + 1
KeyAscii = 0
nextpos MSFlexGrid2.Row, MSFlexGrid2.Col
End If
Exit Sub
texterror:
MsgBox Err.Description
End Sub
★查询子窗体代码：
Option Explicit
Dim rs_find As New ADODB.Recordset
Private Sub Command1_Click()
On Error GoTo cmderror
Dim find_date1 As String
Dim find_date2 As String
If Option1.Value = True Then
sqlfind = "select * from 入出库 where 货单号 between '" & _
Combo1(0).Text & "'" & " and " & "'" & Combo1(1).Text & "'"
End If
If Option2.Value = True Then
find_date1 = Format(CDate(comboy(0).Text & "-" & _
combom(0).Text & "-" & combod(0).Text), "yyyy-mm-dd")
find_date2 = Format(CDate(comboy(1).Text & "-" & _
combom(1).Text & "-" & combod(1).Text), "yyyy-mm-dd")
sqlfind = "select * from 入出库 where 日期 between #" & _
find_date1 & "#" & " and" & " #" & find_date2 & "#"
End If
rs_data1.Open sqlfind, conn, adOpenKeyset, adLockPessimistic
kumanage.displaygrid1
Unload Me
kumanage.Show
cmderror:
If Err.Number 0 Then
MsgBox "请输入正确的查询条件！", vbOKOnly + vbExclamation, "警告" End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim i As Integer
Dim j As Integer
Dim sql As String
'If findok = True Then
'rs_data1.Close
'End If
sql = "select * from 入出库 order by 货单号 desc"
rs_find.CursorLocation = adUseClient
rs_find.Open sql, conn, adOpenKeyset, adLockPessimistic
If rs_find.EOF = False Then
With rs_find
Do While Not .EOF
Combo1(0).AddItem .Fields(0)
Combo1(1).AddItem .Fields(0)
.MoveNext
Loop
End With
End If
For i = 2001 To 20011
comboy(0).AddItem i
comboy(1).AddItem i
Next i
For i = 1 To 12
combom(0).AddItem i
combom(1).AddItem i
Next i
For i = 1 To 31
combod(0).AddItem i
combod(1).AddItem i
Next i
End Sub
Private Sub Form_Unload(Cancel As Integer)
rs_find.Close
End Sub
Private Sub Frame2_DragDrop(Source As Control, X As Single, Y As Single) End Sub
Private Sub Option1_Click()
Option2.Value = False
End Sub
Private Sub Option2_Click()
Option1.Value = False
End Sub
★登陆子窗体代码：
Option Explicit
Dim cnt As Integer
Private Sub Command1_Click()
Dim sql As String
Dim rs_login As New ADODB.Recordset
If Trim(txtuser.Text) = "" Then
MsgBox "没有这个用户", vbOKOnly + vbExclamation, ""
txtuser.SetFocus
Else
sql = "select * from 系统管理 where 用户名='" & txtuser.Text & "'"
rs_login.Open sql, conn, adOpenKeyset, adLockPessimistic
If rs_login.EOF = True Then
MsgBox "没有这个用户", vbOKOnly + vbExclamation, ""
txtuser.SetFocus
Else
If Trim(rs_login.Fields(1)) = Trim(txtpwd.Text) Then
userID = txtuser.Text
userpow = rs_login.Fields(2)
rs_login.Close
Unload Me
MDIForm1.Show
Else
MsgBox "密码不正确", vbOKOnly + vbExclamation, ""
txtpwd.SetFocus
End If
End If
End If
cnt = cnt + 1
If cnt = 3 Then
Unload Me
End If
Exit Sub
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim connectionstring As String
connectionstring = "provider=Microsoft.Jet.oledb.4.0;" & _
"data source=cangku.mdb"
conn.Open connectionstring
cnt = 0
End Sub
Private Sub Timer1_Timer()
Label3.Caption = Time
Label4.Caption = Date
End Sub
★货物汇总子窗体代码：
Option Explicit
Dim rs_sum As New ADODB.Recordset
Dim addup As Double
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim sql As String
Select Case summary_menu
Case "check"
Label1.Caption = "按货物名称汇总"
sql = "select 货源地,sum(金额) as 总金额 from 货物详况 group by 货源地 order by sum(金额)"
rs_sum.CursorLocation = adUseClient
rs_sum.Open sql, conn, adOpenKeyset, adLockPessimistic
addup = 0
MSFlexGrid1.Rows = rs_sum.RecordCount + 2
MSFlexGrid1.Cols = 3
' 设置表头
MSFlexGrid1.Row = 0
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = "货源地"
MSFlexGrid1.Col = 1
MSFlexGrid1.Text = "总金额"
MSFlexGrid1.Col = 2
MSFlexGrid1.Text = "入出库"
If rs_sum.EOF = False Then
rs_sum.MoveFirst
Do While Not rs_sum.EOF
MSFlexGrid1.Row = MSFlexGrid1.Row + 1
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = rs_sum.Fields(0)
MSFlexGrid1.Col = 1
If CDbl(rs_sum.Fields(1))
MSFlexGrid1.Text = Replace(rs_sum.Fields(1), "-", "") MSFlexGrid1.Col = 2
MSFlexGrid1.Text = "出库"
Else
MSFlexGrid1.Text = rs_sum.Fields(1)
MSFlexGrid1.Col = 2
MSFlexGrid1.Text = "入库"
End If
addup = addup + CDbl(rs_sum.Fields(1))
rs_sum.MoveNext
Loop
MSFlexGrid1.Row = MSFlexGrid1.Row + 1
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = "(总计)"
MSFlexGrid1.Col = 1
MSFlexGrid1.Text = addup
End If
rs_sum.Close
Case "date"
Label1.Caption = "按日期汇总"
sql = "select 日期,sum(金额) as 总金额 from 货物详况 group by 日期 order by sum(金额)"
rs_sum.CursorLocation = adUseClient
rs_sum.Open sql, conn, adOpenKeyset, adLockPessimistic
addup = 0
MSFlexGrid1.Rows = rs_sum.RecordCount + 2
MSFlexGrid1.Cols = 3
MSFlexGrid1.Row = 0
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = "日期"
MSFlexGrid1.Col = 1
MSFlexGrid1.Text = "总金额"
MSFlexGrid1.Col = 2
MSFlexGrid1.Text = "入出库"
If rs_sum.EOF = False Then
rs_sum.MoveFirst
Do While Not rs_sum.EOF
MSFlexGrid1.Row = MSFlexGrid1.Row + 1
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = rs_sum.Fields(0)
MSFlexGrid1.Col = 1
If CDbl(rs_sum.Fields(1))
MSFlexGrid1.Text = Replace(rs_sum.Fields(1), "-", "") MSFlexGrid1.Col = 2
MSFlexGrid1.Text = "出库"
Else
MSFlexGrid1.Text = rs_sum.Fields(1)
MSFlexGrid1.Col = 2
MSFlexGrid1.Text = "入库"
End If
addup = addup + CDbl(rs_sum.Fields(1))
rs_sum.MoveNext
Loop
MSFlexGrid1.Row = MSFlexGrid1.Row + 1
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = "(总计)"
MSFlexGrid1.Col = 1
MSFlexGrid1.Text = addup
End If
rs_sum.Close
Case "custom"
Label1.Caption = "按客户汇总"
sql = "select 客户名,sum(金额) as 总金额 from 货物详况 group by 客户名 order by sum(金额)"
rs_sum.CursorLocation = adUseClient
rs_sum.Open sql, conn, adOpenKeyset, adLockPessimistic
addup = 0
MSFlexGrid1.Rows = rs_sum.RecordCount + 2
MSFlexGrid1.Cols = 3
MSFlexGrid1.Row = 0
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = "客户名"
MSFlexGrid1.Col = 1
MSFlexGrid1.Text = "总金额"
MSFlexGrid1.Col = 2
MSFlexGrid1.Text = "入出库"
If rs_sum.EOF = False Then
rs_sum.MoveFirst
Do While Not rs_sum.EOF
MSFlexGrid1.Row = MSFlexGrid1.Row + 1
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = rs_sum.Fields(0)
MSFlexGrid1.Col = 1
If CDbl(rs_sum.Fields(1))
MSFlexGrid1.Text = Replace(rs_sum.Fields(1), "-", "") MSFlexGrid1.Col = 2
MSFlexGrid1.Text = "出库"
Else
MSFlexGrid1.Text = rs_sum.Fields(1)
MSFlexGrid1.Col = 2
MSFlexGrid1.Text = "入库"
End If
addup = addup + CDbl(rs_sum.Fields(1))
rs_sum.MoveNext
Loop
MSFlexGrid1.Row = MSFlexGrid1.Row + 1
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = "(总计)"
MSFlexGrid1.Col = 1
MSFlexGrid1.Text = addup
End If
rs_sum.Close
Case "check_date"
Label1.Caption = "按货物+日期汇总"
sql = "select 货源地, 日期,sum(金额) as 总金额 from 货物详况 " & _ "group by 货源地, 日期 order by sum(金额)"
rs_sum.CursorLocation = adUseClient
rs_sum.Open sql, conn, adOpenKeyset, adLockPessimistic
addup = 0
MSFlexGrid1.MergeCells = flexMergeRestrictRows
MSFlexGrid1.MergeCol(0) = True
MSFlexGrid1.Rows = rs_sum.RecordCount + 2
MSFlexGrid1.Rows = rs_sum.RecordCount + 2
MSFlexGrid1.Cols = 4
MSFlexGrid1.Row = 0
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = "货源地"
MSFlexGrid1.Col = 1
MSFlexGrid1.Text = "日期"
MSFlexGrid1.Col = 2
MSFlexGrid1.Text = "总金额"
MSFlexGrid1.Col = 3
MSFlexGrid1.Text = "入出库"
If rs_sum.EOF = False Then
rs_sum.MoveFirst
Do While Not rs_sum.EOF
MSFlexGrid1.Row = MSFlexGrid1.Row + 1
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = rs_sum.Fields(0)
MSFlexGrid1.Col = 1
MSFlexGrid1.Text = rs_sum.Fields(1)
MSFlexGrid1.Col = 2
If CDbl(rs_sum.Fields(2))
MSFlexGrid1.Text = Replace(rs_sum.Fields(2), "-", "") MSFlexGrid1.Col = 3
MSFlexGrid1.Text = "出库"
Else
MSFlexGrid1.Text = rs_sum.Fields(2)
MSFlexGrid1.Col = 3
MSFlexGrid1.Text = "入库"
End If
addup = addup + CDbl(rs_sum.Fields(2))
rs_sum.MoveNext
Loop
MSFlexGrid1.Row = MSFlexGrid1.Row + 1
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = "(总计)"
MSFlexGrid1.Col = 2
MSFlexGrid1.Text = addup
End If
rs_sum.Close
Case "date_custom"
Label1.Caption = "按客户+日期汇总"
sql = "select 客户名, 日期,sum(金额) as 总金额 from 货物详况 " & _ "group by 客户名, 日期 order by sum(金额)"
rs_sum.CursorLocation = adUseClient
rs_sum.Open sql, conn, adOpenKeyset, adLockPessimistic
addup = 0
MSFlexGrid1.MergeCells = flexMergeRestrictRows
MSFlexGrid1.MergeCol(0) = True
MSFlexGrid1.Rows = rs_sum.RecordCount + 2
MSFlexGrid1.Rows = rs_sum.RecordCount + 2
MSFlexGrid1.Cols = 4
MSFlexGrid1.Row = 0
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = "客户名"
MSFlexGrid1.Col = 1
MSFlexGrid1.Text = "日期"
MSFlexGrid1.Col = 2
MSFlexGrid1.Text = "总金额"
MSFlexGrid1.Col = 3
MSFlexGrid1.Text = "入出库"
If rs_sum.EOF = False Then
rs_sum.MoveFirst
Do While Not rs_sum.EOF
MSFlexGrid1.Row = MSFlexGrid1.Row + 1
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = rs_sum.Fields(0)
MSFlexGrid1.Col = 1
MSFlexGrid1.Text = rs_sum.Fields(1)
MSFlexGrid1.Col = 2
If CDbl(rs_sum.Fields(2))
MSFlexGrid1.Text = Replace(rs_sum.Fields(2), "-", "")
MSFlexGrid1.Col = 3
MSFlexGrid1.Text = "出库"
Else
MSFlexGrid1.Text = rs_sum.Fields(2)
MSFlexGrid1.Col = 3
MSFlexGrid1.Text = "入库"
End If
addup = addup + CDbl(rs_sum.Fields(2))
rs_sum.MoveNext
Loop
MSFlexGrid1.Row = MSFlexGrid1.Row + 1
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = "(总计)"
MSFlexGrid1.Col = 2
MSFlexGrid1.Text = addup
End If
rs_sum.Close
End Select
End Sub
7. 课程设计体会
通过两周的课程设计，掌握了GIS 可视化程序设计的全部过程，回顾起此次课程设计，至今我仍感慨颇多，的确，从选题到定稿，从理论到实践，在整整两星期的日子里，可以说得是苦多于甜，但是可以学到很多很多的的东西，同时不仅可以巩固了以前所学过的知识，而且学到了很多在书本上所没有学到过的知识。通过这次课程设计使我懂得了理论与实际相结合是很重要的，只有理论知识是远远不够的，只有把所学的理论知识与实践相结合起来，从理论中得出结论，才能真正为社会服务，从而提高自己的实际动手能力和独立思考的能力。在设计的过程中遇到问题，可以说得是困难重重，这毕竟第一次做的，难免会遇到过各种各样的问题，同时在设计的过程中发现了自己的不足之处，对以前所学过的知识理解得不够深刻，掌握得不够牢固，比如说不知道access 数据库的建立，不懂如何将数据进行连接，对vb 的编程语言掌握的不够熟练„„通过这次课程设计之后，一定把以前所学过的知识重新温故。
生活就是这样，汗水预示着结果也见证着收获。劳动是人类生存生活永恒不变的话题。通过实习，我才真正领略到“艰苦奋斗”这一词的真正含义。我想说，设计确实有些辛苦，但苦中也有乐，在如今单一的理论学习中，很少有机会能有实践的机会，设计是一个团队的任务，一起的工作可以让我们有说有笑，相互帮助，配合默契，多少人间欢乐在这里洒下，大学里一年的相处还赶不上这十来天的合作，我感觉我和同学们之间的距离更加近了；当我们看到自己所做的成果时，心中也不免产生兴奋； 正所谓“三百六十行，行行出状元”。我们同样可以为社会作出我们应该做的一切，这有什么不好？我们不断的反问自己。也许有人不喜欢这类的工作，也许有人认为设计的工作有些枯燥，但我们认为无论干什么，只要人生活的有意义就可。社会需要我们，我们也应该为社会而工作。既然如此，那还有什么必要失落呢？于是我们决定沿着自己的路，执着的走下去。
同时我认为我们的工作是一个团队的工作，团队需要个人，个人也离不开团队，必须发扬团结协作的精神。某个人的离群都可能导致导致整项工作的失败。实习中只有一个人知道
原理是远远不够的，必须让每个人都知道，否则一个人的错误，就有可能导致整个工作失败。团结协作是我们实习成功的一项非常重要的保证。而这次实习也正好锻炼我们这一点，这也是非常宝贵的。
对我们而言，知识上的收获重要，精神上的丰收更加可喜。挫折是一份财富，经历是一份拥有。这次实习必将成为我人生旅途上一个非常美好的回忆！
8. 致谢
在这次课程设计的撰写过程中，我得到了许多人的帮助。首先我要感谢老师在课程设计上给予我的指导、提供给我的支持和帮助，这是我能顺利完成这次报告的主要原因，更重要的是老师帮我解决了许多技术上的难题，让我能把系统做得更加完善。在此期间，我不仅学到了许多新的知识，而且也开阔了视野，提高了自己的设计能力。其次，我要感谢帮助过我的同学，他们也为我解决了不少我不太明白的设计难题。同时也感谢系机房为我提良好的做设计的环境。最后再一次感谢所有在设计中曾经帮助过我的良师益友和同学！