frmpdseek.frm

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

    Dim strsql As String
    Dim msgtext As String
    Dim mrc As ADODB.Recordset
    Dim rpt As New report
    Dim txt As New clsText
    Dim BTarray(8) As Integer
    Dim recBT(8) As String
    Dim intTmp As Integer
    Dim roomstr As String
   Select Case Index
    Case 6
        FrmSql.intnumfield = 6
        For intTmp = 0 To MSHFlexGrid1.Cols - 3
                roomstr = MSHFlexGrid1.TextMatrix(0, intTmp)
                FrmSql.CboField.AddItem roomstr
        Next
        FrmSql.CboField.ListIndex = 0
        FrmSql.Show vbModal
        Select Case SSTab1.Tab
         Case 0
            strsql = "select ps_id,format(ps_date,'yyyy-MM-dd'),ps_maker,ps_type,ps_demo"
            strsql = strsql & " from ps_head_b "
            strsql = strsql & " where ps_type='仓库盘点报损'"
         Case 1
            strsql = "select ps_id,format(ps_date,'yyyy-MM-dd'),ps_maker,ps_type,ps_demo"
            strsql = strsql & " from ps_head_b "
            strsql = strsql & " where ps_type='仓库盘点报溢'"
        End Select
        Select Case FrmSql.intnumfield
           Case -2
              Exit Sub
           Case 0
             strsql = strsql & " and ps_id='" & FrmSql.strsqlfield & "'"
           Case 1
             strsql = strsql & " and format(ps_date,'yyyy-MM-dd')= '" & Format(FrmSql.strsqlfield, "yyyy-MM-dd") & "'"
           Case 2
             strsql = strsql & " and ps_maker='" & FrmSql.strsqlfield & "'"
        End Select
        Set mrc = ExecuteSQL(strsql, msgtext)
        Set MSHFlexGrid1.DataSource = mrc
        showtitle1
        mrc.Close
        Set mrc = Nothing
    Case 7
'              rpt.SetPrinter 11905.488, 7936.992, Portrait
'             rpt.SetPrinter 11905.488, 7653.528, Portrait
            '定义页首
            Set txt = New clsText
            With txt
                .stringX = struserinfoname & Text1   '& Space(20) & "地址:" & struserinfoaddress & Space(20) & "电话:" & struserinfotell
                .fontsize = 12
                .FontUnderLine = True
                 .FontBold = True
                '.ForeColor = &HFF8080
                .FontUnderLine = True
                .Align = tymiddle
            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 = "备注:" & txtps_demo.text & Space(50) & "|共&s页/第&p页"
                .fontsize = 10
                '.ForeColor = &HFF8080
                '.FontUnderLine = True
                .Align = tymiddle
            End With
            rpt.Title.AddText "title3", txt
            Set txt = Nothing
            
            Set txt = New clsText
            With txt
                .stringX = "类别:" & Text1 & Space(10) & "|单据号:" & txtps_id & Space(10) & "|入库日期:" & txtps_date
                .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 = "制表人:" & txtps_maker.text & Space(15) & "仓管:" & Space(20) & "会计:" & Space(10) & "|经理:" & Space(10)
'                .fontsize = 10
'                '.ForeColor = vbRed
'                '.FontBold = True
'                .Align = tyLeft
'            End With
'            rpt.Tail.AddText "Tail1", txt
'            Set txt = Nothing
            rpt.LeftSection.AlignMode = tyContent
            rpt.RightSection.AlignMode = tyContent
            rpt.Align = tymiddle
'            BTarray(1) = 1000
'            BTarray(2) = 3500
'            BTarray(3) = 1500
'            BTarray(4) = 1000
'            BTarray(5) = 1000
'            BTarray(6) = 1000
'            BTarray(7) = 1000
'            BTarray(8) = 1200
'            recBT(1) = "产品编号"
'            recBT(2) = "产品名称"
'            recBT(3) = "规格"
'            recBT(5) = "单位"
'            recBT(4) = "单价"
'            recBT(6) = "数量"
'            recBT(7) = "金额"
'            recBT(8) = "有效期"
            report = False
            rpt.AttachFlexGrid msglist
            'rpt.ReadTemplate Left(App.Path, Len(App.Path)) & "\dllprint\rptkc.txt"
            rpt.Preview
    Case 8
     Unload Me
  End Select
End Sub
Private Sub Form_Load()
  Call SSTab1_Click(0)
End Sub
Private Sub msglist_Click()
   If msglist.rows < 2 And msglist.TextMatrix(msglist.row, 0) <> "" Then Exit Sub
   With msglist
    txt_id.text = .TextMatrix(.row, 1)
    txt_name.text = .TextMatrix(.row, 2)
    DataCombo1.text = .TextMatrix(.row, 3)
    txt_unit.text = .TextMatrix(.row, 4)
    txt_qty.text = .TextMatrix(.row, 5)
    txt_price.text = .TextMatrix(.row, 6)
   End With
End Sub
Private Sub MSHFlexGrid1_Click()
    Dim strsql As String
    Dim msgtext As String
    Dim super As String
    Dim mrc As ADODB.Recordset
    Dim i As Integer
    Dim totalnum As Double
    Dim jftotal As Single
    Dim jetotal As Single
    Dim jqty As Single
   If MSHFlexGrid1.rows < 2 Then Exit Sub
   With MSHFlexGrid1
    txtps_id.text = .TextMatrix(.row, 0)
    txtps_date.text = .TextMatrix(.row, 1)
    txtps_maker.text = .TextMatrix(.row, 2)
    txtps_demo.text = .TextMatrix(.row, 4)
    Text1.text = .TextMatrix(.row, 3)
   End With
    msglist.Clear
    totalnum = 0
    jftotal = 0
    jetotal = 0
    jqty = 0
    strsql = "select p_id,p_name,unit,format(unit_price,'0.00') as unit_price,qty,price "
     strsql = strsql & " from order_detail_b "
    strsql = strsql & " where order_id ='" & txtps_id.text & "'"
    Set mrc = ExecuteSQL(strsql, msgtext)
    showtitle
    If mrc.EOF Then
        Exit Sub
    End If
    mrc.MoveFirst
    i = 1
    Do Until mrc.EOF
        With msglist
            .rows = i + 1
            .TextMatrix(i, 0) = .rows - 1
            .TextMatrix(i, 1) = "" & mrc.Fields(0)
            .TextMatrix(i, 2) = "" & mrc.Fields(1)
            .TextMatrix(i, 3) = "" & mrc.Fields(2)
            .TextMatrix(i, 4) = "" & mrc.Fields(3)
            .TextMatrix(i, 5) = "" & mrc.Fields(4)
            .TextMatrix(i, 6) = "" & mrc.Fields(5)
             totalnum = totalnum + Val(.TextMatrix(i, 4)) * Val(.TextMatrix(i, 5))
            jqty = jqty + Val(.TextMatrix(i, 5))
            .rowheight(i) = 370
        End With
        i = i + 1
        mrc.MoveNext
    Loop
    mrc.Close
    Set mrc = Nothing
    Label2 = totalnum
    lab_qty.Caption = jqty
    msglist.rows = msglist.rows + 1
    msglist.rowheight(msglist.rows - 1) = 370
    msglist.TextMatrix(msglist.rows - 1, 2) = "合计"
    msglist.TextMatrix(msglist.rows - 1, 6) = Label2.Caption
    lab_total = ChMoney(Val(Label2))
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
    Dim strsql As String
    Dim msgtext As String
    Dim mrc As ADODB.Recordset
    txtps_id.text = ""
    txtps_date.text = ""
    txtps_maker.text = ""
    txtps_demo.text = ""
    Text1.text = ""
    msglist.Clear
    txt_id.text = ""
    txt_name.text = ""
    DataCombo1.text = ""
    txt_qty.text = ""
    txt_unit.text = ""
    txt_price.text = ""
    lab_total.Caption = ""
    lab_qty.Caption = ""
    Label2.Caption = ""
    Select Case SSTab1.Tab
     Case 0
        strsql = "select ps_id,format(ps_date,'yyyy-MM-dd'),ps_maker,ps_type,ps_demo"
        strsql = strsql & " from ps_head_b "
        strsql = strsql & " where ps_type='仓库盘点报损'"
     Case 1
        strsql = "select ps_id,format(ps_date,'yyyy-MM-dd'),ps_maker,ps_type,ps_demo"
        strsql = strsql & " from ps_head_b "
        strsql = strsql & " where ps_type='仓库盘点报溢'"
    End Select
    Set mrc = ExecuteSQL(strsql, msgtext)
    MSHFlexGrid1.Clear
    MSHFlexGrid1.rows = 2
    If Not mrc.EOF Then
    Set MSHFlexGrid1.DataSource = mrc
    End If
    showtitle1
    
    If mrc.State = adStateOpen Then mrc.Close
    Set mrc = Nothing
End Sub
Private Sub showtitle1()
    Dim i As Integer
    With MSHFlexGrid1
        .Cols = 5
         If .rows < 2 Then
            .rows = 2
        End If
        .TextMatrix(0, 0) = "单号"
        .TextMatrix(0, 1) = "日期"
        .TextMatrix(0, 2) = "制单人"
        .TextMatrix(0, 4) = "备注"
        .TextMatrix(0, 3) = "单据类型"
        For i = 0 To 4
            .ColAlignment(i) = 1
        Next i
        '表头项居中
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        .RowSel = 1
        .ColSel = .Cols - 1
        '.CellAlignment = 4
        '设置单元大小
        .colWidth(0) = 800
        .colWidth(1) = 1000
        .colWidth(2) = 800
        .colWidth(4) = 1800
        .colWidth(3) = 1200
        .row = 1
    End With
End Sub
Private Sub showtitle()
    Dim i As Integer
    With msglist
        .Cols = 7
        .rows = 2
        .TextMatrix(0, 0) = "序号"
        .TextMatrix(0, 1) = "编号"
        .TextMatrix(0, 2) = "产品名称"
        .TextMatrix(0, 3) = "单位"
        .TextMatrix(0, 4) = "单价"
        .TextMatrix(0, 5) = "数量"
        .TextMatrix(0, 6) = "金额"
        '设置各列的对齐方
        For i = 1 To 6
            .ColAlignment(i) = 1
        Next i
        '表头项居中
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        .RowSel = 1
        .ColSel = .Cols - 1
        '.CellAlignment = 4
        '设置单元大小
        .colWidth(0) = 600
        .colWidth(1) = 800
        .colWidth(2) = 2500
        .colWidth(3) = 600
        .colWidth(4) = 800
        .colWidth(5) = 700
        .colWidth(6) = 1000
        .row = 1
        .TextMatrix(1, 6) = "合计"
        .mergeRow(1) = True
        .ColAlignment(0) = 6
        .rowheight(1) = 370
'        .MergeCells = flexMergeRestrictRows
    End With
End Sub