cx_kfly.frm

一个简单的酒店管理系统 用VB.net+SQL2000实现

                        L_R(m) = 11
                    Else
                        L_R(m) = 21
                    End If
                    m = m + 1
                Loop
                Call print_tabler(rec, "客房利用情况表" & dy_rqfw.date1 & "~" & dy_rqfw.date2, dy_kfly_xx.FILD, dy_kfly_xx.LLEN, 10, L_R)
            Else
                MsgBox "此时间内无信息!", 64
            End If
        End If
    End If
End Sub

Private Sub Form_Activate()
    gd_lycx.SetFocus
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyF5
              Call cmd_prt_Click
        Case vbKeyEscape
              Call CMD_EXIT_Click
    End Select
End Sub

Private Sub Form_Load()
    Dim I As Integer
    frm_msg.Visible = False
    frm_msg.Caption = ""
    
    Me.KeyPreview = True
    t_length = 6
    t_bt_ylkf = "^ 预留客房  "
    For I = 1 To sys_lxn
        t_bt_ylkf = t_bt_ylkf & "||^" & SYS_LXC(I) & Space(t_length - Len(SYS_LXC(I)) * 2) & "|>" & SYS_Yl(I) & Space(t_length - Len(SYS_Yl(I)))
    Next
    gd_ylkf.Cols = sys_lxn * 2 + 1
    t_bt_ylkf = Left(t_bt_ylkf, Len(t_bt_ylkf) - 1) & " "
    gd_ylkf.FormatString = t_bt_ylkf
    gd_ylkf.Width = 11 * 105 + (t_length * 2 + 1) * 105 * sys_lxn
    
    gd_lycx.Width = 11 * 105 + (t_length * 105 * sys_lxn + 2 + 1) * 3 + 105 * 5
    Me.Width = gd_ylkf.Left * 3 + gd_lycx.Width
    
    lb_title.Left = gd_lycx.Left
    lb_title.Width = gd_lycx.Width
    
    frm_msg.Left = gd_lycx.Left
    frm_msg.Width = gd_lycx.Width
    
    START_DAY = Date
    END_DAY = Null
    
    op_kflx(0).Value = True
    CS_id = 0
    
    Call b_build(CS_id, START_DAY, END_DAY)
    
    If gd_lycx.Rows - 1 <> 0 Then
        END_DAY = gd_lycx.TextArray((gd_lycx.Rows - 1) * (1 + (sys_lxn + 1) * 3))
    Else
        END_DAY = Null
    End If
    
    tx_rq_s.Text = Format(START_DAY, "yyyy-mm-dd")
    tx_rq_e.Text = IIf(IsNull(END_DAY), "    -  -  ", Format(END_DAY, "yyyy-mm-dd"))

End Sub

Private Sub b_build(T_ID As Integer, t_rq_s As Date, t_rq_e As Variant)
    Dim j As Integer

    Dim temp_i As Integer
    
    Dim temp_kflx As String
    Dim temp_kflx_mc As String
    
    Dim temp_fields As String       'KF_KFLY显示的字段
    Dim temp_kfly As Recordset      'KF_KFLY的记录集
    
    t_bt_lycx = "^" & "日期" & Space(11 - Len("日期") * 2)
    For j = 1 To 3
        t_bt_lycx = t_bt_lycx & "|"
        For temp_i = 1 To sys_lxn
            t_bt_lycx = t_bt_lycx & "|>" & SYS_LXC(temp_i) & Space(t_length - Len(SYS_LXC(temp_i)) * 2)
        Next   '设置显示表头格式
    Next

    temp_fields = "RQ,"
    '剩余
    temp_fields = temp_fields & "'' AS S1,"
    For temp_i = 1 To sys_lxn
        temp_fields = temp_fields & "SY_LX" & Trim(STR(temp_i)) & ","
    Next
    '住人
    temp_fields = temp_fields & "'' AS S2,"
    For temp_i = 1 To sys_lxn
        temp_fields = temp_fields & "ZR_LX" & Trim(STR(temp_i)) & ","
    Next
    
    Select Case T_ID
    Case 0
        temp_kflx = "YD"
        temp_kflx_mc = "预订"
    Case 1
        temp_kflx = "CB"
        temp_kflx_mc = "长包"
    Case 2
        temp_kflx = "WX"
        temp_kflx_mc = "维修"
    Case 3
        temp_kflx = "NB"
        temp_kflx_mc = "内部"
    Case 4
        temp_kflx = "FY"
        temp_kflx_mc = "房源"
    End Select
    
    t_bt_title = "^           "
    t_bt_title = t_bt_title & "||^" & "剩余" & Space((t_length + 1) * sys_lxn - Len("剩余") * 2 - 1)
    t_bt_title = t_bt_title & "||^" & "住人" & Space((t_length + 1) * sys_lxn - Len("住人") * 2 - 1)
    t_bt_title = t_bt_title & "||^" & temp_kflx_mc & Space((t_length + 1) * sys_lxn - Len(temp_kflx_mc) * 2 - 1)
    gd_title.Cols = sys_lxn + 1
    t_bt_title = Left(t_bt_title, Len(t_bt_title) - 1) & " "
    gd_title.FormatString = t_bt_title
    gd_title.Width = gd_lycx.Width
    
    '预订等
    temp_fields = temp_fields & "'' AS S3,"
    For temp_i = 1 To sys_lxn
        temp_fields = temp_fields & temp_kflx & "_LX" & Trim(STR(temp_i)) & ","
    Next
    temp_fields = Left(temp_fields, Len(temp_fields) - 1)
    
    gd_lycx.Clear
    gd_lycx.FillStyle = 1
    gd_lycx.AllowBigSelection = False
    gd_lycx.Rows = 15
    
    If IsNull(t_rq_e) Then
        Set temp_kfly = PUB_data.OpenRecordset("SELECT " & temp_fields & " FROM KF_KFLY WHERE RQ>=#" & t_rq_s & "# ORDER BY RQ", 4, 0, 2)
    Else
        Set temp_kfly = PUB_data.OpenRecordset("SELECT " & temp_fields & " FROM KF_KFLY WHERE RQ BETWEEN #" & t_rq_s & "# AND #" & t_rq_e & "# ORDER BY RQ", 4, 0, 2)
    End If
    If Not temp_kfly.BOF Then
        temp_kfly.MoveLast
        If temp_kfly.RecordCount > 9 Then
            gd_lycx.Rows = temp_kfly.RecordCount + 1
        End If
        
        temp_kfly.MoveFirst
    End If
    
    gd_lycx.Cols = (sys_lxn + 1) * 3 + 1
    gd_lycx.FormatString = t_bt_lycx

    j = 0
    Do While Not temp_kfly.EOF
        j = j + 1
        gd_lycx.Row = j
        For temp_i = 0 To gd_lycx.Cols - 1
            gd_lycx.TextArray(j * gd_lycx.Cols + temp_i) = temp_kfly.Fields(temp_i)
        Next
        
        If j Mod 5 = 0 Then
            gd_lycx.Row = j
            gd_lycx.RowSel = j
            gd_lycx.ColSel = gd_lycx.Cols - 1
            gd_lycx.CellBackColor = &HFFC0C0
        End If
        
        temp_kfly.MoveNext
    Loop
    temp_kfly.Close
    
    gd_lycx.Col = 0
    gd_lycx.Row = 1
End Sub

Private Sub gd_lycx_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        tx_rq_s.SetFocus
    End If
End Sub
Private Sub op_kflx_Click(Index As Integer)
    Call b_build(Index, START_DAY, END_DAY)
End Sub

Private Sub op_kflx_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        cmd_exit.SetFocus
    End If
End Sub

Private Sub tx_rq_e_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim temp_i As Integer
    If KeyCode = vbKeyReturn Then
        For temp_i = 0 To op_kflx.Count - 1
            If op_kflx(temp_i).Value Then
                op_kflx(temp_i).SetFocus
                Exit For
            End If
        Next
    End If
End Sub

Private Sub tx_rq_e_LostFocus()
    Dim temp_ft As Boolean
    
    frm_msg.Visible = False
    frm_msg.Caption = ""
    
    temp_ft = True
    
    If tx_rq_e.Text = "    -  -  " Then
        END_DAY = Null
    Else
        If Len(Trim(tx_rq_e.Text)) = 10 Then
            If IsDate(Trim(tx_rq_e.Text)) Then
                If CDate(tx_rq_e.Text) < CDate(tx_rq_s.Text) Then
                    temp_ft = False
                Else
                    END_DAY = CDate(tx_rq_e.Text)
                End If
            Else
                temp_ft = False
            End If
        Else
            temp_ft = False
        End If
    End If
    
    If Not temp_ft Then
        frm_msg.Visible = True
        frm_msg.Caption = "不适当的终止日期"
        tx_rq_e.SetFocus
    Else
        Call b_build(CS_id, START_DAY, END_DAY)
    End If

End Sub

Private Sub tx_rq_s_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        tx_rq_e.SetFocus
    End If
End Sub

Private Sub tx_rq_s_LostFocus()
    Dim temp_ft As Boolean
    
    frm_msg.Visible = False
    frm_msg.Caption = ""
    
    temp_ft = True
    If tx_rq_s.Text = "    -  -  " Then
        tx_rq_s.Text = Format(Date, "yyyy-mm-dd")
    Else
        If Len(Trim(tx_rq_s.Text)) = 10 Then
            If IsDate(Trim(tx_rq_s.Text)) Then
                If CDate(tx_rq_e.Text) < Date Then
                    tx_rq_s.Text = Format(Date, "yyyy-mm-dd")
                End If
            Else
                temp_ft = False
            End If
        Else
            temp_ft = False
        End If
    End If
    
    If Not temp_ft Then
        frm_msg.Visible = True
        frm_msg.Caption = "不适当的起始日期"
    Else
        START_DAY = CDate(tx_rq_s.Text)
    End If

End Sub