frmpsprint.frm

服装销售系统,VB开发.没有解压密码

VERSION 5.00
Begin VB.Form frmPSPrint 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "配送单打印"
   ClientHeight    =   2250
   ClientLeft      =   45
   ClientTop       =   375
   ClientWidth     =   5190
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   2250
   ScaleWidth      =   5190
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   555
      Left            =   2355
      TabIndex        =   7
      Top             =   1605
      Width           =   1740
   End
   Begin VB.CommandButton Command1 
      Caption         =   "打印"
      Height          =   495
      Left            =   585
      TabIndex        =   6
      Top             =   1635
      Width           =   1515
   End
   Begin VB.TextBox txtPurcode 
      BackColor       =   &H80000018&
      Height          =   315
      Left            =   1950
      TabIndex        =   5
      Top             =   1125
      Width           =   1635
   End
   Begin VB.TextBox txtPE 
      Height          =   315
      Left            =   2910
      MaxLength       =   7
      TabIndex        =   3
      Top             =   510
      Width           =   975
   End
   Begin VB.TextBox txtPB 
      Height          =   315
      Left            =   990
      MaxLength       =   7
      TabIndex        =   1
      Top             =   510
      Width           =   990
   End
   Begin VB.Label Label3 
      Caption         =   "当前单号"
      Height          =   225
      Left            =   990
      TabIndex        =   4
      Top             =   1125
      Width           =   915
   End
   Begin VB.Label Label2 
      Caption         =   "单号止"
      Height          =   315
      Left            =   2205
      TabIndex        =   2
      Top             =   525
      Width           =   630
   End
   Begin VB.Label Label1 
      Caption         =   "单号起"
      Height          =   390
      Left            =   390
      TabIndex        =   0
      Top             =   615
      Width           =   540
   End
End
Attribute VB_Name = "frmPSPrint"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim RsTemp As New ADODB.Recordset

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 RRT 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")
        
        
        ssql = "select * from psd where 表单号='" & Trim(txtPurcode.Text) & "'"
        Set RRT = Nothing
        RRT.Open ssql, Conn, adOpenStatic, adLockReadOnly
        
        
        If GetSetting("LSDSTAR", "库存设置", "显示付款方式", "1") = "1" Then
            rptLSBill.Sections("Indent").Controls("lblPayType").Caption = RRT("付款方式")
        Else
            rptLSBill.Sections("Indent").Controls("lblPayType").Visible = False
        End If
        
        If GetSetting("LSDSTAR", "库存设置", "显示业务员", "1") = "1" Then
            rptLSBill.Sections("Indent").Controls("lblYW").Caption = "业务：" & RRT("业务员")
        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 = "部门:" & RRT("分店名称")
        rptLSBill.Sections("Indent").Controls("lblDate").Caption = "日期:" & RRT("配送日期")
        rptLSBill.Sections("Indent").Controls("lblBZ").Caption = "备注:" & RRT("备注")
        If RRT("订单号") <> "" Then rptLSBill.Sections("Indent").Controls("lblBZ").Caption = "备注:" & RRT("备注") & "(订单号:" & Trim(RRT("订单号")) & ")"
        rptLSBill.Sections("Indent").Controls("lblYH").Visible = True
        rptLSBill.Sections("Indent").Controls("lblIptno").Caption = "开票:" & RRT("录入员")
    '    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 Sub Command1_Click()
    Dim i
    For i = CInt(txtPB.Text) To CInt(txtPE.Text)
        txtPurcode.Text = Format(i, "0000000")
        Call PrintLSJ
    Next i
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub