formmain.frm

VB+SQL开发的管理系统软件,希望能对学习写软件工程文档的同学们有所帮助 转载的新云软件的程序

Private Sub asPopup4_Click(Cancel As Boolean)
Me.WindowState = 1
Form1.Show 1
End Sub

Private Sub asPopup5_Click(Cancel As Boolean)
yxsave = False '不可保存，可删除，可修改
yxedit = True
yxdel = True
addmx = True '添加明细不可用
Grid1.Rows = 1
For i = 2 To 8
Grid1.Column(i).Locked = True
Next
yxsql = "select * from 销售记录 order by 日期 desc"
yxkusee '执行过程,执行数据的查询与显示
End Sub

Private Sub Form_Load()
On Error GoTo finish:
Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^" '进行注册
'Me.Picture = LoadPicture(App.path & "\images\bgmain.jpg")
yxsql = "select * from 销售记录"
yxnumber = 8 '设定入库表中有多少个字段，在这里使用变量是防止以后程序修改后只需要修改
              '这个关键字就可以了
Grid1.Cols = yxnumber + 1
Grid1.Column(1).Width = 50 '合理的设定表格中每列的宽度
Grid1.Column(2).Width = 129
Grid1.Column(3).Width = 65
Grid1.Column(4).Width = 60
Grid1.Column(5).Width = 60
Grid1.Column(6).Width = 50
Grid1.Column(7).Width = 55
Grid1.Column(8).Width = 70
Grid1.Column(8).Locked = True
Grid1.DisplayFocusRect = False '改变输入模式为平面
Grid1.Column(1).CellType = cellCheckBox
Grid1.Column(2).CellType = cellCalendar
Grid1.Column(3).CellType = cellComboBox
Grid1.Column(4).CellType = cellComboBox
Grid1.Column(5).CellType = cellComboBox
Label1 = yxadmin '当前操作员的名字
'*****************通过用户获取权限，来分配用户哪些程序可以使用
Set yx3 = cnn.Execute("select * from 用户 where 用户名='" & yxadmin & "'")
If yx3.Fields(2) = "0" Then
XPButton1.Enabled = False '新销售按钮不可用
XPButton2.Enabled = False '增加明细按钮不可用
XPButton3.Enabled = False '保存按钮不可用
End If
If yx3.Fields(3) = "0" Then
 XPButton4.Enabled = False '修改按钮不可用
End If
If yx3.Fields(4) = "0" Then
 XPButton5.Enabled = False '删除按钮不可用
End If
If yx3.Fields(5) = "0" Then
 asPopup4.Enabled = False '不允许执行入库操作
End If
If yx3.Fields(6) = "0" Then
 asPopup1.Enabled = False '不允许管理库存
End If
If yx3.Fields(7) = "0" Then
 asPopup2.Enabled = False '不允许管理客户资料
End If
If yx3.Fields(8) = "0" Then
 asPopup3.Enabled = False '不允许管理用户
End If
'*****************
Set yx1 = cnn.Execute(yxsql) '执行某一SQL语句，并将结果返回到记录集yx1
For i = 1 To Grid1.Cols - 1
Grid1.Cell(0, i).Text = yx1.Fields(i - 1).Name
Next
Grid1.BackColorFixed = RGB(242, 244, 189)
'----------以下是向combox记录集中写入已有的客户名称供用户方便选择
Set yx2 = cnn.Execute("select * from 客户")
Grid1.ComboBox(3).Clear
Do While Not yx2.EOF
 Grid1.ComboBox(3).AddItem yx2.Fields(0)
 yx2.MoveNext
Loop
'-------------
'----------以下是向combox记录集中写入已有的客户名称供用户方便选择
Set yx2 = cnn.Execute("select * from 库存")
Grid1.ComboBox(4).Clear
Grid1.ComboBox(5).Clear
Grid1.ComboBox(4).ListWidth = 150
Grid1.ComboBox(5).ListWidth = 150
Do While Not yx2.EOF
 Grid1.ComboBox(4).AddItem yx2.Fields(0) & "-" & yx2.Fields(2) & "-" & yx2.Fields(3)
 Grid1.ComboBox(5).AddItem yx2.Fields(1) & "-" & yx2.Fields(2) & "-" & yx2.Fields(3)
 yx2.MoveNext
Loop
'-------------
'****************************grid2表格控件的配置
Grid2.AllowUserResizing = False
Grid2.DisplayFocusRect = False '改变输入模式为平面
Grid2.Column(0).Width = 0
Grid2.Column(2).Width = 100
Grid2.Column(4).Width = 108
Grid2.Column(5).Width = 200
Grid2.Column(1).CellType = cellComboBox
Grid2.Column(2).CellType = cellComboBox
Grid2.Column(3).CellType = cellComboBox
Grid2.Cell(0, 1).Text = "查询模式" '将表格内添入固定内容
Grid2.Cell(0, 2).Text = "查询段"
Grid2.Cell(0, 3).Text = "条件"
Grid2.Cell(0, 4).Text = "关键字"
Grid2.Cell(0, 5).Text = "附加条件"
Grid2.ComboBox(1).AddItem "精确查询" '这里是类似combo框的操作，也是把内容添入combo控件的记录集
Grid2.ComboBox(1).AddItem "模糊查询"
Set yx2 = cnn.Execute("select * from 销售记录")
For i = 1 To Grid1.Cols - 1
Grid2.ComboBox(2).AddItem yx2.Fields(i - 1).Name
Next
'************************************
sumjiage '计算总金额
Exit Sub
finish:
MsgBox Err.Description
End Sub
Private Sub sumjiage()
Set yx3 = cnn.Execute("select sum(总价格) from 销售记录")
Label3.Caption = "销售总金额：" & yx3.Fields(0)
Set yx3 = cnn.Execute("select sum(总价格) from 销售记录 where 已付款='1'")
Label18.Caption = "已收总金额：" & yx3.Fields(0)
Set yx3 = cnn.Execute("select sum(总价格) from 销售记录 where 已付款='0'")
Label19.Caption = "欠费总金额：" & yx3.Fields(0)
End Sub
Private Sub yxkusee() '这里是通过引入的SQL语句来执行数据的显示
Set yx1 = cnn.Execute(yxsql)
Do While Not yx1.EOF '当yx1记录集未到结尾时执行
Grid1.Rows = Grid1.Rows + 1
Grid1.Cell(Grid1.Rows - 1, 0).Text = Grid1.Rows - 1
 For j = 1 To Grid1.Cols - 1 '设定读取列
 If Not yx1.Fields(j - 1) Is Nothing Then '空值的处理
  Grid1.Cell(Grid1.Rows - 1, j).Text = yx1.Fields(j - 1)
    If Mid(Grid1.Cell(Grid1.Rows - 1, j).Text, 1, 1) = "." Then
    Grid1.Cell(Grid1.Rows - 1, j).Text = "0" & Grid1.Cell(Grid1.Rows - 1, j).Text
   End If
 Else
 Grid1.Cell(Grid1.Rows - 1, j).Text = ""
 End If
 Next
 yx1.MoveNext
Loop
End Sub

Private Sub Grid1_CellChange(ByVal Row As Long, ByVal Col As Long)
On Error GoTo finish:
'************************
'以下代码主要是实现了在用户选择相对应的客户名称以及商品编号或助记码时
'系统会自动调出该对象的其它资料供用户参考
'************************
Dim length1, length2 As Integer
If Row <> 0 And Grid1.Cell(Row, 3).Text <> "" Then
Set yx4 = cnn.Execute("select * from 客户 where 客户名称='" & Grid1.Cell(Row, 3).Text & "'")
If yx4.EOF = False Then
Label5.Caption = yx4.Fields(0)
Label7.Caption = yx4.Fields(2)
Label8.Caption = yx4.Fields(3)
Label10.Caption = yx4.Fields(4)
Else
Label5.Caption = ""
Label7.Caption = "0"
Label8.Caption = "0.00"
Label10.Caption = "0.00"
End If
End If
If Row <> 0 And Grid1.Cell(Row, 4).Text <> "" Then
  length1 = Len(Grid1.Cell(Row, 4).Text)
  Do While length2 < length1
    length2 = length2 + 1
    If Mid(Grid1.Cell(Row, 4).Text, length2, 1) = "-" Then
      Grid1.Cell(Row, 4).Text = Mid(Grid1.Cell(Row, 4).Text, 1, length2 - 1)
      Set yx3 = cnn.Execute("select * from 库存 where 商品编号='" & Grid1.Cell(Row, 4).Text & "'")
      If yx3.EOF = False Then
      Grid1.Cell(Row, 5).Text = yx3.Fields(1)
      Grid1.Cell(Row, 7).Text = yx3.Fields(6)
      Label13.Caption = yx3.Fields(2)
      Label15.Caption = yx3.Fields(3)
      Label16.Caption = yx3.Fields(4)
      Else
      Label13.Caption = ""
      Label15.Caption = ""
      Label16.Caption = ""
      End If
      Exit Do
    End If
  Loop
End If
If Row <> 0 And Grid1.Cell(Row, 5).Text <> "" Then '此句主要实现每行的第5列的智能输入
  length1 = Len(Grid1.Cell(Row, 5).Text)
  Do While length2 < length1
    length2 = length2 + 1
    If Mid(Grid1.Cell(Row, 5).Text, length2, 1) = "-" Then
      Grid1.Cell(Row, 5).Text = Mid(Grid1.Cell(Row, 5).Text, 1, length2 - 1)
      Set yx3 = cnn.Execute("select * from 库存 where 助记码='" & Grid1.Cell(Row, 5).Text & "'")
      If yx3.EOF = False Then
      Grid1.Cell(Row, 4).Text = yx3.Fields(0)
      Grid1.Cell(Row, 7).Text = yx3.Fields(6)
      Label13.Caption = yx3.Fields(2)
      Label15.Caption = yx3.Fields(3)
      Label16.Caption = yx3.Fields(4)
      Else
      Label13.Caption = ""
      Label15.Caption = ""
      Label16.Caption = ""
      End If
      Exit Do
    End If
  Loop
End If
If yxsave = False Then
Exit Sub
Else
If Row <> 0 And Grid1.Cell(Row, 6).Text <> "0" Then
If Val(Grid1.Cell(Row, 6).Text) > Val(Label16.Caption) Then
MsgBox "销售数量已大出库存数量！", , "提示"
Grid1.Cell(Row, 6).Text = "0"
End If
End If
If Grid1.Cell(Row, 7).Text <> "" And Row <> 0 Then
 Grid1.Cell(Row, 8).Text = Grid1.Cell(Row, 6).Text * Grid1.Cell(Row, 7).Text
End If
End If
Exit Sub
finish:
MsgBox Err.Description
End Sub

Private Sub Grid1_RowColChange(ByVal Row As Long, ByVal Col As Long)
hang = Row
 If Grid1.Rows <> 1 Then '以下几句代码主要实现鼠标点击行时行背景自动变色
  Grid1.Range(1, 1, Grid1.Rows - 1, Grid1.Cols - 1).BackColor = vbWhite
  Grid1.Range(Row, 1, Row, Grid1.Cols - 1).BackColor = RGB(90, 158, 214)
 End If
End Sub

Private Sub Grid2_RowColChange(ByVal Row As Long, ByVal Col As Long)
If Grid2.Cell(1, 1).Text <> "" Then
If Grid2.Cell(1, 1).Text = "精确查询" Then
Grid2.ComboBox(3).Clear '以下清除表格中combo集中的内容,并加入以下内容
Grid2.ComboBox(3).AddItem "="
Grid2.ComboBox(3).AddItem ">"
Grid2.ComboBox(3).AddItem "<"
Grid2.ComboBox(3).AddItem ">="
Grid2.ComboBox(3).AddItem "<="
Grid2.ComboBox(3).AddItem "<>"
Grid2.ComboBox(2).Clear '先清空记录集
Set yx2 = cnn.Execute("select * from 销售记录")
For i = 1 To Grid1.Cols - 1
Grid2.ComboBox(2).AddItem yx2.Fields(i - 1).Name
Next
Grid2.ComboBox(2).AddItem "操作员"
Else
Grid2.ComboBox(3).Clear
Grid2.ComboBox(3).AddItem "like"
Grid2.ComboBox(2).Clear
Set yx2 = cnn.Execute("select * from 销售记录")
For i = 1 To Grid1.Cols - 1
 Select Case i '这里使用case语句是因为模糊查询中数值型是不支持的
   Case 1, 2, 3, 4, 5
   Grid2.ComboBox(2).AddItem yx2.Fields(i - 1).Name
 End Select
Next
Grid2.ComboBox(2).AddItem "操作员"
End If
End If
End Sub

Private Sub Image1_Click()
End
End Sub

Private Sub Timer1_Timer()
sumjiage
End Sub

Private Sub xpbutton1_Click()
yxsave = True
yxedit = False
yxdel = False
addmx = True '指示当前可以添加明细，即grid的行数
For i = 2 To 7
Grid1.Column(i).Locked = False
Next
Grid1.Rows = 1 '使用等于1可以将表格中的残余数据清空
Grid1.Rows = 2
Grid1.Cell(Grid1.Rows - 1, 0).Text = Grid1.Rows - 1
gridread
End Sub
Private Sub gridread() '写入初始的一些固定信息，无须用户在输入的数据
Grid1.Cell(Grid1.Rows - 1, 1).Text = "1"
Grid1.Cell(Grid1.Rows - 1, 2).Text = Date & " " & Time
Grid1.Cell(Grid1.Rows - 1, 6).Text = "0"
Grid1.Cell(Grid1.Rows - 1, 7).Text = "0.00"
Grid1.Cell(Grid1.Rows - 1, 8).Text = "0.00"
Grid1.Cell(Grid1.Rows - 1, 3).SetFocus
End Sub

Private Sub XPButton2_Click()
If addmx = True Then
Grid1.Rows = Grid1.Rows + 1
Grid1.Cell(Grid1.Rows - 1, 0).Text = Grid1.Rows - 1
gridread '写入初始的一些固定信息，无须用户在输入的数据
End If
End Sub

Private Sub XPButton6_Click()
On Error GoTo finish '防错代码，防止用户组织语句的错误或其它不可预见的错误发生
If Grid2.Cell(1, 1).Text <> "" And Grid2.Cell(1, 2).Text <> "" And Grid2.Cell(1, 3).Text <> "" And Grid2.Cell(1, 4).Text <> "" Then
    If Grid2.Cell(1, 1).Text = "精确查询" Then
      Select Case Grid2.Cell(1, 3).Text '处理数值型的查询组织语句
      Case "数量", "单价", "进货价格", "售出价格", "总价格"
      yxsql = "select * from 销售记录 where " & Grid2.Cell(1, 2).Text & Grid2.Cell(1, 3).Text & Grid2.Cell(1, 4).Text
      Case Else
      yxsql = "select * from 销售记录 where " & Grid2.Cell(1, 2).Text & Grid2.Cell(1, 3).Text & "'" & Grid2.Cell(1, 4).Text & "'"
     End Select
    Else
    yxsql = "select * from 销售记录 where " & Grid2.Cell(1, 2).Text & " like '%" & Grid2.Cell(1, 4).Text & "%'"
    End If
    If Grid2.Cell(1, 5).Text <> "" Then
    yxsql = yxsql & " " & Grid2.Cell(1, 5).Text
    End If
  Grid1.Rows = 1
  yxkusee
  XPFrame1.Visible = False
Else
MsgBox "查询时关键组成部分不可以出现空格！"
End If
Exit Sub
finish:
  MsgBox Err.Description
End Sub

Private Sub XPButton7_Click()
XPFrame1.Visible = False
End Sub

Private Sub XPButton8_Click()
yxsave = False
yxedit = True
yxdel = True
XPFrame1.Visible = True
End Sub

Private Sub XPButton9_Click()
yxfind.Show
End Sub