frmck.frm

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

      Top             =   2205
      Width           =   3600
   End
   Begin VB.Label Label3 
      BackStyle       =   0  'Transparent
      Caption         =   "领出数量："
      Height          =   285
      Left            =   540
      TabIndex        =   3
      Top             =   1860
      Width           =   990
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "商品名称："
      Height          =   255
      Left            =   585
      TabIndex        =   1
      Top             =   1335
      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          =   615
      Left            =   180
      TabIndex        =   0
      Top             =   555
      Width           =   4425
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H00FFFFC0&
      BackStyle       =   1  'Opaque
      Height          =   8895
      Left            =   135
      Shape           =   4  'Rounded Rectangle
      Top             =   405
      Width           =   4470
   End
End
Attribute VB_Name = "Frmck"
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 ckspid As Long

Private Sub Form_Load()
Me.Left = Screen.Width - Me.Width
Me.Top = 400
Adodc1.ConnectionString = connstr
Adodc1.CommandType = adCmdText
Adodc2.ConnectionString = connstr
Adodc2.CommandType = adCmdText
loadsp
tim = 0
Call loadmsh1
Call topme(Me)
If username = "" Then loginfrm.Show
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)
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 Combo1.Text = "" Then Exit Sub
If Val(Text1) = 0 Then Exit Sub
savespck
Combo1.Text = "'"
Text1 = ""
loadsp
End Sub

Private Sub cmd2_Click()
If Combo1.Text = "" Then Exit Sub
If Val(Text1) = 0 Then Exit Sub
savespck
Combo1.Text = ""
Text1 = ""
Unload Me
End Sub

Private Sub cmd3_Click()
Unload Me
End Sub

Private Sub cmd4_Click()
tim = 0
spxx.selectxx = True
spxx.Show
End Sub
Public Sub loadsp()
Adodc1.RecordSource = "select DISTINCT spname from spkc 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 Combo1_Click()
tim = 0
Label5.Caption = ""
loaddw
End Sub


Public Sub savespck()
Dim sl As Double
ckdh = Format(Now, "yyyymmddhhmmss") & "-" & userid
Adodc2.RecordSource = "select * from spkc where  DWS='" & gsname & "' and id=" & ckspid
Adodc2.Refresh
If Not Adodc2.Recordset.EOF Then
Adodc2.Recordset.Fields("spsl") = Adodc2.Recordset.Fields("spsl") - loadsl(Trim(Combo2.Text), Val(Text1.Text))
Adodc2.Recordset.Update
Else
MsgBox "仓库中没有此商品", vbExclamation + vbOKOnly, "错误"
Exit Sub
End If
Adodc2.RecordSource = "select * from ck WHERE DWS='" & gsname & "' and ckdh='" & ckdh & "' "
Adodc2.Refresh
With Adodc2.Recordset
.addnew
.Fields("ckdh") = ckdh
.Fields("spname") = Trim(Combo1.Text)
.Fields("cksl") = loadsl(Trim(Combo2.Text), Val(Text1.Text))
.Fields("ckxz") = "商品领用"
.Fields("ckname") = username
.Fields("ckdate") = Now
.Fields("dws") = gsname
.Update

End With

Call loadmsh1

Label5.Caption = "商品：" & Trim(Combo1.Text) & "出库登记完成"
jczdkc
End Sub
Public Sub loaddw()
Dim dwsl As Double
Adodc1.RecordSource = "select splb,mdwsl,spdw from spxx WHERE DWS='" & gsname & "' and spname='" & Trim(Combo1.Text) & "'"
Adodc1.Refresh
Combo2.Clear
If Not Adodc1.Recordset.EOF Then
Combo2.AddItem Trim(Adodc1.Recordset.Fields(2).Value)
Combo2.AddItem Trim(Adodc1.Recordset.Fields(0).Value)
Combo2.Text = Trim(Adodc1.Recordset.Fields(2).Value)
End If
Adodc1.RecordSource = "select spsl,id from spkc WHERE DWS='" & gsname & "' and spname='" & Trim(Combo1.Text) & "'"
Adodc1.Refresh
If Not Adodc1.Recordset.EOF Then
Label5.Caption = "本次最大出库数：" & dw(CDbl(Adodc1.Recordset.Fields(0).Value), Trim(Combo1.Text))
ckspid = Adodc1.Recordset.Fields(1).Value
cmd2.Enabled = True
cmd1.Enabled = True
Else
cmd2.Enabled = False
cmd1.Enabled = False
End If

End Sub

Private Sub Text1_Change()
tim = 0
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call cmd2_Click
End Sub

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


Public Sub loadmsh1()
With MSH1
.Clear
.Cols = 5
.Rows = 1
.TextMatrix(0, 0) = "领用时间"
.TextMatrix(0, 1) = "商品名"
.TextMatrix(0, 2) = "数量"
.TextMatrix(0, 3) = "备注"

For i = 0 To 3
.ColAlignment(i) = 4
.ColAlignmentFixed(i) = 4
Next
i = 0
If rs.State Then rs.Close
rs.Open "select * from ck WHERE DWS='" & gsname & "' and year(ckdate)='" & Year(Date) & "' and month(ckdate)='" & Month(Date) & "' and day(ckdate)='" & Day(Date) & "'", cn, 1, 1
Do While Not rs.EOF
i = i + 1
.AddItem Format(rs.Fields("ckdate"), "HH:MM:SS") & vbTab & Trim(rs.Fields("spname")) & vbTab & dw(Val(rs.Fields("cksl")), Trim(rs.Fields("spname"))) & vbTab
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 form spxx WHERE DWS='" & gsname & "' and spname='" & Trim(Combo1.Text) & "'", cn, 1, 1
If rs.EOF Then
loadbh = False
Else
    If ss = Trim(rs.Fields("spdw").Value) Then
    dwn = yls * Val(rs.Fields("mdwsl").Value)
    jgs = yljg / Val(rs.Fields("mdwsl").Value)
    ylzs = zss * Val(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 DWS='" & gsname & "' and spname='" & Trim(ss) & "'", 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


Public Function loadsl(ss As String, sl As Double) As Double
Dim rs1 As ADODB.Recordset
Set rs1 = New ADODB.Recordset
If rs1.State Then rs1.Close
loadsl = 0
rs1.Open "select spdw,mdwsl,splb from spxx WHERE DWS='" & gsname & "' and spname='" & Trim(Combo1.Text) & "'", cn, 1, 1
If Not rs1.EOF Then
   If ss = Trim(rs1.Fields("spdw").Value) Then
    loadsl = sl * Val(rs1.Fields("mdwsl").Value)
   ElseIf ss = Trim(rs1.Fields("splb").Value) Then
    loadsl = sl
    End If
End If


End Function