frmsale_bs.frm

ktv场所的包房开房、迎宾、预定管理系统。

End Sub

Private Sub msglist_DblClick()
        If txt_qty.Enabled = False Then Exit Sub
        If msglist.rows = 1 Or msglist.TextMatrix(msglist.row, 1) = "" Then
            Exit Sub
        End If
        With msglist
            txt_id.text = .TextMatrix(.row, 1)
            txt_name.text = .TextMatrix(.row, 2)
            combdw = .TextMatrix(.row, 3)
            txt_qty.text = .TextMatrix(.row, 5)
            combdj.Clear
            combdj = .TextMatrix(.row, 4)
            txt_total.text = .TextMatrix(.row, 6)
'            Text1 = .TextMatrix(.row, 7)
        End With
        txt_qty.SetFocus
        txt_qty.tag = txt_qty.text
        SendKeys "{Home}+{End}"
        CmdAct(1).Enabled = True
        CmdAct(0).Enabled = False
        CmdAct(2).Enabled = False
        CmdAct(3).Enabled = False
        txt_id.Enabled = False
End Sub

Private Sub msglist_KeyPress(KeyAscii As Integer)
        If txt_qty.Enabled = False Then Exit Sub
    If KeyAscii = 13 Then
        If msglist.TextMatrix(msglist.row, 1) = "" Then
            Exit Sub
        End If
        With msglist
            txt_id.text = .TextMatrix(.row, 1)
            txt_name.text = .TextMatrix(.row, 2)
            combdw = .TextMatrix(.row, 3)
            txt_qty.text = .TextMatrix(.row, 5)
            combdj.Clear
            combdj = .TextMatrix(.row, 4)
            txt_total.text = .TextMatrix(.row, 6)
'            Text1 = .TextMatrix(.row, 7)
        End With
        txt_qty.SetFocus
        txt_qty.tag = txt_qty.text
        SendKeys "{Home}+{End}"
        CmdAct(1).Enabled = True
        CmdAct(0).Enabled = False
        CmdAct(2).Enabled = False
        CmdAct(3).Enabled = False
        txt_id.Enabled = False
    End If
End Sub


Private Sub txt_id_Change()

Dim s As String
Dim mrc As ADODB.Recordset
Dim TxtSQL As String
Dim msgtext As String
Dim i, j, m As Integer
    
    If Trim$(txt_id.text) <> "" Then
        s = Mid(txt_id.text, 1, 1)
        If LCase(Asc(s)) > 57 Then
            m = 0
            With flex_pro
                For i = 1 To .rows - 1
                    For j = 1 To Len(Trim$(txt_id.text))
                        If Mid(Trim$(.TextMatrix(i, 5)), j, 1) = UCase(Mid(Trim$(txt_id.text), j, 1)) Then
                            If j > m Then
                                .col = 1
                                .row = i
                                .TopRow = i
                                m = j
                            End If
                        Else
                            Exit For
                        End If
                    Next j
                Next i
            End With
        End If
    End If

End Sub

Private Sub txt_id_GotFocus()
     SendKeys "{Home}+{End}"
    flex_pro.Visible = True
End Sub


Private Sub txt_id_KeyDown(KeyCode As Integer, Shift As Integer)
With flex_pro
    Select Case KeyCode
        Case 40
             If .row < .rows - 1 Then
                .row = .row + 1
                .TopRow = .row
            End If
        Case 38
            If .row > 1 Then
                .row = .row - 1
                .TopRow = .row
            End If
        Case 34 '上页
            If .rows - .TopRow > 10 Then
                .TopRow = .TopRow + 10
                .row = .TopRow
            End If
        
        Case 33 '下页
            If .TopRow < 10 Then
                .TopRow = 1
                .row = .TopRow
            Else
                If .rows - .TopRow > 10 Then
                    .TopRow = .TopRow - 10
                    .row = .TopRow
                End If
            End If
    End Select
End With
End Sub

Private Sub txt_id_KeyPress(KeyAscii As Integer)
Dim i As Integer
Dim s As String

    If KeyAscii = 13 And flex_pro.rows > 2 Then
        With flex_pro
            If Trim$(txt_id.text) <> "" Then
                s = Mid(txt_id.text, 1, 1)
                If LCase(Asc(s)) <= 57 Then
                    For i = 1 To .rows - 1
                        If Trim$(.TextMatrix(i, 6)) = Trim$(txt_id.text) Then
                            .col = 1
                            .row = i
                            Exit For
                        End If
                    Next i
                    If i - 1 = .rows - 1 And Trim$(.TextMatrix(i - 1, 6)) <> Trim$(txt_id.text) Then
                        MsgBox "仓库库存中没有此商品", vbInformation, "提示"
                        SendKeys "{home}+{end}"
                        txt_id.SetFocus
                        Exit Sub
                    End If
                End If
            End If
            txt_id = "" & .TextMatrix(.row, 0)
            txt_name = "" & .TextMatrix(.row, 1)
            combdj.Clear
            combdj.AddItem "" & .TextMatrix(.row, 3)
            combdj.ListIndex = 0
            combdw = "" & .TextMatrix(.row, 2)
'            Text1 = "" & .TextMatrix(.row, 6)
            txt_qty.Enabled = True
            txt_qty.text = 1
            txt_qty.SetFocus
            SendKeys "{Home}+{End}"
        End With
    End If
End Sub


Private Sub txt_id_LostFocus()
    flex_pro.Visible = False
End Sub

Private Sub txt_memo_KeyDown(KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
End Sub


Private Sub txt_qty_Change()
 Dim ru As Integer
 
 If txt_qty.Enabled = True Then
    If CmdAct(1).Enabled = True Then
        With flex_pro
            For ru = 1 To .rows - 1
                If Trim$(.TextMatrix(ru, 0)) = Trim$(msglist.TextMatrix(msglist.row, 1)) Then
                    .TextMatrix(ru, 4) = Val(.TextMatrix(ru, 4)) + Val(txt_qty.tag)
                    Exit For
                End If
            Next ru
        End With
    End If
    If Val(txt_qty.text) > Val(flex_pro.TextMatrix(flex_pro.row, 4)) Then
        MsgBox "库存数量不足！", vbCritical, "警告"
        txt_qty.text = "" & Val(flex_pro.TextMatrix(flex_pro.row, 4))
         SendKeys "{Home}+{End}"
    End If
End If

End Sub


Private Sub txt_qty_KeyPress(KeyAscii As Integer)

    If KeyAscii = 13 Then
        If IsNumeric(txt_qty.text) = False Then
            MsgBox "必须输入数字！", vbInformation, "提示"
            txt_qty.SetFocus
            Exit Sub
        End If
        If txt_qty.text = "" Or txt_qty.text <= 0 Then
            MsgBox "请输入正确的报损数量！", vbInformation, "提示"
            txt_qty.SetFocus
            Exit Sub
        End If
        combdj.SetFocus
    End If
End Sub

Private Sub txt_qty_LostFocus()

    If txt_qty.Enabled = True Then
        txt_total.text = Format(CStr(Val(txt_qty.text) * Val(combdj.text)), "0.000")
    End If
                
End Sub


Private Sub txtsa_id_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 And txtsa_id.text <> "" Then
        If Len(txtsa_id.text) = 7 Then
            txtsa_id.text = "CK" & txtsa_id.text
        End If
        CmdAct(2).Enabled = True
        CmdAct(3).Enabled = True
    Else
        CmdAct(2).Enabled = False
        CmdAct(3).Enabled = False
    End If
End Sub

Private Sub txtsa_id_Validate(Cancel As Boolean)
    If txtsa_id.text <> "" Then
        If Len(txtsa_id.text) = 7 Then
            txtsa_id.text = "CR" & txtsa_id.text
        End If
        CmdAct(2).Enabled = True
        CmdAct(3).Enabled = True
    Else
        CmdAct(2).Enabled = False
        CmdAct(3).Enabled = False
    End If
End Sub


Private Sub txtsa_date_KeyDown(KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
End Sub

Private Sub txtsa_demo_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then CmdAct(2).SetFocus
End Sub

Private Sub txtsa_maker_KeyDown(KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
End Sub

Private Sub txtsa_rid_KeyDown(KeyCode As Integer, Shift As Integer)
   EnterToTab KeyCode
End Sub

Public Sub showtitle()
    
    With msglist
        .Cols = 7
        .rows = 2
        .TextMatrix(0, 0) = "序号"
        .TextMatrix(0, 1) = "编号"
        .TextMatrix(0, 2) = "产品名称"
        .TextMatrix(0, 3) = "单位"
        .TextMatrix(0, 4) = "单价"
        .TextMatrix(0, 5) = "数量"
        .TextMatrix(0, 6) = "金额"
        .ColAlignment(1) = 1
        .ColAlignment(2) = 1
        .ColAlignment(3) = 1
        .ColAlignment(4) = 1
        .ColAlignment(5) = 1
        .ColAlignment(6) = 1
        
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        .RowSel = 1
        .ColSel = .Cols - 1
        
        .colWidth(0) = 600
        .colWidth(1) = 1000
        .colWidth(2) = 2800
        .colWidth(3) = 800
        .colWidth(4) = 800
        .colWidth(5) = 800
        .colWidth(6) = 1100
        
        .row = 1
    End With
End Sub

Private Sub updatesales(ByVal pos As Integer)

    Dim mrc As New ADODB.Recordset
    If pos = 1 Then
        mrc.Open "select * from ps_head_b where ps_id='" & txtsa_id.text & "'", cnn, adOpenDynamic, adLockOptimistic
        With mrc
            .AddNew
            !PS_id = "" & txtsa_id.text
            !PS_date = dtptime.Value
            !ps_maker = "" & txtsa_maker.text
            !ps_demo = "" & txt_memo.text
            !ps_type = "" & Combtype.text
            !ps_total = Val(txt_total.text)
            mrc.Update
        End With
    End If
    If mrc.State = adStateOpen Then mrc.Close
    
    mrc.Open "select * from order_detail_b where order_id=' " & txtsa_id.text & "'", cnn, adOpenDynamic, adLockOptimistic
    With mrc
        .AddNew
        !order_id = "" & txtsa_id.text
        !p_id = msglist.TextMatrix(pos, 1)
        !p_name = "" & msglist.TextMatrix(pos, 2)
        !unit_price = Val("" & msglist.TextMatrix(pos, 4))
        !qty = msglist.TextMatrix(pos, 5)
        !price = msglist.TextMatrix(pos, 6)
        !UNIT = msglist.TextMatrix(pos, 3)
        mrc.Update
    End With
    If mrc.State = adStateOpen Then mrc.Close
    Set mrc = Nothing
    cnn.Execute "update mat_detail set qty=qty- " & Val(msglist.TextMatrix(pos, 5)) & " where p_id='" & Trim$(msglist.TextMatrix(pos, 1)) & "'"
    
End Sub


Public Sub totalprice()
Dim i As Integer
Dim totalnum As Double

    totalnum = 0
    With msglist
        For i = 1 To .rows - 1
            totalnum = totalnum + Val(.TextMatrix(i, 6))
        Next
    End With
    Label2.Caption = Format(totalnum, "0.000")
    lab_total.Caption = ChMoney(Val(Label2.Caption))
End Sub

Private Sub showtitle_pro()
    Dim i As Integer
    
    With flex_pro
        .Cols = 7
        If .rows <= 2 Then
            .rows = 2
        End If
        
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        .RowSel = 1
        .ColSel = .Cols - 1
        
        .TextMatrix(0, 0) = "编号"
        .TextMatrix(0, 1) = "商品名称"
        .TextMatrix(0, 2) = "单位"
        .TextMatrix(0, 3) = "单价"
        .TextMatrix(0, 4) = "库存"
        .TextMatrix(0, 5) = "拼音码"
        .TextMatrix(0, 6) = "条形码"
            
        .ColAlignment(0) = 1
        .ColAlignment(1) = 1
        .ColAlignment(2) = 1
        .ColAlignment(3) = 1
        .ColAlignment(4) = 1
        .ColAlignment(5) = 1
        .ColAlignment(6) = 1

        .colWidth(0) = 800
        .colWidth(1) = 2500
        .colWidth(2) = 800
        .colWidth(3) = 800
        .colWidth(4) = 1000
        .colWidth(5) = 1200
        .colWidth(6) = 1600
        .row = 1
    End With
End Sub