frmpdbs.frm

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

      Caption         =   "盘点报损"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   345
      Left            =   5955
      TabIndex        =   41
      Top             =   180
      Width           =   1230
   End
End
Attribute VB_Name = "frmpdbs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private rscount As ADODB.Recordset
Private Sub CmdAct_Click(Index As Integer)
    Dim strsql 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
    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)
            strsql = "update counterid set CountNum=CountNum+1 where TableName='ck_pdbs'"
            Set mrc = ExecuteSQL(strsql, msgtext)
            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
'                .TextMatrix(.row, 7) = Text1
            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
            txt_total = Val(txt_qty) * Val(combdj) * (100 / 100)
            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
'                .TextMatrix(.rows - 1, 7) = Text1
                .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
            txt_memo = ""
            msglist.Clear
            showtitle
            strsql = "select CountNum from counterid where TableName='ck_pdbs'"
            Set mrc = ExecuteSQL(strsql, msgtext)
            txtsa_id.text = "KBS" & 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 = struserinfoname & Space(20) & "地址:" & struserinfoaddress & Space(20) & "电话:" & struserinfotell
'                .fontsize = 10
'                .FontUnderLine = True
'                '.ForeColor = &HFF8080
'                .FontUnderLine = True
'                .Align = tyLeft
'            End With
'            rpt.Title.AddText "title1", txt
'            Set txt = Nothing
            
            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
            
'            Set txt = New clsText
'            With txt
'                .stringX = "|共&s页/第&p页"
'                .fontsize = 10
'                '.ForeColor = &HFF8080
'                '.FontUnderLine = True
'                .Align = tymiddle
'            End With
'            rpt.Title.AddText "title3", txt
'            Set txt = Nothing
            
            rpt.SetPrinter 10000.488, 13000.064, Portrait
            '定义表首
            Set txt = New clsText
            With txt
                .stringX = Combtype
                .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 = "单号:" & 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 "head2", 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) = 3800
            BTarray(3) = 800
            BTarray(4) = 1100
            BTarray(5) = 800
            BTarray(6) = 1400
            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.ReadTemplate Left(App.Path, Len(App.Path)) & "\dllprint\rptkc.txt"
            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 Combdj_LostFocus()
    If combdj.text = "" Then combdj.text = 0
    txt_total = Val(txt_qty) * Val(combdj) * (100 / 100)
End Sub
Private Sub combdw_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()
Dim mrc As ADODB.Recordset
Dim TxtSQL As String
Dim msgtext As String
    showtitle
    Call IsEdit(False)

    Combtype.text = "仓库盘点报损"
    TxtSQL = "select a.p_id,a.p_name,a.unit,format(b.product_cos,'0.000'),format(sum(a.qty),'0') 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,b.product_cos,b.product_code,b.product_eno,b.type_id"
    TxtSQL = TxtSQL & " order by b.type_id,a.p_name,a.p_id"
    Set mrc = ExecuteSQL(TxtSQL, msgtext)
    Set flex_pro.DataSource = mrc
    showtitle_pro
    flex_pro.Visible = False
    mrc.Close
    Set mrc = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
    intNumWindows = Closewindow(intNumWindows)
End Sub

Private Sub IsEdit(blnIsEdit As Boolean)
    Dim intNum As Integer
    
    txt_id.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