frm_yybb.frm

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

        TxtSQL = "select * from counterid where TableName='printsn'"
        Set mrc = ExecuteSQL(TxtSQL, msgtext)
        txt_ids(1) = mrc.Fields("CountNum")
        txt_ids(0) = mrc.Fields("precountnum")
        txt_ids(0).Enabled = False
        txt_ids(1).Enabled = False
    End If
    If Me.comb_lx.ListIndex = 3 Then
        txt_ids(0).Enabled = True
        txt_ids(1).Enabled = True
        txt_ids(0).SetFocus
    End If
    If Me.comb_lx.ListIndex = 0 Then
        TxtSQL = "select * from counterid where TableName='printsn'"
        Set mrc = ExecuteSQL(TxtSQL, msgtext)
        txt_ids(0) = mrc.Fields("CountNum") + 1
        TxtSQL = "select * from counterid where TableName='sale_id'"
        Set mrc = ExecuteSQL(TxtSQL, msgtext)
        txt_ids(1) = mrc.Fields("CountNum")
        txt_ids(1).Enabled = False
        txt_ids(0).Enabled = False
    End If
End Sub
Private Sub addup() '合计金额数量
   Dim lrows As Long
   Dim i As Long
   Dim zcje As Long
   Dim yhje As Long
   Dim zsje As Long
   Dim hjje As Long
   Dim zcsl As Long
   Dim yhsl As Long
   Dim zssl As Long
   zcje = 0
   yhje = 0
   zsje = 0
   hjje = 0
   zcsl = 0
   yhsl = 0
   zssl = 0
   If msglist.rows < 2 Then Exit Sub
   For i = 1 To msglist.rows - 1
       msglist.row = i
       msglist.col = 3
       zcsl = zcsl + Val(msglist.text)
       msglist.col = 4
       zcje = zcje + Val(msglist.text)
       msglist.col = 6
       yhsl = yhsl + Val(msglist.text)
       msglist.col = 7
       yhje = yhje + Val(msglist.text)
       msglist.col = 8
       zssl = zssl + Val(msglist.text)
       msglist.col = 9
       zsje = zsje + Val(msglist.text)
   Next
   msglist.row = msglist.rows - 1
   msglist.col = 1
   msglist.text = "正常消费收入"
   msglist.col = 3
   msglist.text = zcsl
   msglist.col = 4
   msglist.text = zcje
   msglist.col = 5
   msglist.text = "折扣收入"
   msglist.col = 6
   msglist.text = yhsl
   msglist.col = 7
   msglist.text = yhje
      
   msglist.rows = msglist.rows + 1
   msglist.row = msglist.rows - 1
   msglist.col = 1
   msglist.text = "实收现金"
   msglist.col = 2
   msglist.text = zcje + yhje
   msglist.col = 7
   msglist.text = "赠送合计"
   msglist.col = 8
   msglist.text = zssl
   msglist.col = 9
   msglist.text = zsje
End Sub
Private Sub Command1_Click(Index As Integer)
   Dim TxtSQL As String
   Dim msgtext As String
   Dim mrc As ADODB.Recordset
   Dim bakmrc As ADODB.Recordset
    Dim roomnum As Integer
    Dim roomstr As String
    Dim BTarray(9) As Integer
    Dim recBT(9) As String
    Dim txt As New clsText
    Dim rpt As New report
    Dim recBT1(8) As String
    Dim partid As String
    Dim cX As String
    Dim zx As String
    Dim part_id As String
    Select Case Index
        Case 0
            Select Case Me.comb_lx.ListIndex
                Case 0, 1, 3
                    TxtSQL = "select b.p_id, b.product_name,b.unit,avg(b.price) as price,sum(b.qty) as qty,sum(b.finalprice) as finalprice"
                    TxtSQL = TxtSQL & " from sale_head as a,sale as b"
                    TxtSQL = TxtSQL & " where a.sale_id=b.sale_id"
                    TxtSQL = TxtSQL & " and a.sale_id>=" & Val(Me.txt_ids(0))
                    TxtSQL = TxtSQL & " and a.sale_id<=" & Val(Me.txt_ids(1))
                    TxtSQL = TxtSQL & " group by b.p_id,product_name,unit,b.p_id"
                    TxtSQL = TxtSQL & " order by b.p_id,product_name"
                Case 2
                    TxtSQL = "select  b.p_id,b.product_name,b.unit,avg(b.price) as price,sum(b.qty) as qty,sum(b.finalprice) as finalprice"
                    TxtSQL = TxtSQL & " from sale_head as a,sale as b"
                    TxtSQL = TxtSQL & " where a.sale_id=b.sale_id"
                    TxtSQL = TxtSQL & " and a.sale_date>=#" & Me.dtptime(0).Value & "#"
                    TxtSQL = TxtSQL & " and a.sale_date<=#" & Me.dtptime(1).Value & "#"
                    TxtSQL = TxtSQL & " group by b.p_id,product_name,unit"
                    TxtSQL = TxtSQL & " order by b.p_id,product_name"
            End Select
            Set mrc = ExecuteSQL(TxtSQL, msgtext)
            
            Set bakmrc = ExecuteSQL(TxtSQL, msgtext)
            msglist.rows = 2
            msglist.Clear
            showtitle
            If mrc.RecordCount > 0 Then
              
              cX = "(促销)"
              zx = "(赠送)"
              part_id = ""
              mrc.MoveFirst
              Me.msglist.row = 0
              Do While mrc.EOF = False
                partid = mrc!p_id
                If partid <> part_id Then
                  Me.msglist.row = Me.msglist.row + 1
                  msglist.col = 0
                  msglist.text = mrc!p_id
                  partid = mrc!p_id
                  Me.msglist.col = 1
                  If msglist.text = "" Then
                   msglist.text = mrc!product_name
                  End If
                  msglist.rows = msglist.rows + 1
                End If
                If Right(mrc!product_name, 4) <> cX And Right(mrc!product_name, 4) <> zx Then
                    Me.msglist.col = 1
                    Me.msglist.text = mrc!product_name
                    Me.msglist.col = 2
                    Me.msglist.text = mrc!price
                    msglist.col = 3
                    msglist.text = mrc!qty
                    msglist.col = 4
                    msglist.text = mrc!finalprice
                 End If
                 bakmrc.MoveFirst
                 If partid <> part_id Then
                    Do While bakmrc.EOF = False
                         If bakmrc!p_id = partid And Right(bakmrc!product_name, 4) = cX Then
                            Me.msglist.col = 5
                            Me.msglist.text = bakmrc!price
                            Me.msglist.col = 6
                            Me.msglist.text = bakmrc!qty
                            Me.msglist.col = 7
                            Me.msglist.text = bakmrc!finalprice
                         End If
                         If bakmrc!p_id = partid And Right(bakmrc!product_name, 4) = zx Then
                            Me.msglist.col = 8
                            Me.msglist.text = bakmrc!qty
                            Me.msglist.col = 9
                            Me.msglist.text = bakmrc!finalprice
                         End If
                         bakmrc.MoveNext
                    Loop
                 End If
                 part_id = mrc!p_id
                 mrc.MoveNext
              Loop
              addup
            End If
        Case 2
            rpt.SetPrinter 11905.488, 7370.064, Portrait
            '定义页首
            Set txt = New clsText
            With txt
                .stringX = struserinfoname
                .fontsize = 14
                .FontName = "黑体"
                .FontBold = True
                .FontUnderLine = True
                .Align = tyLeft
            End With
            rpt.Title.AddText "title1", txt
            Set txt = Nothing
                                               
            Set txt = New clsText
            With txt
                .stringX = "|第&p页/共&s页"
                .fontsize = 10
            End With
            rpt.Title.AddText "title2", txt
            Set txt = Nothing
            
            '定义表首
            Set txt = New clsText
            With txt
                .stringX = "销售报表"
                .fontsize = 13
                .FontBold = True
                .Align = tymiddle
            End With
            rpt.Header.AddText "head1", txt
            Set txt = Nothing
            
            Set txt = New clsText
            With txt
                .stringX = "帐单号从:" & Me.txt_ids(0) & "到" & Me.txt_ids(1)
                .fontsize = 10
                .Align = tyLeft
            End With
            rpt.Header.AddText "head2", txt
            Set txt = Nothing
            
            Set txt = New clsText
            With txt
                .stringX = "操作员:" & strCurUser & "|" & "打印日期:" & dteSysDate
                .fontsize = 10
                .Align = tyLeft
            End With
            rpt.Header.AddText "head3", txt
            Set txt = Nothing
                        
            rpt.LeftSection.AlignMode = tyContent
            rpt.RightSection.AlignMode = tyContent
            rpt.Align = tymiddle
            BTarray(1) = 1000
            BTarray(2) = 3000
            BTarray(3) = 1800
            recBT(1) = "产品编号"
            recBT(2) = "产品名称"
            recBT(3) = "单位"
            rpt.AttachFlexGrid msglist
            rpt.Preview
        
        Case 3
            Unload Me
    End Select
End Sub

Private Sub Form_Load()
    Dim TxtSQL As String
    Dim msgtext As String
    Dim mrc As ADODB.Recordset
   
    comb_lx.AddItem "当班报表"
    comb_lx.AddItem "前班报表"
    comb_lx.AddItem "时间段报表"
    comb_lx.AddItem "帐单号报表"
'    dteSysDate = Now
    Me.dtptime(0).Value = dteSysDate
    Me.dtptime(1).Value = dteSysDate
    TxtSQL = "select * from counterid where TableName='printsn'"
    Set mrc = ExecuteSQL(TxtSQL, msgtext)
    txt_ids(0) = mrc.Fields("CountNum") + 1
    TxtSQL = "select * from counterid where TableName='sale_id'"
    Set mrc = ExecuteSQL(TxtSQL, msgtext)
    txt_ids(1) = mrc.Fields("CountNum")
    txt_ids(1).Enabled = False
    txt_ids(0).Enabled = False
    Me.comb_lx.ListIndex = 0
    Command1_Click (0)
End Sub

Private Sub showtitle()
    Dim i As Integer
    With msglist
        .Cols = 10
          If .rows <= 2 Then
            .rows = 2
        End If
        .TextMatrix(0, 1) = "   品  名"
        .TextMatrix(0, 2) = " 单 价"
        .TextMatrix(0, 3) = "销售数量"
        .TextMatrix(0, 4) = " 金 额"
        .TextMatrix(0, 5) = "  优惠价"
        .TextMatrix(0, 6) = "销售数量"
        .TextMatrix(0, 7) = " 金 额"
        .TextMatrix(0, 8) = "赠送数量"
        .TextMatrix(0, 9) = " 金 额"
        '设置各列的对齐方
        For i = 1 To 9
            .ColAlignment(i) = 1
        Next i
        '表头项居中
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        '.RowSel = 1
        .ColSel = .Cols - 1
        '.CellAlignment = 4
        '设置单元大小
        .colWidth(0) = 0
        .colWidth(1) = 2000
        .colWidth(2) = 1000
        .colWidth(3) = 1000
        .colWidth(4) = 1000
        .colWidth(5) = 1500
        .colWidth(6) = 1000
        .colWidth(7) = 1000
        .colWidth(8) = 1000
        .colWidth(9) = 1000
        '.Row = 1
    End With
End Sub