form6.frm

vb做的超市管理系统,带有源代码可以修改

      Top             =   2415
      Width           =   1215
   End
   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      Caption         =   "合同号:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   3960
      TabIndex        =   18
      Top             =   1815
      Width           =   975
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "到货时间:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   3960
      TabIndex        =   17
      Top             =   1230
      Width           =   1215
   End
End
Attribute VB_Name = "Form6"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'作者：性灵工作室
'发布日期：2007/03/03
'描    述：简单小型超市采购系统
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Dim intPage As Integer
   Dim intPageCount As Integer
   Dim intRecord As Integer

Private Sub Form_Load()
Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^" '进行注册
Set cg1 = cnn.Execute("select * from 供货商")
xcombox1.Clear
 Do While Not cg1.EOF
  xcombox1.AddItem cg1.Fields(0)
  cg1.MoveNext
 Loop
xcombox2.Clear
xcombox2.AddItem "现金"
xcombox2.AddItem "汇票"
xcombox2.AddItem "银行汇票"
xcombox2.AddItem "商业汇票"
Grid1.AllowUserResizing = True
    Grid1.DisplayFocusRect = False
    Grid1.ExtendLastCol = True
    Grid1.Appearance = Flat
    Grid1.FixedRowColStyle = Flat
    Grid1.ScrollBarStyle = Flat
    
    Grid1.DefaultFont.Name = "Tahoma"
    Grid1.DefaultFont.Size = 8
    Grid1.BackColorFixed = RGB(90, 158, 214)
    Grid1.BackColorFixedSel = RGB(110, 180, 230)
    Grid1.BackColorBkg = RGB(90, 158, 214)
    Grid1.BackColorScrollBar = RGB(231, 235, 247)
    Grid1.BackColor1 = RGB(231, 235, 247)
    Grid1.BackColor2 = RGB(239, 243, 255)
    Grid1.GridColor = RGB(148, 190, 231)
    Grid1.Cols = 9
    Grid1.Column(0).Width = 0
    For i = 1 To 8
    Grid1.Column(i).Width = 100
    Next
    Grid1.Column(4).Width = 50
    Grid1.Column(5).Width = 50
    Grid1.Column(8).Width = 30
    Grid1.Column(1).CellType = cellComboBox
    Grid1.Column(2).CellType = cellComboBox
    Grid1.Column(3).CellType = cellComboBox
    Grid1.Column(5).CellType = cellComboBox
    Grid1.Column(8).CellType = cellCheckBox
If cg2.State = adStateOpen Then
cg2.Close
End If
cg2.Open "select * from 申购单明细", cnn, adOpenKeyset, adLockReadOnly, adCmdText
For i = 0 To 7
 Grid1.Cell(0, i + 1).Text = cg2.Fields(i).Name
Next
Set cg3 = cnn.Execute("select distinct(商品类型) from 商品")
Grid1.ComboBox(1).Clear
Do While cg3.EOF = False
Grid1.ComboBox(1).AddItem cg3.Fields(0)
cg3.MoveNext
Loop
zdcsh '执行订单初始化
If cg1.State = adStateOpen Then
 cg1.Close
End If
cg1.Open "select 申购单.*,收货单.状态 from 收货单,申购单 where 收货单.采购单号=申购单.采购单号", cnn, adOpenStatic, adLockReadOnly, adCmdText
cg1.PageSize = 1
intPageCount = cg1.PageCount
If cg1.PageCount = 0 Then
intPageCount = 1
End If
intPage = cg1.PageCount
If cg1.RecordCount = 0 Then
Exit Sub
End If
cg1.AbsolutePage = intPage
 clickpage
 XPButton3.Caption = "上一订单(" & intPage - 1 & ")"
 XPButton4.Caption = "下一订单(" & intPageCount - intPage & ")"
  If intPage < intPageCount Then
    XPButton4.Enabled = True
 End If
 If intPage <= 1 Then
  XPButton3.Enabled = False
 Else
  XPButton3.Enabled = True
 End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
'Cancel = True
'Unload Me
End Sub

Private Sub Grid1_LeaveCell(ByVal Row As Long, ByVal Col As Long, NewRow As Long, NewCol As Long, Cancel As Boolean)
Set cg3 = cnn.Execute("select * from 商品")
Grid1.ComboBox(5).Clear
Do While cg3.EOF = False
Grid1.ComboBox(5).AddItem cg3.Fields(0)
cg3.MoveNext
Loop
End Sub
Private Sub clickpage()
  xtext1.Text = cg1.Fields(0)
  xtext2.Text = cg1.Fields(1)
  xtext5(0).Text = cg1.Fields(2)
  xcombox1.Text = cg1.Fields(3)
  xtext5(1).Text = cg1.Fields(4)
  xcombox2.Text = cg1.Fields(5)
  xtext3.Text = cg1.Fields(6)
  xcombox3.Text = cg1.Fields(7)
  xtext4.Text = cg1.Fields(8)
  xtext5(2).Text = cg1.Fields(9)
  xtext8.Text = cg1.Fields(10)
  Select Case cg1.Fields(12)
   Case "1"
  Image1.Picture = LoadPicture(App.Path & "\images\shouhuo-2.jpg")
  Image2.Picture = LoadPicture(App.Path & "\images\money-1.jpg")
  XPButton6.Enabled = False
  XPButton7.Enabled = False
  XPButton1.Enabled = True
  Case "0"
  Image1.Picture = LoadPicture(App.Path & "\images\shouhuo-1.jpg")
  Image2.Picture = LoadPicture(App.Path & "\images\money-1.jpg")
  XPButton6.Enabled = True
  XPButton7.Enabled = True
  XPButton1.Enabled = False
  Case "3"
  XPButton6.Enabled = False
  XPButton7.Enabled = False
  XPButton1.Enabled = False
  Image1.Picture = LoadPicture(App.Path & "\images\shouhuo-2.jpg")
  Image2.Picture = LoadPicture(App.Path & "\images\money-2.jpg")
  Case "2"
  XPButton6.Enabled = False
  XPButton7.Enabled = False
  XPButton1.Enabled = False
  Image1.Picture = LoadPicture(App.Path & "\images\exithuo-1.jpg")
  Image2.Picture = LoadPicture(App.Path & "\images\money-1.jpg")
 End Select
  Set cg2 = cnn.Execute("select * from 申购单明细 where 批号='" & xtext2.Text & "'")
  Grid1.Rows = 1
  i = 0
  Do While Not cg2.EOF
  i = i + 1
  Grid1.Rows = Grid1.Rows + 1
  For j = 0 To 7
   Grid1.Cell(i, j + 1).Text = cg2.Fields(j)
  Next
  cg2.MoveNext
  Loop
xtext1.Enabled = False
xtext2.Enabled = False
xtext5(0).Enabled = False
xcombox1.Enabled = False
xtext5(1).Enabled = False
xcombox2.Enabled = False
xtext3.Enabled = False
xcombox3.Enabled = False
xtext4.Enabled = False
xtext5(2).Enabled = False
xtext8.Enabled = False
Grid1.ReadOnly = True
End Sub
Private Sub zdcsh()
    Dim dh As Integer
    Dim strdh As String
    Dim bdh As Boolean
    bdh = False
    dh = 1
    Do While bdh = False
    strdh = dh
    Do While Len(strdh) < 6
    strdh = "0" & strdh
    Loop
    xtext1.Text = Date & "-" & strdh
   Set cg4 = cnn.Execute("select * from 采购订单 where 采购单号='" & xtext1.Text & "'")
     If cg4.EOF = False Then
     dh = dh + 1
     Else
     bdh = True
     End If
    cg4.Close
    Loop
xtext2.Text = xtext1.Text
For dh = 0 To 2
xtext5(dh).Text = Date
Next
xtext8.Text = loginname
xcombox1.Text = ""
xcombox2.Text = ""
xcombox3.Text = ""
xtext3.Text = ""
xtext4.Text = ""
xtext1.Enabled = False
xtext2.Enabled = False
xtext5(0).Enabled = True
xcombox1.Enabled = True
xtext5(1).Enabled = True
xcombox2.Enabled = True
xtext3.Enabled = True
xcombox3.Enabled = True
xtext4.Enabled = True
xtext5(2).Enabled = False
xtext8.Enabled = False
Grid1.ReadOnly = False
End Sub

Private Sub Grid1_RowColChange(ByVal Row As Long, ByVal Col As Long)
If Row = 0 Then
Exit Sub
End If
If Grid1.Cell(Row, 1).Text <> "" Then
 Set cg3 = cnn.Execute("select distinct(商品名称) from 商品 where 商品类型='" & Grid1.Cell(Row, 1).Text & "'")
 Grid1.ComboBox(2).Clear
 Do While Not cg3.EOF
  Grid1.ComboBox(2).AddItem cg3.Fields(0)
  cg3.MoveNext
 Loop
End If
If Grid1.Cell(Row, 1).Text <> "" And Grid1.Cell(Row, 2).Text <> "" Then
 Set cg3 = cnn.Execute("select distinct(商品型号) from 商品 where 商品类型='" & Grid1.Cell(Row, 1).Text & "' and 商品名称='" & Grid1.Cell(Row, 2).Text & "'")
 Grid1.ComboBox(3).Clear
 Do While Not cg3.EOF
  Grid1.ComboBox(3).AddItem cg3.Fields(0)
  cg3.MoveNext
 Loop
End If
End Sub

Private Sub Timer1_Timer()
If xcombox1.Text <> "" Then
  Set cg3 = cnn.Execute("select 联系人 from 供货商 where 供货商='" & xcombox1.Text & "'")
  If cg3.EOF = True Then
  Exit Sub
  End If
  xcombox3.Clear
  xcombox3.AddItem cg3.Fields(0)
End If
End Sub


Private Sub xpbutton1_Click()
If system(8) = False Then
MsgBox "无此权限!"
Exit Sub
End If

If cg1.State = adStateOpen Then
 cg1.Close
End If
cg1.Open "select * from 收货单 where 采购单号='" & xtext1.Text & "'", cnn, adOpenKeyset, adLockOptimistic, adCmdText
If cg1.EOF = False Then
cg1.Fields(1) = "3"
cg1.Update
'---------添加付款记录
Dim smoney As Double
For i = 1 To Grid1.Rows - 1
smoney = smoney + Val(Grid1.Cell(i, 7).Text)
Next
sql = "insert into 付款记录 values('" & xcombox1.Text & "','" & xtext1.Text & "'," & smoney & ",'" & Date & "')"
Set cg1 = cnn.Execute(sql)
'--------
Call Form_Load
MsgBox "已对该订单付款！"
Image1.Picture = LoadPicture(App.Path & "\images\shouhuo-2.jpg")
Else
MsgBox "无此订单，付款错误！"
Call Form_Load
End If
End Sub

Private Sub XPButton3_Click()
If intPage > 1 Then
intPage = intPage - 1
cg1.AbsolutePage = intPage
 clickpage
 cg1.MoveNext  '读取下一记录
 XPButton3.Caption = "上一订单(" & intPage - 1 & ")"
 XPButton4.Caption = "下一订单(" & intPageCount - intPage & ")"
   If intPage < intPageCount Then
    XPButton4.Enabled = True
 End If
 If intPage <= 1 Then
  XPButton3.Enabled = False
 End If
End If
End Sub

Private Sub XPButton4_Click()
If intPage < intPageCount Then
intPage = intPage + 1
cg1.AbsolutePage = intPage
  clickpage
 cg1.MoveNext  '读取下一记录
  XPButton3.Caption = "上一订单(" & intPage - 1 & ")"
 XPButton4.Caption = "下一订单(" & intPageCount - intPage & ")"
  If intPage >= intPageCount Then
    XPButton4.Enabled = False
 End If
 If intPage > 1 Then
  XPButton3.Enabled = True
  End If
End If
End Sub

Private Sub XPButton6_Click()
If system(6) = False Then
MsgBox "无此权限!"
Exit Sub
End If
If cg1.State = adStateOpen Then
 cg1.Close
End If
cg1.Open "select * from 收货单 where 采购单号='" & xtext1.Text & "'", cnn, adOpenKeyset, adLockOptimistic, adCmdText
If cg1.EOF = False Then
cg1.Fields(1) = "1"
cg1.Update
'-----------------
For i = 1 To Grid1.Rows - 1
  If Grid1.Cell(i, 1).Text = "" Then
   Exit For
  End If
  sql = "select * from 库存 where 商品类型='" & Grid1.Cell(i, 1).Text & "' and 商品名称='" & Grid1.Cell(i, 2).Text & "' and 商品型号='" & Grid1.Cell(i, 3).Text & "' and 单价=" & Grid1.Cell(i, 6).Text
  Set cg2 = cnn.Execute(sql)
  If cg2.EOF = False Then
   Dim vyes As String
   vyes = MsgBox(Grid1.Cell(i, 2).Text & "库存中有相匹配的记录存在，是否将其数量累加到库存中?", vbQuestion + vbYesNo, "提示")
  If vyes = vbYes Then
  sql = "update 库存 set 数量=" & Val(cg2.Fields(3)) + Val(Grid1.Cell(i, 4).Text) & " where 商品类型='" & Grid1.Cell(i, 1).Text & "' and 商品名称='" & Grid1.Cell(i, 2).Text & "' and 商品型号='" & Grid1.Cell(i, 3).Text & "' and 单价=" & Grid1.Cell(i, 6).Text
  Set cg3 = cnn.Execute(sql)
  Else
    sql = "insert into 库存 values('" & Grid1.Cell(i, 1).Text & "','" & Grid1.Cell(i, 2).Text & "','" & Grid1.Cell(i, 3).Text & "',"
  If Grid1.Cell(i, 4).Text <> "" Then
  sql = sql & Grid1.Cell(i, 4).Text & ",'" & Grid1.Cell(i, 5).Text & "',"
  Else
  sql = sql & "0,'" & Grid1.Cell(i, 5).Text & "',"
  End If
  For j = 6 To Grid1.Cols - 3
   If Grid1.Cell(i, j).Text <> "" Then
    sql = sql & Grid1.Cell(i, j).Text & ","
   Else
    sql = sql & "0,"
   End If
  Next
  sql = sql & Grid1.Cell(i, 6).Text & ")"
  MsgBox sql
  Set cg3 = cnn.Execute(sql)
  End If
  Else
    sql = "insert into 库存 values('" & Grid1.Cell(i, 1).Text & "','" & Grid1.Cell(i, 2).Text & "','" & Grid1.Cell(i, 3).Text & "',"
  If Grid1.Cell(i, 4).Text <> "" Then
  sql = sql & Grid1.Cell(i, 4).Text & ",'" & Grid1.Cell(i, 5).Text & "',"
  Else
  sql = sql & "0,'" & Grid1.Cell(i, 5).Text & "',"
  End If
  For j = 6 To Grid1.Cols - 3
   If Grid1.Cell(i, j).Text <> "" Then
    sql = sql & Grid1.Cell(i, j).Text & ","
   Else
    sql = sql & "0,"
   End If
  Next
  sql = sql & Grid1.Cell(i, 6).Text & ")"
  Set cg3 = cnn.Execute(sql)
  End If
Next
'--------------
Call Form_Load
MsgBox "已完成收货！"
Image1.Picture = LoadPicture(App.Path & "\images\shouhuo-2.jpg")
Else
MsgBox "无此订单，收货错误！"
Call Form_Load
End If
End Sub
Private Sub XPButton7_Click()
If system(7) = False Then
MsgBox "无此权限!"
Exit Sub
End If

Dim vyes As String
vyes = MsgBox("你确定将此订单中的商品退回供货商吗？", vbQuestion + vbYesNo, "提示")
If vyes = vbNo Then
Exit Sub
End If
If cg1.State = adStateOpen Then
 cg1.Close
End If
cg1.Open "select * from 收货单 where 采购单号='" & xtext1.Text & "'", cnn, adOpenKeyset, adLockOptimistic, adCmdText
If cg1.EOF = False Then
cg1.Fields(1) = "2"
cg1.Update
Call Form_Load
MsgBox "已经对此单进行退货！"
Image1.Picture = LoadPicture(App.Path & "\images\shouhuo-2.jpg")
Else
MsgBox "无此订单，退货错误！"
Call Form_Load
End If
End Sub