frmpsout.frm

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

        CmdAct(3).Enabled = False
        txt_id.Enabled = False
        CmdAct(7).Enabled = False
        CmdAct(1).Enabled = True
        
End Sub

Private Sub msglist_KeyPress(KeyAscii As Integer)
    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 = .TextMatrix(.row, 4)
            txt_total.text = .TextMatrix(.row, 6)
        End With
        txt_qty.SetFocus
        txt_qty.tag = txt_qty.text
        SendKeys "{Home}+{End}"
'        CmdAct(1).Enabled = True
        cmdSave.Enabled = False
        CmdAct(2).Enabled = False
        CmdAct(3).Enabled = False
        txt_id.Enabled = True
        CmdAct(7).Enabled = False
        CmdAct(1).Enabled = True
    End If
End Sub


Private Sub txt_id_Change()

    Dim i As Long, j As Long, m As Long
    
    If Trim$(txt_id.text) <> "" Then

        If Asc(Left$(txt_id.text, 1)) > 57 Or Asc(Right$(txt_id.text, 1)) > 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, 6)), 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
        Else
            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, 0)), 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()
    'txt_id = ""
     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 Long
    Dim bFinded As Boolean
    On Error GoTo errpro
    bFinded = False
    If KeyAscii = 13 And flex_pro.rows > 2 Then
        With flex_pro
            txt_id = "" & .TextMatrix(.row, 0)
            txt_name = "" & .TextMatrix(.row, 1)
            combdj = "" & .TextMatrix(.row, 3)
            combdw = "" & .TextMatrix(.row, 2)
            txt_qty.Enabled = True
            txt_qty.text = 1
            num = "" & .TextMatrix(.row, 4)
            txt_qty.SetFocus
            SendKeys "{Home}+{End}"


        End With
    End If
    Exit Sub
errpro:
    MsgBox "错误号为：" & Err.Number & "说明" & Err.Description
    Exit Sub
    
    
    
    
    
    
    
    
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)
                    txt_qty.tag = txt_qty
                    If Val(txt_qty.text) > flex_pro.TextMatrix(flex_pro.row, 4) Then
                        MsgBox "库存数量不足！", vbCritical, "警告"
'                        txt_qty.text = "" & flex_pro.TextMatrix(flex_pro.row, 4)
'                         txt_qty.tag = txt_qty
                         SendKeys "{Home}+{End}"
                    End If
                    .TextMatrix(ru, 4) = Val(.TextMatrix(ru, 4)) - Val(txt_qty.tag)
                    Exit For
                End If
            Next ru
        End With
    Else
        If Val(txt_qty.text) > Val(flex_pro.TextMatrix(flex_pro.row, 4)) Then
            MsgBox "库存数量不足！", vbCritical, "警告"
            txt_qty.text = "" & flex_pro.TextMatrix(flex_pro.row, 4)
             SendKeys "{Home}+{End}"
        End If
    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 = "" Then
            MsgBox "请输入出库数量！", vbInformation, "提示"
            txt_qty.SetFocus
            Exit Sub
        End If
        If txt_qty.text <= 0 Then
            MsgBox "出库数量输入错误！", vbInformation, "提示"
            txt_qty.SetFocus
            Exit Sub
        End If
        combdj.Enabled = True
        combdj.SetFocus
        'txt_price = Val(txt_qty) * Val(txt_unit)
        txt_total = Val(txt_qty) * Val(combdj) * (100 / 100)
    End If
End Sub

Private Sub txt_qty_LostFocus()
    If txt_qty.Enabled = True Then
        txt_total = 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

Public Sub showtitle()
    Dim i As Integer
    
    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) = "金额"
        '设置各列的对齐方
        For i = 1 To 6
            .ColAlignment(i) = 1
        Next i
        '表头项居中
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        .RowSel = 1
        .ColSel = .Cols - 1
        '.CellAlignment = 4
        '设置单元大小
        .colWidth(0) = 800
        .colWidth(1) = 1000
        .colWidth(2) = 2500
        .colWidth(3) = 800
        .colWidth(4) = 800
        .colWidth(5) = 800
        .colWidth(6) = 1200
        
        .row = 1
    End With
End Sub

Private Sub updatesales(ByVal lPos As Long)

Dim TxtSQL As String
Dim mrc As New ADODB.Recordset

    If lPos = 1 Then
        TxtSQL = "select * from psout_head where ps_id=' " & txtsa_id.text & "'"
        mrc.Open TxtSQL, cnn, adOpenDynamic, adLockOptimistic
        With mrc
            .AddNew
            !PS_id = "" & txtsa_id.text
            !PS_date = dtptime.Value
            !ps_rid = "" & Comsupp.ItemData(Comsupp.ListIndex)
            !ps_maker = "" & txtsa_maker.text
            !ps_demo = "" & txt_memo.text
            !ps_men = "" & Combtype.text
            !ps_total = Val("0" & Label2.Caption)
            mrc.Update
        End With
    End If
    If mrc.State = adStateOpen Then mrc.Close
    TxtSQL = "select * from psout_detail where order_id=' " & txtsa_id.text & "'"   'this mrc most be NULL,in order to retrieve least data from engine
    mrc.Open TxtSQL, cnn, adOpenDynamic, adLockOptimistic
    With mrc
        .AddNew
        !order_id = "" & txtsa_id.text
        !p_id = msglist.TextMatrix(lPos, 1)
        !p_name = "" & msglist.TextMatrix(lPos, 2)
        !unit_price = Val("" & msglist.TextMatrix(lPos, 4))
        !qty = msglist.TextMatrix(lPos, 5)
        !price = Val("" & msglist.TextMatrix(lPos, 6))
        !UNIT = msglist.TextMatrix(lPos, 3)
        mrc.Update
    End With
    If mrc.State = adStateOpen Then mrc.Close

    TxtSQL = "update mat_detail set qty=qty-" & Val(msglist.TextMatrix(lPos, 5)) & " where p_id='" & msglist.TextMatrix(lPos, 1) & "'"
    cnn.Execute TxtSQL

    TxtSQL = "select * from mat_detail_bt where p_id='" & msglist.TextMatrix(lPos, 1) & "'"
    TxtSQL = TxtSQL & " and location='" & Comsupp.ItemData(Comsupp.ListIndex) & "'"
    mrc.Open TxtSQL, cnn, adOpenDynamic, adLockOptimistic
    If mrc.EOF = True Then
        With mrc
            .AddNew
            !p_id = msglist.TextMatrix(lPos, 1)
            !p_name = "" & msglist.TextMatrix(lPos, 2)
            !unit_price = Val("" & msglist.TextMatrix(lPos, 4))
            !qty = msglist.TextMatrix(lPos, 5)
            !price = Val("" & msglist.TextMatrix(lPos, 6))
            !UNIT = msglist.TextMatrix(lPos, 3)
            !Location = "" & Comsupp.ItemData(Comsupp.ListIndex)
            mrc.Update
        End With
    Else
        TxtSQL = "update mat_detail_bt set qty=qty+" & Val(msglist.TextMatrix(lPos, 5)) & " where p_id='" & msglist.TextMatrix(lPos, 1) & "'"
        TxtSQL = TxtSQL & " and location='" & Comsupp.ItemData(Comsupp.ListIndex) & "'"
        cnn.Execute TxtSQL
    End If
    If mrc.State = adStateOpen Then mrc.Close
    Set mrc = Nothing
End Sub


Public Sub totalprice()

Dim i As Integer
Dim totalnum As Double
Dim sP As Currency

Dim rst As New ADODB.Recordset

    totalnum = 0
    sP = 0
    With msglist
        For i = 1 To .rows - 2
            totalnum = totalnum + Val(.TextMatrix(i, 6))
            rst.Open "select * from product where p_id='" & .TextMatrix(i, 1) & "'", cnn, adOpenDynamic, adLockOptimistic
            
            sP = CStr(sP + Val("" & rst!product_pst) * Val(.TextMatrix(i, 5)))
            rst.Close
        Next
    End With

    Label2.Caption = Format(totalnum, "0.000")
    Label1.Caption = sP
    lab_total = ChMoney(Val(Label2))
    
    
    
End Sub
Private Sub showtitle_pro()
    Dim i As Integer
    
    With flex_pro
        .Cols = 8
        If .rows <= 2 Then
            .rows = 2
        End If
        .TextMatrix(0, 0) = "编号"
        .TextMatrix(0, 1) = "商品名称"
        .TextMatrix(0, 2) = "单位"
        .TextMatrix(0, 3) = "单价"
        .TextMatrix(0, 4) = "数量"
        .TextMatrix(0, 5) = "金额"
        .TextMatrix(0, 6) = "拼音码"
        .TextMatrix(0, 7) = "条形码"
        '设置各列的对齐方
        For i = 0 To 7
            .ColAlignment(i) = 1
        Next i
        '表头项居中
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        .RowSel = 1
        .ColSel = .Cols - 1
        '.CellAlignment = 4
        
        '设置单元大小
        .colWidth(0) = 800
        .colWidth(1) = 3000
        .colWidth(2) = 800
        .colWidth(3) = 800
        .colWidth(4) = 900
        .colWidth(5) = 1000
        .colWidth(6) = 1000
        .colWidth(7) = 1600
        .row = 1
    End With
End Sub