frm_ghcx.frm

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

         Top             =   1625
         Width           =   1035
      End
      Begin VB.Label Label3 
         Caption         =   "结束时间:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   270
         Index           =   0
         Left            =   135
         TabIndex        =   13
         Top             =   985
         Width           =   1035
      End
      Begin VB.Label Label2 
         Caption         =   "起始时间:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   270
         Left            =   135
         TabIndex        =   12
         Top             =   345
         Width           =   1035
      End
      Begin VB.Label Label1 
         Caption         =   "查询类别:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   270
         Left            =   135
         TabIndex        =   4
         Top             =   2265
         Width           =   1050
      End
   End
   Begin MSHierarchicalFlexGridLib.MSHFlexGrid msglist 
      Height          =   4410
      Left            =   60
      TabIndex        =   0
      Top             =   255
      Width           =   7770
      _ExtentX        =   13705
      _ExtentY        =   7779
      _Version        =   393216
      FixedCols       =   0
      AllowBigSelection=   0   'False
      SelectionMode   =   1
      AllowUserResizing=   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   11.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _NumberOfBands  =   1
      _Band(0).Cols   =   2
   End
End
Attribute VB_Name = "frm_ghcx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const UNIT = 0.03937 * 1440

Private Sub Command1_Click(Index As Integer)
   Dim TxtSQL As String
   Dim msgtext As String
   Dim supp As String
   Dim mrc As ADODB.Recordset
   Dim rpt         As New report
   Dim txt         As clsText

    Select Case Index
        Case 0
            TxtSQL = "select supplier_id from Supplier_unit where supplier_name='" & supplier & "'"
            Set mrc = ExecuteSQL(TxtSQL, msgtext)
            supp = mrc!supplier_id
            TxtSQL = "select ps_id,format(ps_date,'yyyy-MM-dd'),ps_rid,ps_maker,ps_demo,ps_type,ps_total"
            TxtSQL = TxtSQL & " from ps_head_b where ps_rid='" & supp & "'"
            Select Case comb_lx.ListIndex
                Case 0
                    Select Case comb_lxx.ListIndex
                        Case 0
                            TxtSQL = TxtSQL & " and ps_type='采购入库'"
                        Case 1
                            TxtSQL = TxtSQL & " and ps_type='退库单'"
                    End Select
                    TxtSQL = TxtSQL & " and format(ps_date,'yyyy-MM-dd')='" & Format(dtptime(0).Value, "yyyy-MM-dd") & "'"
                    TxtSQL = TxtSQL & " order by ps_id"
                Case 1
                    Select Case comb_lxx.ListIndex
                        Case 0
                            TxtSQL = TxtSQL & " and ps_type='采购入库'"
                        Case 1
                            TxtSQL = TxtSQL & " and ps_type='退库单'"
                    End Select
                    TxtSQL = TxtSQL & " and format(ps_date,'yyyy-MM')='" & Format(dtptime(0).Value, "yyyy-MM") & "'"
                    TxtSQL = TxtSQL & " order by ps_id"
                Case 2
                    Select Case comb_lxx.ListIndex
                        Case 0
                            TxtSQL = TxtSQL & " and ps_type='采购入库'"
                        Case 1
                            TxtSQL = TxtSQL & " and ps_type='退库单'"
                    End Select
                    TxtSQL = TxtSQL & " and format(ps_date,'yyyy-MM-dd')>='" & Format(dtptime(0).Value, "yyyy-MM-dd") & "'"
                    TxtSQL = TxtSQL & " and format(ps_date,'yyyy-MM-dd')<='" & Format(dtptime(1).Value, "yyyy-MM-dd") & "'"
                    TxtSQL = TxtSQL & " order by ps_id"
            End Select
            Set mrc = ExecuteSQL(TxtSQL, msgtext)
            Set msglist.DataSource = mrc
            showtitle
            mrc.Close
            Set mrc = Nothing
        Case 1
            rpt.AttachFlexGrid msglist
            rpt.ReadTemplate Left(app.Path, Len(app.Path)) & "\rptkc1.txt"
            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
   
    TxtSQL = "select supplier_name from Supplier_unit"
    Set mrc = ExecuteSQL(TxtSQL, msgtext)
    If Not mrc.EOF Then
        Do While Not mrc.EOF
            supplier.AddItem mrc!supplier_name
            mrc.MoveNext
        Loop
        supplier.ListIndex = 0
    End If
    mrc.Close
    Set mrc = Nothing
    comb_lx.AddItem "日查询"
    comb_lx.AddItem "月查询"
    comb_lx.AddItem "时段查询"
    comb_lxx.AddItem "采购入库"
    comb_lxx.AddItem "退库单"
    dtptime(0).Value = Now
    dtptime(1).Value = Now
    comb_lx.text = ""
    comb_lxx.text = ""
    Command1_Click (0)
End Sub

Private Sub msglist_Click()
Dim TxtSQL As String
Dim msgtext As String
Dim mrc As ADODB.Recordset
    
    If msglist.row > 0 Then
        TxtSQL = "select * from order_detail_b"
        TxtSQL = TxtSQL & " where order_id='" & msglist.TextMatrix(msglist.row, 0) & "'"
        TxtSQL = TxtSQL & " order by p_id"
        Set mrc = ExecuteSQL(TxtSQL, msgtext)
        Set msglist1.DataSource = mrc
        showtitle1
        mrc.Close
        Set mrc = Nothing
    End If
End Sub
Private Sub showtitle()
    Dim i As Integer
    
    With msglist
        .Cols = 7
        .TextMatrix(0, 0) = "单号"
        .TextMatrix(0, 1) = "日期"
        .TextMatrix(0, 2) = "供应商编号"
        .TextMatrix(0, 3) = "制单人"
        .TextMatrix(0, 4) = "备注事项"
        .TextMatrix(0, 5) = "单据类型"
        .TextMatrix(0, 6) = "金额"
        '设置各列的对齐方
        'For i = 0 To 6
        '    .ColAlignment(i) = 1
        'Next i
        '表头项居中
        '.FillStyle = flexFillRepeat
        '.col = 0
        '.row = 0
        '.RowSel = 1
        '.ColSel = .Cols - 1
        '.CellAlignment = 4
        '设置单元大小
        .colWidth(0) = 900
        .colWidth(1) = 1300
        .colWidth(2) = 1300
        .colWidth(3) = 900
        .colWidth(4) = 1300
        .colWidth(5) = 1000
        .colWidth(6) = 1000
    End With
End Sub

Private Sub showtitle1()
    Dim i As Integer
    
    With msglist1
        .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 = 0 To 6
        '    .ColAlignment(i) = 1
        'Next i
        '表头项居中
        '.FillStyle = flexFillRepeat
        '.col = 0
        '.row = 0
        '.RowSel = 1
        '.ColSel = .Cols - 1
        '.CellAlignment = 4
        '设置单元大小
        .colWidth(0) = 1300
        .colWidth(1) = 1400
        .colWidth(2) = 2500
        .colWidth(3) = 1400
        .colWidth(4) = 1400
        .colWidth(5) = 1400
        .colWidth(6) = 1600
        '.Row = 1
    End With
End Sub