frmsale_bs.frm

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

         TabIndex        =   26
         Top             =   5490
         Visible         =   0   'False
         Width           =   585
      End
   End
End
Attribute VB_Name = "frmsale_bs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub CmdAct_Click(Index As Integer)
    Dim intRow As Integer
    Dim blnIsTrue As Boolean
    Dim strsql As String
    Dim depid As String
    Dim sale_id As String
    Dim ru, i As Integer
    Dim mrc As ADODB.Recordset
    Dim TxtSQL As String
    Dim msgtext As String
    Dim rpt As New report
    Dim txt As New clsText
    Dim BTarray(8) As Integer
    Dim recBT(8) As String


    On Error GoTo Err:
    Select Case Index
        Case 0
            If Combtype = "" Then
                MsgBox "单据类型不能为空!", vbCritical, "错误"
                Combtype.SetFocus
                Exit Sub
            End If
            If msglist.rows <= 2 Then
                MsgBox "单据明细项不能为空!", vbCritical, "错误"
                Exit Sub
            End If
            ru = MsgBox("确认保存?", 33, "保存")
            If ru = 2 Then
                Exit Sub
            End If
            With msglist
                For i = 1 To .rows - 1
                    If Trim$(.TextMatrix(i, 1)) <> "" Then
                        updatesales i
                    End If
                Next
            End With
            Call IsEdit(False)
            cnn.Execute "update counterid set CountNum=CountNum+1 where TableName='sale_bs'"
            CmdAct(5).SetFocus
        Case 1
            With msglist
                .TextMatrix(.row, 1) = txt_id.text
                .TextMatrix(.row, 2) = txt_name.text
                .TextMatrix(.row, 3) = combdw
                .TextMatrix(.row, 4) = combdj
                .TextMatrix(.row, 5) = txt_qty
                .TextMatrix(.row, 6) = txt_total.text

            End With
            With flex_pro
                .TextMatrix(.row, 4) = Val(.TextMatrix(.row, 4)) - Val(msglist.TextMatrix(msglist.rows - 2, 5))
            End With
            totalprice
            txt_id.Enabled = True
            CmdAct(7).SetFocus
            CmdAct(1).Enabled = False
            CmdAct(0).Enabled = True
            CmdAct(2).Enabled = True
            CmdAct(3).Enabled = True
        Case 2
            If txt_id.text = "" Then
                Exit Sub
            End If
            With msglist
                .TextMatrix(.rows - 1, 0) = .rows - 1
                .TextMatrix(.rows - 1, 1) = txt_id.text
                .TextMatrix(.rows - 1, 2) = txt_name.text
                .TextMatrix(.rows - 1, 3) = combdw
                .TextMatrix(.rows - 1, 4) = combdj
                .TextMatrix(.rows - 1, 5) = txt_qty
                .TextMatrix(.rows - 1, 6) = txt_total.text
                .rows = .rows + 1
                If .rows >= 10 Then
                    .TopRow = .TopRow + 1
                End If
            End With
            With flex_pro
                .TextMatrix(.row, 4) = Val(.TextMatrix(.row, 4)) - Val(msglist.TextMatrix(msglist.rows - 2, 5))
            End With
            totalprice
            CmdAct(7).SetFocus
        Case 3
            If msglist.rows > 2 And msglist.TextMatrix(msglist.row, 1) <> "" Then
                ru = MsgBox("确认删除?", 33, "询问")
                If ru = 2 Then
                    Exit Sub
                End If
                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(msglist.TextMatrix(msglist.row, 5))
                            Exit For
                        End If
                    Next ru
                End With
                msglist.RemoveItem (msglist.row)
                For ru = 1 To msglist.rows - 1
                    msglist.TextMatrix(msglist.rows - ru, 0) = msglist.rows - ru
                Next ru
            Else
                MsgBox "本行不能删除！", vbInformation, "信息"
            End If
            CmdAct(7).SetFocus
        Case 4
                If msglist.rows > 2 And CmdAct(0).Enabled = True Then
                    ru = MsgBox("放弃当前销售的数据?", 33, "询问")
                    If ru = 2 Then
                        Exit Sub
                    End If
                End If
            Unload Me
        Case 5
            txt_id = ""
            txt_qty = 0
            txtsa_maker.text = strCurUser
            dtptime.Value = Now
            Combsupp.text = ""
            txt_memo = ""
            msglist.Clear
            showtitle
            strsql = "select CountNum from counterid where TableName='sale_bs'"
            Set mrc = ExecuteSQL(strsql, msgtext)
            txtsa_id.text = "B" & Format(mrc!CountNum + 1, "00000")
            Call IsEdit(True)
            combdw.Enabled = False
            mrc.Close
            Set mrc = Nothing
            CmdAct(7).SetFocus
        Case 6
            txt_qty = 0
            txt_name = ""
            txt_id = ""
            txt_total = ""
            txt_lb = ""
            combdj.Clear
            txt_id.Enabled = True
            txt_id.SetFocus
            SendKeys "{Home}+{End}"
        Case 7
            txt_qty = 0
            txt_name = ""
            txt_id = ""
            txt_total = ""
            txt_lb = ""
            combdw = ""
            combdj.Clear
            txt_id.Enabled = True
            txt_id.SetFocus
            SendKeys "{Home}+{End}"
        Case 8
            
            Set txt = New clsText
            With txt
                .stringX = " "
                .fontsize = 10
                '.ForeColor = &HFF8080
                '.FontUnderLine = True
                .Align = tymiddle
            End With
            rpt.Title.AddText "title2", txt
            Set txt = Nothing
            
            rpt.SetPrinter 9500.488, 13000.064, Portrait
            '定义表首
            Set txt = New clsText
            With txt
                .stringX = Combtype.text
                .fontsize = 12
                '.FontUnderLine = True
                '.ForeColor = &HFF8080
                .FontBold = True
                .Align = tymiddle
            End With
            rpt.Header.AddText "head1", txt
            Set txt = Nothing
            
            Set txt = New clsText
            With txt
                .stringX = " "
                .fontsize = 10
                '.ForeColor = &H8000&
                '.FontBold = True
                .Align = tyLeft
            End With
            rpt.Header.AddText "head2", txt
            Set txt = Nothing
            Set txt = New clsText
            With txt
                .stringX = "单号:" & txtsa_id & Space(10) & "日期:" & dtptime.Value & Space(5) & "|备注:" & txt_memo
                .fontsize = 10
                '.ForeColor = &H8000&
                '.FontBold = True
                .Align = tyLeft
                .orient = Portrait
            End With
            rpt.Header.AddText "head3", txt
            Set txt = Nothing
            Set txt = New clsText
            With txt
                .stringX = "合计:<大写：> " & lab_total & Space(9) & "<小写：>" & Label2 & "|制单人:" & txtsa_maker
                .fontsize = 10
                '.ForeColor = vbRed
                '.FontBold = True
                .Align = tyLeft
            End With
            rpt.Footer.AddText "footer1", txt
            Set txt = Nothing
            rpt.LeftSection.AlignMode = tyContent
            rpt.RightSection.AlignMode = tyContent
            rpt.Align = tymiddle
            BTarray(1) = 1000
            BTarray(2) = 3500
            BTarray(3) = 600
            BTarray(4) = 1000
            BTarray(5) = 1000
            BTarray(6) = 1200
            recBT(1) = "产品编号"
            recBT(2) = "产品名称"
            recBT(3) = "单位"
            recBT(4) = "单价"
            recBT(5) = "数量"
            recBT(6) = "金额"
            
            TxtSQL = "select a.p_id,a.p_name,b.unit,format(a.unit_price,'0.000'),a.qty,format(price,'0.000')"
            TxtSQL = TxtSQL & " from order_detail_b as a,Product as b where a.order_id='" & txtsa_id & "'"
            TxtSQL = TxtSQL & " and a.p_id=b.p_id"
            Set mrc = ExecuteSQL(TxtSQL, msgtext)
            If mrc.EOF Then Exit Sub
            report = False
            rpt.Attachmrc mrc, recBT, BTarray
            rpt.Preview
            mrc.Close
            Set mrc = Nothing
           
    End Select
    Exit Sub
Err:
    MsgBox "错误号为：" & Err.Number & Chr(13) & "错误说明：" & Err.Description
    'Resume Next
End Sub



Private Sub DCbouser_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        CmdAct(2).SetFocus
    End If
End Sub
Private Sub Combdj_GotFocus()
Dim strsql As String
Dim rscount As ADODB.Recordset
Dim Addstring As String
Dim custID As Double

    Set rscount = New ADODB.Recordset
    strsql = "select unit_price from order_detail_b where p_id='" & Trim$(txt_id) & "'"
    strsql = strsql & " group by unit_price"
    strsql = strsql & " order by unit_price"
    rscount.Open strsql, cnn, adOpenDynamic, adLockOptimistic
    'Combdj.Clear
    Do Until rscount.EOF
           Addstring = "" & rscount!unit_price
           combdj.AddItem Addstring
           custID = "" & Val(rscount!unit_price)
           combdj.ItemData(combdj.NewIndex) = custID
           rscount.MoveNext
    Loop
    rscount.Close
    
End Sub



Private Sub Combdj_KeyPress(KeyAscii As Integer)

    If KeyAscii = 13 And CmdAct(2).Enabled = True Then
        CmdAct(2).SetFocus
    Else
        If KeyAscii = 13 Then
            CmdAct(1).SetFocus
        End If
    End If
End Sub

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

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

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


Private Sub DTPicker1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        txt_qty.SetFocus
        SendKeys "{Home}+{End}"
    End If
End Sub

Private Sub DTPicker1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        txt_qty.SetFocus
        SendKeys "{Home}+{End}"
    End If
End Sub

Private Sub flex_pro_Click()
If flex_pro.row > 0 Then
        With flex_pro
            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 Form_Load()
    
    showtitle
    Call IsEdit(False)
    
    Combtype.Clear
    Combtype.AddItem "报损单"
    Combtype.ListIndex = 0

    Dim TxtSQL As String
    TxtSQL = "select a.p_id,a.p_name,a.unit,a.unit_price,sum(a.qty) as qty,b.product_code,b.product_eno"
    TxtSQL = TxtSQL & " from mat_detail as a,Product as b "
    TxtSQL = TxtSQL & " where (a.p_id=b.p_id and a.qty<>0)"
    TxtSQL = TxtSQL & " group by a.p_id,a.p_name,a.unit,unit_price,b.product_code,b.product_eno,b.type_id"
    TxtSQL = TxtSQL & " order by b.type_id,a.p_name,a.p_id"
    
    Dim mrc As New ADODB.Recordset
    mrc.Open TxtSQL, cnn, adOpenDynamic, adLockOptimistic
    If Not mrc.EOF Then
        Set flex_pro.DataSource = mrc
    End If
    If mrc.State = adStateOpen Then mrc.Close
    Set mrc = Nothing
    
    flex_pro.Visible = False
    showtitle_pro
    
End Sub

Private Sub IsEdit(blnIsEdit As Boolean)
    Dim intNum As Integer
    
    txt_id.Enabled = blnIsEdit
    Combsupp.Enabled = blnIsEdit
    Combtype.Enabled = blnIsEdit
    CmdAct(0).Enabled = blnIsEdit
    combdw.Enabled = blnIsEdit
    CmdAct(7).Enabled = blnIsEdit
    txt_memo.Enabled = blnIsEdit
'    txt_name.Enabled = blnIsEdit
    dtptime.Enabled = blnIsEdit
    txt_qty.Enabled = blnIsEdit
    combdj.Enabled = blnIsEdit
    msglist.Enabled = blnIsEdit
    flex_pro.Enabled = blnIsEdit
    
    For intNum = 2 To 3
        CmdAct(intNum).Enabled = blnIsEdit
    Next
    'CmdAct(1).Enabled = Not blnIsEdit
    CmdAct(5).Enabled = Not blnIsEdit
    CmdAct(6).Enabled = blnIsEdit
    If txtsa_id = "" Then
        For intNum = 2 To 3
            CmdAct(intNum).Enabled = False
        Next
    End If