frmobsolete_seek.frm

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

    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(p_time,'yyyy-MM-dd'),p_worker,ps_type,notes"
            strsql = strsql & " from ps_head_b "
            strsql = strsql & " where p_flag=True "
         Case 1
            strsql = "select ps_id,format(p_time,'yyyy-MM-dd'),p_worker,space(10),notes"
            strsql = strsql & " from psout_head "
            strsql = strsql & " where p_flag=True "
        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(p_time,'yyyy-MM-dd')= '" & Format(FrmSql.strsqlfield, "yyyy-MM-dd") & "'"
           Case 2
             strsql = strsql & " and p_worker='" & 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 "
    Select Case SSTab1.Tab
      Case 0
        strsql = strsql & " from order_detail_b "
      Case 1
       strsql = strsql & " from psout_detail "
    End Select
    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(p_time,'yyyy-MM-dd'),p_worker,ps_type,notes"
        strsql = strsql & " from ps_head_b "
        strsql = strsql & " where p_flag=True "
     Case 1
        strsql = "select ps_id,format(p_time,'yyyy-MM-dd'),p_worker,space(10),notes"
        strsql = strsql & " from psout_head "
        strsql = strsql & " where p_flag=True "
    End Select
    Set mrc = ExecuteSQL(strsql, msgtext)
    Set MSHFlexGrid1.DataSource = mrc
    showtitle1
    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
        '表头项居中
        .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) = 800
        .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