frmrk.frm

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

   End
   Begin VB.Label Label5 
      BackStyle       =   0  'Transparent
      Caption         =   "赠送数量："
      Height          =   375
      Left            =   480
      TabIndex        =   8
      Top             =   3105
      Width           =   1095
   End
   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      Caption         =   "本次进货价："
      Height          =   255
      Left            =   360
      TabIndex        =   6
      Top             =   2505
      Width           =   1215
   End
   Begin VB.Label Label3 
      BackStyle       =   0  'Transparent
      Caption         =   "入库数量："
      Height          =   255
      Left            =   480
      TabIndex        =   5
      Top             =   2130
      Width           =   975
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "商品名称："
      Height          =   255
      Left            =   510
      TabIndex        =   1
      Top             =   1560
      Width           =   975
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "入库登记"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   24
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   675
      Left            =   135
      TabIndex        =   0
      Top             =   570
      Width           =   4545
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H00FF8080&
      BackStyle       =   1  'Opaque
      Height          =   9195
      Left            =   150
      Shape           =   4  'Rounded Rectangle
      Top             =   375
      Width           =   4560
   End
End
Attribute VB_Name = "Frmrk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim oldx As Long
Dim oldy As Long
Dim mov As Boolean
Dim jgs As Double
Dim dwn As Double
Dim ylzs As Double

Private Sub Combo2_Click()
Label6.Caption = Trim(Combo2.Text)
End Sub

Private Sub Form_Unload(Cancel As Integer)
tim = 0
End Sub

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

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
tim = 0
If mov Then
Me.Move Me.Left + (X - oldx), Me.Top + (Y - oldy)
End If
End Sub
Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
mov = False
End Sub
Private Sub cmd1_Click()
tim = 0
If Trim(Combo1.Text) = "" Then MsgBox "商品名没有填写！", vbOKOnly + vbExclamation, "神龙网吧仓库工具": Exit Sub
If Val(Text1.Text) = 0 Then MsgBox "入库数量没有填写！", vbOKOnly + vbExclamation, "神龙网吧仓库工具": Exit Sub
If Val(Text2.Text) = 0 Then MsgBox "进货价格没有填写！", vbOKOnly + vbExclamation, "神龙网吧仓库工具": Exit Sub
If Trim(Combo2.Text) = "" Then MsgBox "商品单位没有填写！", vbOKOnly + vbExclamation, "神龙网吧仓库工具": Exit Sub


Call savesp
Combo1.Text = ""
Text1 = ""
Text2 = ""
Text3 = ""
Combo2.Text = ""
loadsp

End Sub

Private Sub cmd2_Click()
tim = 0
If Trim(Combo1.Text) = "" Then MsgBox "商品名没有填写！", vbOKOnly + vbExclamation, "神龙网吧仓库工具": Exit Sub
If Val(Text1.Text) = 0 Then MsgBox "入库数量没有填写！", vbOKOnly + vbExclamation, "神龙网吧仓库工具": Exit Sub
If Val(Text2.Text) = 0 Then MsgBox "进货价格没有填写！", vbOKOnly + vbExclamation, "神龙网吧仓库工具": Exit Sub
If Trim(Combo2.Text) = "" Then MsgBox "商品单位没有填写！", vbOKOnly + vbExclamation, "神龙网吧仓库工具": Exit Sub

Call savesp
Combo1.Text = ""
Text1 = ""
Text2 = ""
Text3 = ""
Combo2.Text = ""

Unload Me

End Sub

Private Sub cmd3_Click()
tim = 0

Unload Me
End Sub

Private Sub cmd4_Click()
spdj.rkdjfrm = True
spdj.Show
End Sub

Private Sub Combo1_Click()
tim = 0
Label7.Caption = ""
loaddw
End Sub

Private Sub Form_Load()
Me.Left = Screen.Width - Me.Width
Me.Top = 400
Adodc1.ConnectionString = connstr
Adodc1.CommandType = adCmdText
Call topme(Me)
Call loadsp
tim = 0
Call loadmsh
If username = "" Then loginfrm.Show
End Sub

Public Sub savesp()
Dim sl As Double
Dim zj As Double
rkdh = Format(Now, "yyyymmddhhmmss") & "-" & userid
Adodc2.ConnectionString = connstr
Adodc2.CommandType = adCmdText
Adodc2.RecordSource = "select * from rk where id=0"
Adodc2.Refresh

With Adodc2.Recordset
dwn = 0
jgs = 0
ylzs = 0
 If loadbh(Trim(Combo2.Text), Trim(Combo1.Text), Val(Text1.Text), Val(Text3.Text), Val(Text2.Text)) = False Then
 MsgBox "此商品计量单位在商品信息中无法找到，请修改商品基本信息！", vbOKOnly + vbExclamation, "商品未找到"
 Exit Sub
 End If
.addnew
.Fields("rkdh") = rkdh
.Fields("spname") = Trim(Combo1.Text)

.Fields("rksl") = dwn
.Fields("rkjg") = Format(jgs, "#0.00")
.Fields("zsrk") = ylzs
.Fields("rkxz") = "进货入库"
.Fields("rkname") = username
.Fields("rkdate") = Now
.Fields("dws") = gsname
.Update
sl = dwn + ylzs
zj = jgs * sl
End With

Adodc2.RecordSource = "select * from spkc where spname='" & Trim(Combo1.Text) & "' and DWS='" & gsname & "'"
Adodc2.Refresh
If Adodc2.Recordset.EOF Then
With Adodc2.Recordset
.addnew
.Fields("spname") = Trim(Combo1.Text)
.Fields("spsl") = sl
.Fields("pvepice") = Format(jgs, "#0.00")

.Fields("dws") = gsname
.Update
End With
Else
With Adodc2.Recordset
.Fields("spsl") = dwn + .Fields("spsl")
sl = sl + Val(.Fields("spsl"))
zj = zj + (Val(.Fields("spsl")) * Val(.Fields("pvepice")))
.Fields("pvepice") = Format(zj / sl, "#0.00")
.Update
End With
End If
Call loadmsh
Label7.Caption = "商品：" & Trim(Combo1.Text) & "已经入库！"

End Sub

Public Sub loadsp()

Adodc1.RecordSource = "select DISTINCT spname from spxx WHERE DWS='" & gsname & "'"
Adodc1.Refresh
Combo1.Clear
Do While Not Adodc1.Recordset.EOF
Combo1.AddItem Adodc1.Recordset.Fields("spname")
Adodc1.Recordset.MoveNext
Loop
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
tim = 0
If KeyAscii = 13 Then Text2.SetFocus



End Sub

Private Sub Text1_LostFocus()
If loadbh(Trim(Combo2.Text), Trim(Combo1.Text), Val(Text1.Text), Val(Text3.Text), Val(Text2.Text)) = False Then
 Label11.Caption = ""
 Label12.Caption = ""
Else
 Label11.Caption = dwn
 Label12.Caption = jgs
End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
tim = 0
If KeyAscii = 13 Then Text3.SetFocus
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
tim = 0
If KeyAscii = 13 Then Call cmd2_Click
End Sub

Public Sub loaddw()
Combo2.Text = ""
Combo2.Clear
Adodc1.RecordSource = "select spdw,splb from spxx where spname='" & Trim(Combo1.Text) & "' and DWS='" & gsname & "'"
Adodc1.Refresh
If Not Adodc1.Recordset.EOF Then
Combo2.AddItem Trim(Adodc1.Recordset.Fields(0).Value)
Combo2.AddItem Trim(Adodc1.Recordset.Fields(1).Value)
Combo2.Text = Trim(Adodc1.Recordset.Fields(1).Value)
End If
End Sub

Private Sub xpcmdbutton1_Click()
Unload Me
rkwh.Frame1.Visible = True
rkwh.Frame2.Visible = False
rkwh.Show

End Sub

Public Sub loadmsh()
With MSH
.Clear
.Cols = 5
.Rows = 1
.TextMatrix(0, 0) = "入库时间"
.TextMatrix(0, 1) = "商品名"
.TextMatrix(0, 2) = "数量"
.TextMatrix(0, 3) = "价格"
.TextMatrix(0, 4) = "备注"
For i = 0 To 4
.ColAlignment(i) = 4
.ColAlignmentFixed(i) = 4
Next
i = 0
If rs.State Then rs.Close
rs.Open "select * from rk where year(rkdate)='" & Year(Date) & "' and month(rkdate)='" & Month(Date) & "' and day(rkdate)='" & Day(Date) & "' and DWS='" & gsname & "'", cn, 1, 1
Do While Not rs.EOF
i = i + 1
.AddItem Format(rs.Fields("rkdate"), "HH:MM:SS") & vbTab & Trim(rs.Fields("spname")) & vbTab & dw(Val(rs.Fields("rksl")), Trim(rs.Fields("spname"))) & vbTab & Format(rs.Fields("rkjg"), "#0.00") & vbTab & IIf(rs("zsrk") > 0, "附送：" & dw(rs("zsrk"), Trim(rs.Fields("spname"))), "")
rs.MoveNext
Loop
If rs.State Then rs.Close
End With



End Sub

Public Function loadbh(ss As String, spm As String, yls As Double, zss As Double, yljg As Double) As Boolean
dwn = 0
If rs.State Then rs.Close
rs.Open "select spdw,mdwsl,splb from spxx where spname='" & Trim(Combo1.Text) & "' and DWS='" & gsname & "'", cn, 1, 1
If rs.EOF Then
loadbh = False
Else
    If ss = Trim(rs.Fields("spdw").Value) Then
    dwn = yls * CDbl(rs.Fields("mdwsl").Value)
    jgs = yljg / CDbl(rs.Fields("mdwsl").Value)
    ylzs = zss * CDbl(rs.Fields("mdwsl").Value)
    loadbh = True
    ElseIf ss = Trim(rs.Fields("splb").Value) Then
    dwn = yls
    jgs = yljg
    ylzs = zss
    loadbh = True
    Else
    loadbh = False
    End If
End If




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

End Function