frmlspsd.frm

注释：用VB开发的进销存系统源码

         ToolTipText     =   "翻至上一页"
         Top             =   45
         Width           =   930
         _ExtentX        =   1640
         _ExtentY        =   820
         _Version        =   131073
         ForeColor       =   0
         Caption         =   "上一条[&U]"
         ButtonStyle     =   3
         BevelWidth      =   0
      End
      Begin Threed.SSCommand cmdNext 
         CausesValidation=   0   'False
         Height          =   465
         Left            =   5655
         TabIndex        =   15
         Tag             =   "下一条"
         ToolTipText     =   "翻至下一页"
         Top             =   45
         Width           =   930
         _ExtentX        =   1640
         _ExtentY        =   820
         _Version        =   131073
         ForeColor       =   0
         Caption         =   "下一条[&M]"
         ButtonStyle     =   3
         BevelWidth      =   0
      End
      Begin Threed.SSCommand cmdExit 
         CausesValidation=   0   'False
         Height          =   465
         Left            =   8475
         TabIndex        =   14
         Tag             =   "退出"
         ToolTipText     =   "退出"
         Top             =   45
         Width           =   930
         _ExtentX        =   1640
         _ExtentY        =   820
         _Version        =   131073
         ForeColor       =   0
         Caption         =   "退出[&X]"
         ButtonStyle     =   3
         BevelWidth      =   0
      End
   End
   Begin VB.Label Label6 
      BackColor       =   &H80000007&
      Caption         =   "Label6"
      Height          =   5190
      Left            =   180
      TabIndex        =   3
      Top             =   645
      Width           =   10455
   End
End
Attribute VB_Name = "frmLSPSD"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::::::::::::::::::::商品配送管理::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

Option Explicit

Private Const TableName As String = "PSD"
Private QueryFlag As Boolean                    '记录查询状态
Private TableState As String                    '当前状态
Private Temp As String
Private QueryRs As New ADODB.Recordset
Private GCount As Integer

Private JD As Single

Private Sub PrintSJ()
    On Error Resume Next
    Dim N, j, Qty, sum As Single, CurPage
    Dim strControl As String, strValue As String
    Dim RP As New ADODB.Recordset
    Dim RR As New ADODB.Recordset
    Dim PRECOLOR, ColorAndSize
    
    sSQL = "select 商品编码,品名,单位,sum(配送数量) as 数量,零售价 as 单价,sum(售价金额)/1.17 as 金额,(sum(售价金额)-sum(售价金额)/1.17) as 税金,sum(售价金额) as S金额 from psd  where 表单号='" & Trim(txtPurcode.Text) & "' group by 商品编码,品名,单位,零售价 order by 商品编码"
    Set RsTemp = Nothing
    RsTemp.CursorLocation = adUseClient
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockPessimistic

    ColorAndSize = ""
    While Not RsTemp.EOF
        Load rptSJBill
        sum = 0
        Qty = 0
        ColorAndSize = ""
        For N = 0 To 5
            If RsTemp.EOF Then Exit For
            
            For j = 0 To 5
                strControl = "lblc" & (j + 1) & "r" & N + 1
                If j = 3 Or j = 4 Or j = 5 Then
                    If j = 3 Then
                        strValue = Format(RsTemp(j), "#")
                    Else
                        strValue = Format(RsTemp(j), DecNum)
                    End If
                ElseIf j = 0 Or j = 1 Or j = 2 Then
                    strValue = RsTemp(j)
                End If
                rptSJBill.Sections("Indent").Controls(strControl).Caption = strValue
            Next j
            
            rptSJBill.Sections("Indent").Controls("lblLSJ" & CStr(N + 1)).Caption = Format(RsTemp("税金"), DecNum)
        
            sSQL = "select 商品编码,品名,单位,颜色,尺寸,配送数量 as 数量 from psd where 表单号='" & Trim(txtPurcode.Text) & "' and 商品编码='" & Trim(RsTemp("商品编码")) & "' and 零售价=" & RsTemp("单价") & " order by 商品编码,颜色,尺寸"
            Set RP = Nothing
            RP.CursorLocation = adUseClient
            RP.Open sSQL, Conn, adOpenStatic, adLockPessimistic
            strControl = "lblR" & Trim(Str(N + 1))

            
            ColorAndSize = ColorAndSize & Trim(RP("商品编码"))
            PRECOLOR = ""
            While Not RP.EOF
                If PRECOLOR <> Trim(RP("颜色")) Then
                    PRECOLOR = Trim(RP("颜色"))
                    ColorAndSize = ColorAndSize & Trim(RP("颜色")) & "[" & Trim(RP("尺寸")) & ":" & Trim(RP("数量")) & "]"
                Else
                    ColorAndSize = ColorAndSize & "[" & Trim(RP("尺寸")) & ":" & Trim(RP("数量")) & "]"
                End If
                RP.MoveNext
            Wend

            ColorAndSize = ColorAndSize & vbCrLf
            Qty = Qty + RsTemp("数量")
            sum = sum + RsTemp("S金额")

            RsTemp.MoveNext
        Next N
        rptSJBill.Sections("Indent").Controls("lblColorAndSize").Caption = ColorAndSize
'        sum = Format(sum, DecNum)
        rptSJBill.Sections("Indent").Controls("lbl大写").Caption = D2X(sum)
        rptSJBill.Sections("Indent").Controls("lblSJ").Caption = "税金:" & Format(sum * 0.17 / 1.17, DecNum)
        rptSJBill.Sections("Indent").Controls("lblSum").Caption = Format(Qty, "#")
        rptSJBill.Sections("Indent").Controls("lblIamt").Caption = Format(sum, "#.00")
        
        If GetSetting("LSDSTAR", "库存设置", "显示付款方式", "1") = "1" Then
            rptSJBill.Sections("Indent").Controls("lblPayType").Caption = cmbPayType.Text
        Else
            rptSJBill.Sections("Indent").Controls("lblPayType").Visible = False
        End If
        
        If GetSetting("LSDSTAR", "库存设置", "显示业务员", "1") = "1" Then
            rptSJBill.Sections("Indent").Controls("lblYW").Caption = "业务：" & txtYWY.TheName
        End If
        
        RsTemp.MovePrevious
        rptSJBill.Sections("Indent").Controls("lblPage").Caption = "第 " & Str(Int((RsTemp.AbsolutePosition - 1) / 6) + 1) & " 页 共 " & Str(Int((RsTemp.RecordCount - 1) / 6) + 1) & " 页"
        RsTemp.MoveNext
        
        rptSJBill.Sections("Indent").Controls("lbltitle").Caption = GetSetting("LSDSTAR", "单据标题", "配送单", "配送单")
        rptSJBill.Sections("Indent").Controls("lblno").Caption = "NO:" & txtPurcode.Text
        rptSJBill.Sections("Indent").Controls("lblgrp").Caption = "部门:" & txtSuppName.Text
        rptSJBill.Sections("Indent").Controls("lblDate").Caption = "日期:" & txtPurdate.Text
        rptSJBill.Sections("Indent").Controls("lblBZ").Caption = "备注:" & txtRemark.Text
        If txtDD.Text <> "" Then rptSJBill.Sections("Indent").Controls("lblBZ").Caption = "备注:" & txtRemark.Text & "(订单号:" & Trim(txtDD.Text) & ")"
        rptSJBill.Sections("Indent").Controls("lblYH").Visible = False
        rptSJBill.Sections("Indent").Controls("lblIptno").Caption = "开票:" & txtIptno.TheName
    '    rptSJBill.Sections("Indent").Controls("lbl大写").Caption = D2X(Val(txtIamt0.Text))
    '    rptSJBill.Sections("Indent").Controls("lblSJ").Caption = Format(Val(txtIamt0.Text) * 0.17 / 1.17, "#.00")
    '    rptSJBill.Sections("Indent").Controls("lblIamt").Caption = Format(Val(txtIamt0.Text) * 0.17 / 1.17, "#.00")

        If GetSetting("LSDSTAR", "单据标题", "显示预览窗口", "1") = "1" Then
            rptSJBill.Show 1
        Else
            rptSJBill.PrintReport
        End If
        Unload rptSJBill
    Wend
       ' rptBill.PrintReport
'        Unload rptBill

End Sub


Private Sub PrintLSJ()
    On Error Resume Next
    Dim N, j, Qty, sum As Single, CurPage
    Dim strControl As String, strValue As String
    Dim RP As New ADODB.Recordset
    Dim RR As New ADODB.Recordset
    Dim PRECOLOR, ColorAndSize
    sSQL = "select 商品编码,品名,单位,sum(配送数量) as 数量,零售价 as 单价,sum(售价金额) as 金额 from psd  where 表单号='" & Trim(txtPurcode.Text) & "' group by 商品编码,品名,单位,零售价 order by 商品编码"
    Set RsTemp = Nothing
    RsTemp.CursorLocation = adUseClient
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockPessimistic
    
    '        Load rptlsbill
    ColorAndSize = ""
    While Not RsTemp.EOF
        Load rptLSBill
        sum = 0
        Qty = 0
        ColorAndSize = ""
        For N = 0 To 5
            If RsTemp.EOF Then Exit For
            
            For j = 0 To 5
                strControl = "lblc" & (j + 1) & "r" & N + 1
                If j = 3 Or j = 4 Or j = 5 Then
                    If j = 3 Then
                        strValue = Format(RsTemp(j), "#")
                    Else
                        strValue = Format(RsTemp(j), DecNum)
                    End If
                ElseIf j = 0 Or j = 1 Or j = 2 Then
                    strValue = RsTemp(j)
                End If
                rptLSBill.Sections("Indent").Controls(strControl).Caption = strValue
            Next j
        
            sSQL = "select 商品编码,品名,单位,颜色,尺寸,配送数量 as 数量 from psd where 表单号='" & Trim(txtPurcode.Text) & "' and 商品编码='" & Trim(RsTemp("商品编码")) & "' and 零售价=" & RsTemp("单价") & " order by 商品编码,颜色,尺寸"
            Set RP = Nothing
            RP.CursorLocation = adUseClient
            RP.Open sSQL, Conn, adOpenStatic, adLockPessimistic
            strControl = "lblR" & Trim(Str(N + 1))

            
            ColorAndSize = ColorAndSize & Trim(RP("商品编码"))
            PRECOLOR = ""
            While Not RP.EOF
                If PRECOLOR <> Trim(RP("颜色")) Then
                    PRECOLOR = Trim(RP("颜色"))
                    ColorAndSize = ColorAndSize & Trim(RP("颜色")) & "[" & Trim(RP("尺寸")) & ":" & Trim(RP("数量")) & "]"
                Else
                    ColorAndSize = ColorAndSize & "[" & Trim(RP("尺寸")) & ":" & Trim(RP("数量")) & "]"
                End If
                RP.MoveNext
            Wend

            ColorAndSize = ColorAndSize & vbCrLf
            Qty = Qty + RsTemp("数量")
            sum = sum + RsTemp("金额")
            
            Set RR = Nothing
            RR.Open "select 零售价 from 商品主档 where 商品编码='" & RsTemp("商品编码") & "'", Conn, adOpenStatic, adLockReadOnly
            If Not RR.EOF Then
               rptLSBill.Sections("Indent").Controls("lblLSJ" & CStr(N + 1)).Caption = RR("零售价")
            End If
            
            RsTemp.MoveNext
        Next N
        rptLSBill.Sections("Indent").Controls("lblColorAndSize").Caption = ColorAndSize
'        sum = Format(sum, DecNum)
        rptLSBill.Sections("Indent").Controls("lbl大写").Caption = D2X(sum)
        rptLSBill.Sections("Indent").Controls("lblSJ").Caption = "税金:" & Format(sum * 0.17 / 1.17, DecNum)
        rptLSBill.Sections("Indent").Controls("lblSum").Caption = Format(Qty, "#")
        rptLSBill.Sections("Indent").Controls("lblIamt").Caption = Format(sum, "#.00")
        
        If GetSetting("LSDSTAR", "库存设置", "显示付款方式", "1") = "1" Then
            rptLSBill.Sections("Indent").Controls("lblPayType").Caption = cmbPayType.Text
        Else
            rptLSBill.Sections("Indent").Controls("lblPayType").Visible = False
        End If
        
        If GetSetting("LSDSTAR", "库存设置", "显示业务员", "1") = "1" Then
            rptLSBill.Sections("Indent").Controls("lblYW").Caption = "业务：" & txtYWY.TheName
        End If
        
        RsTemp.MovePrevious
        rptLSBill.Sections("Indent").Controls("lblPage").Caption = "第 " & Str(Int((RsTemp.AbsolutePosition - 1) / 6) + 1) & " 页 共 " & Str(Int((RsTemp.RecordCount - 1) / 6) + 1) & " 页"
        RsTemp.MoveNext
        
        rptLSBill.Sections("Indent").Controls("lbltitle").Caption = GetSetting("LSDSTAR", "单据标题", "配送单", "配送单")
        rptLSBill.Sections("Indent").Controls("lblno").Caption = "NO:" & txtPurcode.Text
        rptLSBill.Sections("Indent").Controls("lblgrp").Caption = "部门:" & txtSuppName.Text
        rptLSBill.Sections("Indent").Controls("lblDate").Caption = "日期:" & txtPurdate.Text
        rptLSBill.Sections("Indent").Controls("lblBZ").Caption = "备注:" & txtRemark.Text
        If txtDD.Text <> "" Then rptLSBill.Sections("Indent").Controls("lblBZ").Caption = "备注:" & txtRemark.Text & "(订单号:" & Trim(txtDD.Text) & ")"
        rptLSBill.Sections("Indent").Controls("lblYH").Visible = True
        rptLSBill.Sections("Indent").Controls("lblIptno").Caption = "开票:" & txtIptno.TheName
    '    rptlsbill.Sections("Indent").Controls("lbl大写").Caption = D2X(Val(txtIamt0.Text))
    '    rptlsbill.Sections("Indent").Controls("lblSJ").Caption = Format(Val(txtIamt0.Text) * 0.17 / 1.17, "#.00")
    '    rptlsbill.Sections("Indent").Controls("lblIamt").Caption = Format(Val(txtIamt0.Text) * 0.17 / 1.17, "#.00")

        If GetSetting("LSDSTAR", "单据标题", "显示预览窗口", "1") = "1" Then
            rptLSBill.Show 1
        Else
            rptLSBill.PrintReport
        End If
        Unload rptLSBill
    Wend
End Sub


Private Function VilDD(d As Boolean) As Boolean
    On Error Resume Next
    Dim I As Integer
    Dim sSQL As String, Qty As Single
    Cmd.ActiveConnection = Conn
    grdDET.MoveFirst
    For I = 0 To grdDET.Rows - 1
        If d Then
            Qty = grdDET.Columns("数量").Value
        Else
            Qty = -grdDET.Columns("数量").Value
        End If
        
        sSQL = "update 分店订单信息 set 已配送数量=已配送数量+(" & Qty & ") where 分店编码='" & _
            Trim(txtSuppno.Text) & "' and 销售单号='" & Trim(txtDD.Text) & "' and 商品编码='" & _
            Trim(grdDET.Columns("商品编码").Text) & "' and 颜色='" & Trim(grdDET.Columns("颜色").Text) & "' and 尺寸='" & _
            Trim(grdDET.Columns("尺寸").Text) & "'"
        Cmd.CommandText = sSQL
        Cmd.Execute
        grdDET.MoveNext
    Next I
End Function

Private Sub SetButtonState(d As Boolean)
    If d Then
        cmdToolCommit.Caption = "弃审[&O]"
        cmdSave.Enabled = False
        cmdDelete.Enabled = False
        grdDET.AllowUpdate = False
        grdDET.SelectByCell = True
    Else
        cmdToolCommit.Caption = "审核[&O]"
        cmdSave.Enabled = True
        cmdDelete.Enabled = True
        grdDET.AllowUpdate = True
        grdDET.SelectByCell = False
    End If
End Sub

Private Function AcceptVil(d As Boolean) As Boolean
    On Error GoTo ComErr
    Dim I As Integer
    Dim RsS As New ADODB.Recordset
    Dim sSQL As String, Qty As Single
    If Not DataIsOK() Then
        MsgBox "表单数据存在错误!", vbExclamation, "提示窗口"
        Exit Function
    End If
    If Not CommSaveTable() Then