frmbb.frm

网吧库存管理系统 主要对商品网费等费用和数量管理

      Height          =   7440
      Left            =   285
      Top             =   2265
      Width           =   11505
   End
   Begin VB.Image Image1 
      Height          =   390
      Left            =   11160
      Picture         =   "frmbb.frx":0000
      Top             =   675
      Visible         =   0   'False
      Width           =   390
   End
   Begin VB.Label Label4 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "综合报表"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   24
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   780
      Left            =   300
      TabIndex        =   7
      Top             =   450
      Width           =   11385
   End
End
Attribute VB_Name = "frmbb"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs1 As ADODB.Recordset
Dim astr As String
Dim mov As Boolean
Dim oldx As Long
Dim oldy As Long
Dim hrow As Integer
Dim hcol As Integer
Dim spid As Long
Private Sub Form_Load()
Me.Top = mme.Top + mme.Height
Me.Left = Screen.Width - Me.Width - 100
Set rs1 = New ADODB.Recordset
Text1 = Year(Date)
Text2 = Month(Date)
Combo1.Clear
Combo1.AddItem "全部"
Adodc1.ConnectionString = connstr
Adodc1.CommandType = adCmdText



If rs.State Then rs.Close
rs.Open "select DISTINCT spname from spkc WHERE DWS='" & gsname & "'", cn, 1, 1
Do While Not rs.EOF
Combo1.AddItem rs.Fields("spname")
rs.MoveNext
Loop
If rs.State Then rs.Close
End Sub

Private Sub Image1_Click()
Unload Me
End Sub

Private Sub Label4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
oldx = X
oldy = Y
mov = True
End Sub

Private Sub Label4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If mov Then
Me.Move Me.Left + (X - oldx), Me.Top + (Y - oldy)
End If
End Sub
Private Sub Label4_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
mov = False
End Sub

Private Sub MSHF_Click()
If hrow > 0 Then
Text3 = MSHF.TextMatrix(hrow, 5)
Text3.Visible = True
xpcmdbutton8.Visible = True
spid = Val(MSHF.TextMatrix(hrow, 0))
End If
End Sub

Private Sub MSHF_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
hrow = MSHF.Row
hcol = MSHF.Col
tim = 0
If username = "" Then loginfrm.Show
End Sub

Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
tim = 0
If username = "" Then loginfrm.Show
End Sub

Private Sub xpcmdbutton1_Click()
tim = 0
If username = "" Then loginfrm.Show
Picture2.Visible = False
Dim rs1 As ADODB.Recordset
Set rs1 = New ADODB.Recordset
rs1.Open "select * from mytabel WHERE DWS='" & gsname & "'", cn, 3, 3
astr = ""
If Combo1.Text <> "" And Trim(Combo1.Text) <> "全部" Then astr = " and spname='" & Trim(Combo1.Text) & "'"
If rs.State Then rs.Close
rs.Open "select rkdate,rkxz,spname,rksl,rkname from rk where year(rkdate)='" & Trim(Text1) & "' and month(rkdate)='" & Trim(Text2) & "' and  DWS='" & gsname & "'" & astr, cn, 1, 1
Do While Not rs.EOF
rs1.addnew
rs1.Fields(0) = rs.Fields(0)
rs1.Fields(1) = rs.Fields(1)
rs1.Fields(2) = rs.Fields(2)
rs1.Fields(3) = rs.Fields(3)
rs1.Fields(4) = rs.Fields(4)
rs1.Fields("dws") = gsname
rs1.Update
rs.MoveNext
Loop
If rs.State Then rs.Close
rs.Open "select ckdate,ckxz,spname,cksl,ckname from ck where year(ckdate)='" & Trim(Text1) & "' and month(ckdate)='" & Trim(Text2) & "' and DWS='" & gsname & "'" & astr, cn, 1, 1
Do While Not rs.EOF
rs1.addnew
rs1.Fields(0) = rs.Fields(0)
rs1.Fields(1) = rs.Fields(1)
rs1.Fields(2) = rs.Fields(2)
rs1.Fields(3) = rs.Fields(3)
rs1.Fields(4) = rs.Fields(4)
rs1.Fields("dws") = gsname
rs1.Update
rs.MoveNext
Loop

If rs1.State Then rs1.Close
rs1.Open "select * from mytabel WHERE DWS='" & gsname & "' order by mydate", cn, 1, 1
Set MSH.DataSource = rs1
MSH.Cols = 5
For i = 0 To 4
MSH.ColWidth(i) = (MSH.Width - 300) / 5
Next
MSH.TextMatrix(0, 0) = "日期"
MSH.TextMatrix(0, 1) = "事件"
MSH.TextMatrix(0, 2) = "商品名称"
MSH.TextMatrix(0, 3) = "数量"
MSH.TextMatrix(0, 4) = "操作员"
MSH.Refresh
If rs1.State Then rs1.Close
rs1.Open "delete  mytabel where DWS='" & gsname & "'", cn, 3, 3
Dim zs As Double
For i = 1 To MSH.Rows - 1
If Trim((MSH.TextMatrix(i, 1))) = "进货入库" Or Trim((MSH.TextMatrix(i, 1))) = "商品退库" Then zs = zs + Val(MSH.TextMatrix(i, 3)) Else zs = zs - Val(MSH.TextMatrix(i, 3))
MSH.TextMatrix(i, 3) = dw(Val(MSH.TextMatrix(i, 3)), Trim(MSH.TextMatrix(i, 2)))
Next
MSH.Rows = MSH.Rows + 1
MSH.TextMatrix(MSH.Rows - 1, 2) = Format(zs, "#0.00")

End Sub

Private Sub xpcmdbutton10_Click()
Me.Hide
mainzz.Show

End Sub

Private Sub xpcmdbutton2_Click()
tim = 0
If username = "" Then loginfrm.Show
Picture2.Visible = False
astr = ""
If Combo1.Text <> "" And Trim(Combo1.Text) <> "全部" Then astr = " and spname='" & Trim(Combo1.Text) & "'"
Dim rs1 As ADODB.Recordset
Set rs1 = New ADODB.Recordset
rs1.Open "select * from mytabel WHERE DWS='" & gsname & "'", cn, 3, 3
If rs.State Then rs.Close
rs.Open "select rkdate,rkxz,spname,rksl,zsrk,rkjg,rkname from rk where year(rkdate)='" & Trim(Text1) & "' and month(rkdate)='" & Trim(Text2) & "' and DWS='" & gsname & "'" & astr, cn, 1, 1
Do While Not rs.EOF
rs1.addnew
rs1.Fields(0) = rs.Fields(0)
rs1.Fields(1) = rs.Fields(1)
rs1.Fields(2) = rs.Fields(2)
rs1.Fields(3) = rs.Fields(3)
rs1.Fields(4) = rs.Fields(4)
rs1.Fields(5) = rs.Fields(5)
rs1.Fields(6) = rs.Fields(6)
rs1.Fields("dws") = gsname
rs1.Update
rs.MoveNext
Loop

If rs1.State Then rs1.Close
rs1.Open "select * from mytabel WHERE DWS='" & gsname & "' order by mydate", cn, 1, 1
Set MSH.DataSource = rs1
MSH.Cols = 8
For i = 0 To 7
MSH.ColWidth(i) = (MSH.Width - 300) / 8
Next
MSH.TextMatrix(0, 0) = "日期"
MSH.TextMatrix(0, 1) = "事件"
MSH.TextMatrix(0, 2) = "商品名称"
MSH.TextMatrix(0, 3) = "入库数量"
MSH.TextMatrix(0, 4) = "赠送数量"
MSH.TextMatrix(0, 5) = "入库价格"
MSH.TextMatrix(0, 6) = "操作员"
MSH.TextMatrix(0, 7) = "应付款"

MSH.Refresh
If rs1.State Then rs1.Close
rs1.Open "delete  mytabel where DWS='" & gsname & "' ", cn, 3, 3
Dim zs As Double
Dim zs1 As Double
Dim zs2 As Double
Dim zs3 As Double
For i = 1 To MSH.Rows - 1
zs = zs + Val(MSH.TextMatrix(i, 3))
zs1 = zs1 + Val(MSH.TextMatrix(i, 4))
zs2 = zs2 + Val(MSH.TextMatrix(i, 5))
If Trim(MSH.TextMatrix(i, 1)) = "进货入库" Then
MSH.TextMatrix(i, 7) = Format(Val(MSH.TextMatrix(i, 3)) * Val(MSH.TextMatrix(i, 5)), "#0.00")
zs3 = zs3 + Val(MSH.TextMatrix(i, 3)) * Val(MSH.TextMatrix(i, 5))
End If
MSH.TextMatrix(i, 3) = dw(Val(MSH.TextMatrix(i, 3)), Trim(MSH.TextMatrix(i, 2)))

Next
MSH.Rows = MSH.Rows + 1
MSH.TextMatrix(MSH.Rows - 1, 3) = Format(zs, "#0.00")
MSH.TextMatrix(MSH.Rows - 1, 4) = Format(zs1, "#0.00")
MSH.TextMatrix(MSH.Rows - 1, 5) = Format(zs2, "#0.00")
MSH.TextMatrix(MSH.Rows - 1, 7) = Format(zs3, "#0.00")
End Sub

Private Sub xpcmdbutton3_Click()
tim = 0
If username = "" Then loginfrm.Show
Picture2.Visible = False
Dim rs1 As ADODB.Recordset
Set rs1 = New ADODB.Recordset
rs1.Open "select * from mytabel WHERE DWS='" & gsname & "'", cn, 3, 3
astr = ""
If Combo1.Text <> "" And Trim(Combo1.Text) <> "全部" Then astr = " and spname='" & Trim(Combo1.Text) & "'"
If rs.State Then rs.Close
rs.Open "select ckdate,ckxz,spname,cksl,beizhu,ckname from ck where year(ckdate)='" & Trim(Text1) & "' and month(ckdate)='" & Trim(Text2) & "' and DWS='" & gsname & "'" & astr, cn, 1, 1
Do While Not rs.EOF
rs1.addnew
rs1.Fields(0) = rs.Fields(0)
rs1.Fields(1) = rs.Fields(1)
rs1.Fields(2) = rs.Fields(2)
rs1.Fields(3) = rs.Fields(3)
rs1.Fields(4) = rs.Fields(4)
rs1.Fields(5) = rs.Fields(5)
rs1.Fields("dws") = gsname
rs1.Update
rs.MoveNext
Loop

If rs1.State Then rs1.Close
rs1.Open "select * from mytabel WHERE DWS='" & gsname & "' order by mydate", cn, 1, 1
Set MSH.DataSource = rs1
MSH.Cols = 8
For i = 0 To 7
MSH.ColWidth(i) = (MSH.Width - 300) / 8
Next
MSH.TextMatrix(0, 0) = "日期"
MSH.TextMatrix(0, 1) = "事件"
MSH.TextMatrix(0, 2) = "商品名称"
MSH.TextMatrix(0, 3) = "数量"
MSH.TextMatrix(0, 4) = "说明"
MSH.TextMatrix(0, 5) = "操作员"
MSH.TextMatrix(0, 6) = "零售价"
MSH.TextMatrix(0, 7) = "总价"
MSH.Refresh
If rs1.State Then rs1.Close
rs1.Open "delete mytabel WHERE DWS='" & gsname & "'", cn, 3, 3
Dim zs As Double
Dim zs1 As Double
Dim jg As Double
For i = 1 To MSH.Rows - 1
jg = 0
If Trim(MSH.TextMatrix(i, 1)) = "商品领用" Then
If rs.State Then rs.Close
rs.Open "select xsj from spkc where spname='" & Trim(MSH.TextMatrix(i, 2)) & "' and DWS='" & gsname & "'", cn
If Not rs.EOF Then
If Not IsNull(rs.Fields(0).Value) Then jg = Val(rs.Fields(0).Value)
End If
MSH.TextMatrix(i, 6) = Format(jg, "#0.00")
MSH.TextMatrix(i, 7) = Format(Val(MSH.TextMatrix(i, 3)) * Val(MSH.TextMatrix(i, 6)), "#0.00")
zs1 = zs1 + Val(MSH.TextMatrix(i, 3)) * Val(MSH.TextMatrix(i, 6))
End If
zs = zs + Val(MSH.TextMatrix(i, 3))
MSH.TextMatrix(i, 3) = dw(Val(MSH.TextMatrix(i, 3)), Trim(MSH.TextMatrix(i, 2)))
Next
MSH.Rows = MSH.Rows + 1
MSH.TextMatrix(MSH.Rows - 1, 3) = Format(zs, "#0.00")
MSH.TextMatrix(MSH.Rows - 1, 7) = Format(zs1, "#0.00")
End Sub

Private Sub xpcmdbutton4_Click()
tim = 0
If username = "" Then loginfrm.Show
Picture2.Visible = False
rs1.Open "select * from mytabel WHERE DWS='" & gsname & "'", cn, 3, 3
astr = ""
If Combo1.Text <> "" And Trim(Combo1.Text) <> "全部" Then astr = " and spname='" & Trim(Combo1.Text) & "'"
If rs.State Then rs.Close
rs.Open "select * from spkc WHERE DWS='" & gsname & "'" & astr, cn, 1, 1
Do While Not rs.EOF
rs1.addnew
rs1.Fields(0) = rs.Fields(0)
rs1.Fields(1) = rs.Fields(1)
rs1.Fields(2) = rs.Fields(2)
rs1.Fields(3) = rs.Fields(3)
rs1.Fields(4) = rs.Fields(4)
rs1.Fields(5) = rs.Fields(5)
rs1.Fields("dws") = gsname
rs1.Update
rs.MoveNext
Loop

If rs1.State Then rs1.Close
rs1.Open "select * from mytabel WHERE DWS='" & gsname & "' order by mydate", cn, 1, 1
Set MSH.DataSource = rs1
MSH.Cols = 9
For i = 0 To 8
MSH.ColWidth(i) = (MSH.Width - 300) / 9
Next
MSH.TextMatrix(0, 0) = "纪录号"
MSH.TextMatrix(0, 1) = "商品名称"
MSH.TextMatrix(0, 2) = "库存数量"
MSH.TextMatrix(0, 3) = "入库价格"
MSH.TextMatrix(0, 4) = "设定最低库存"
MSH.TextMatrix(0, 5) = "零售价格"
MSH.TextMatrix(0, 6) = "库存实价"
MSH.TextMatrix(0, 7) = "零售价值"
MSH.TextMatrix(0, 8) = "利润值"
MSH.Refresh
If rs1.State Then rs1.Close
rs1.Open "delete  mytabel where DWS='" & gsname & "'", cn, 3, 3
Dim zs As Double
Dim zs1 As Double
Dim zs2 As Double
Dim zs3 As Double
For i = 1 To MSH.Rows - 1

MSH.TextMatrix(i, 6) = Format(Val(MSH.TextMatrix(i, 2)) * Val(MSH.TextMatrix(i, 3)), "#0.00")
zs = zs + Val(MSH.TextMatrix(i, 2))
zs3 = zs3 + Val(MSH.TextMatrix(i, 2)) * Val(MSH.TextMatrix(i, 3))
MSH.TextMatrix(i, 7) = Format(Val(MSH.TextMatrix(i, 2)) * Val(MSH.TextMatrix(i, 5)), "#0.00")
zs1 = zs1 + Val(MSH.TextMatrix(i, 2)) * Val(MSH.TextMatrix(i, 5))
MSH.TextMatrix(i, 8) = Format(Val(MSH.TextMatrix(i, 2)) * (Val(MSH.TextMatrix(i, 5)) - Val(MSH.TextMatrix(i, 3))), "#0.00")
zs2 = zs2 + Val(MSH.TextMatrix(i, 2)) * (Val(MSH.TextMatrix(i, 5)) - Val(MSH.TextMatrix(i, 3)))
MSH.TextMatrix(i, 2) = dw(Val(MSH.TextMatrix(i, 2)), Trim(MSH.TextMatrix(i, 1)))
Next
MSH.Rows = MSH.Rows + 1
MSH.TextMatrix(MSH.Rows - 1, 2) = Format(zs, "#0.00") & "(件)"
MSH.TextMatrix(MSH.Rows - 1, 6) = Format(zs3, "#0.00")
MSH.TextMatrix(MSH.Rows - 1, 7) = Format(zs1, "#0.00")
MSH.TextMatrix(MSH.Rows - 1, 8) = Format(zs2, "#0.00")

End Sub

Private Sub xpcmdbutton5_Click()
Me.Hide
mainjz.Show

End Sub

Private Sub xpcmdbutton6_Click()
cleardb.Show
End Sub
Private Sub xpcmdbutton7_Click()
Adodc1.RecordSource = "select id as 记录号,spname as 商品名称,spsl as 库存数量,pvepice as 入库价格, zdkc as 最低库存,xsj as 零售价 from spkc WHERE DWS='" & gsname & "'"
Adodc1.Refresh
Set MSHF.DataSource = Adodc1.Recordset
MSHF.Refresh
For i = 1 To MSHF.Rows - 1
MSHF.TextMatrix(i, 2) = dw(Val(MSHF.TextMatrix(i, 2)), Trim(MSHF.TextMatrix(i, 1)))
Next
Picture2.Visible = True
Text3.Visible = False
tim = 0
If username = "" Then loginfrm.Show



End Sub

Private Sub xpcmdbutton8_Click()
tim = 0
If username = "" Then loginfrm.Show
If rs.State Then rs.Close
rs.Open "select * from spkc where DWS='" & gsname & "' and id=" & spid, cn, 3, 3
rs.Fields("xsj").Value = Val(Text3)
rs.Update
If rs.State Then rs.Close
Text3.Visible = False
MSHF.TextMatrix(hrow, 5) = Val(Text3)
Text3 = ""
xpcmdbutton8.Visible = False



End Sub

Public Function dw(sl As Double, ss As String) As String
On Error GoTo ext
Dim dv As Double
dw = ""
dv = 1
Dim dl As Double
If rs.State Then rs.Close
rs.Open "select spdw,mdwsl,splb from spxx where spname='" & Trim(ss) & "' and DWS='" & gsname & "'", cn, 1, 1
If Not rs.EOF Then
dv = Val(rs.Fields(1).Value)
dl = sl \ dv
If dl > 0 Then dw = dl & Trim(rs.Fields(0).Value)
dw = dw & CStr(sl Mod dv) & Trim(rs.Fields(2).Value)
Else
dw = CStr(sl)
End If
Exit Function
ext:
dw = CStr(sl)

End Function

Private Sub xpcmdbutton9_Click()
Me.Hide
mainfz.Show

End Sub