frmroom.frm

宾馆管理信息系统

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmRoom 
   BackColor       =   &H00C0C0FF&
   Caption         =   "客房信息列表"
   ClientHeight    =   4725
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9150
   LinkTopic       =   "Form3"
   ScaleHeight     =   4725
   ScaleWidth      =   9150
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command3 
      BackColor       =   &H00C0C0FF&
      Caption         =   "修改"
      Height          =   495
      Left            =   5520
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   3960
      Width           =   1215
   End
   Begin VB.CommandButton Command2 
      BackColor       =   &H00C0C0FF&
      Caption         =   "添加"
      Height          =   495
      Left            =   3600
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   3960
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      BackColor       =   &H00C0C0FF&
      Caption         =   "删除"
      Height          =   495
      Left            =   1680
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   3960
      Width           =   1215
   End
   Begin MSFlexGridLib.MSFlexGrid msgList 
      Height          =   3015
      Left            =   240
      TabIndex        =   1
      Top             =   720
      Width           =   8655
      _ExtentX        =   15266
      _ExtentY        =   5318
      _Version        =   393216
      Cols            =   4
      FixedCols       =   3
   End
   Begin VB.Label Label2 
      BackColor       =   &H00C0C0FF&
      Caption         =   "退出"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00004040&
      Height          =   375
      Left            =   6840
      TabIndex        =   2
      Top             =   120
      Width           =   615
   End
   Begin VB.Label Label1 
      BackColor       =   &H00C0C0FF&
      Caption         =   " 客  房  信  息  列  表"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00004040&
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   4335
   End
End
Attribute VB_Name = "frmRoom"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public txtSQL As String
Dim mrc As ADODB.Recordset
Dim MsgText As String
Dim msSql As String

Private Sub cmddelete_Click()
RecordDelete
End Sub

Private Sub cmdfirst_Click()
 Set mrc = ExecuteSQL(txtSQL, MsgText)
 If mrc.RecordCount > 0 Then
 mrc.MoveFirst
 End If
End Sub

Private Sub cmdnext_Click()
If Not mrc.EOF Then
  mrc.MoveNext
End If
If mrc.EOF And mrc.RecordCount > 0 Then
  mrc.MoveLast
End If
End Sub

Private Sub cmdprevious_Click()
If Not mrc.BOF Then
   mrc.MovePrevious
End If
If mrc.BOF And mrc.RecordCount > 0 Then
   mrc.MoveFirst
End If
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Sub Command1_Click()
 Dim txtSQL As String
    Dim intCount As Integer
    Dim mrc As ADODB.Recordset
    Dim MsgText As String
            If msgList.Rows > 1 Then
            If MsgBox("真的要删除这条文件记录么？", vbOKCancel + vbExclamation, "警告") = vbOK Then
               txtSQL = "select * from bookin where  roomNO='" & Trim(msgList.TextMatrix(intCount, 1)) & "'" And putup = ""
               Set mrc = ExecuteSQL(txtSQL, MsgText)
              If mrc = "" Then
                intCount = msgList.Row
                txtSQL = "delete from rooms where roomNO='" & Trim(msgList.TextMatrix(intCount, 1)) & "'"
                Set mrc = ExecuteSQL(txtSQL, MsgText)
                 Unload frmRoom
                txtSQL = "select * from rooms"
                frmRoom.Show
              Else
                MsgBox "客房被预定不能删除！！", vbExclamation, "警告"
            End If
       End If
    End If
End Sub

Private Sub Command2_Click()
    gintRmode = 1
    frmRoom1.Show
    frmRoom1.ZOrder 0
End Sub

Private Sub Command3_Click()
 Dim intCount As Integer
    If flagRedit Then
        If frmRoom.msgList.Rows > 1 Then
            gintRmode = 2
            intCount = msgList.Row
            frmRoom1.txtSQL = "select * from rooms where roomNO ='" & Trim(frmRoom.msgList.TextMatrix(intCount, 1)) & "'"
            frmRoom1.Show
               End If
    Else
        frmRoom.txtSQL = "select * from rooms"
        frmRoom.Show
    End If
End Sub

Private Sub Form_Load()
    ShowTitle
    ShowData
    flagRedit = True
End Sub
'Private Sub Form_Resize()
  '  If Me.WindowState <> vbMinimized And fMainForm.WindowState <> vbMinimized Then
        '边界处理
   '     If Me.ScaleHeight < 10 * lblTitle.Height Then
   '         Exit Sub
    '    End If
    '    If Me.ScaleWidth < lblTitle.Width + lblTitle.Width / 2 Then
    '       Exit Sub
     '   End If
        '控制控件的位置
    '    lblTitle.Top = lblTitle.Height
     '   lblTitle.Left = (Me.Width - lblTitle.Width) / 2
     '   msgList.Top = lblTitle.Top + lblTitle.Height + lblTitle.Height / 2
     '   msgList.Width = Me.ScaleWidth - 200
      '  msgList.Left = Me.ScaleLeft + 100
      '  msgList.Height = Me.ScaleHeight - msgList.Top - 200
    'End If
'End Sub
Public Sub RecordEdit()
    Dim intCount As Integer
    If msgList.Rows > 1 Then
        gintMode = EDIT
        intCount = msgList.Row
        msSql = " where rkno='" & Trim(msgList.TextMatrix(msgList.Row, 1)) & "'"
        frmMaterIn1.Show 1
        ShowData
        Call MovCursor(intCount, msgList)
    Else
        Call RecordAdd
    End If
End Sub
Public Sub FormClose()
    Unload Me
End Sub
'删除记录
Public Sub RecordDelete()
    Dim sSql As String
    Dim intCount As Integer
  On Error GoTo myErr
    If msgList.Rows > 1 Then
        If MsgBox("真的要删除这条文件记录么？", vbOKCancel + vbExclamation, "警告") = vbOK Then
            intCount = msgList.Row
            wksHuaxia.BeginTrans
            sSql = "update amsurplus set yeaccount=yeaccount-" & Trim(msgList.TextMatrix(msgList.Row, 7)) & ",yevalue=yevalue-" & Trim(msgList.TextMatrix(msgList.Row, 9)) & " where yeid='" & Trim(msgList.TextMatrix(msgList.Row, 2)) & "'"
            dbHuaxia.Execute sSql, dbSQLPassThrough
            sSql = "delete from " & msTableName & " where rkno='" & Trim(msgList.TextMatrix(msgList.Row, 1)) & "'"
            dbHuaxia.Execute sSql, dbSQLPassThrough
            wksHuaxia.CommitTrans
            ShowData
            If msgList.Rows > 1 Then
                If intCount = msgList.Rows Then
                    MovCursor msgList.Rows - 1, msgList
                Else
                    MovCursor intCount, msgList
                End If
            End If
        End If
    End If
    Exit Sub
myErr:
    wksHuaxia.Rollback
    ShowError
End Sub
Public Sub RecordRefresh()
    '设置msSql
    msSql = msSelect & msTableName & " where rkdate>='" & Format(DateAdd("m", -1, Now), "yyyy-mm-dd") & "' and rkdate<='" & Format(Now, "yyyy-mm-dd") & "'" & msOrderBy
    '显示数据
    msBarText = "当前数据时间范围：" & Format(DateAdd("m", -1, Now), "yyyy-mm-dd") & "至" & Format(Now, "yyyy-mm-dd")
    sOrder0 = "+ {rkdate}"
    sOrder1 = ""
    ShowData
End Sub
Public Sub RecordAdd()
    gintMode = Add
    frmMaterIn1.Show 1
    ShowData
End Sub
Public Sub RecordFind()
    frmMaterIn2.Show 1
    If Trim(frmMaterIn2.sQSql & " ") <> "" Then
        msSql = msSelect & msTableName & " where" & frmMaterIn2.sQSql & msOrderBy
        ShowData
    End If
    Unload frmMaterIn2
End Sub
Private Sub Form_Unload(Cancel As Integer)
    flagRedit = False
    flagSedit = False
    gintRmode = 0
End Sub
'显示Grid的内容
Private Sub ShowData()
    Dim j As Integer
    Dim i As Integer
    Set mrc = ExecuteSQL(txtSQL, MsgText)
        With msgList
        .Rows = 1
        Do While Not mrc.EOF
            .Rows = .Rows + 1
            For i = 1 To mrc.Fields.Count
                Select Case mrc.Fields(i - 1).Type
                    Case adDBDate
                        .TextMatrix(.Rows - 1, i) = Format(mrc.Fields(i - 1) & "", "yyyy-mm-dd")
                    Case Else
                        .TextMatrix(.Rows - 1, i) = mrc.Fields(i - 1) & ""
                End Select
            Next i
            mrc.MoveNext
        Loop
    End With
    mrc.Close
End Sub
'显示Grid表头
Private Sub ShowTitle()
    Dim i As Integer
    With msgList
        .Cols = 7
        .TextMatrix(0, 1) = "客房编号"
        .TextMatrix(0, 2) = "客房种类"
        .TextMatrix(0, 3) = "客房位置"
        .TextMatrix(0, 4) = "客房单价"
        .TextMatrix(0, 5) = "是否被定"
        .TextMatrix(0, 6) = "备注"
        '固定表头
        .FixedRows = 1
        '设置各列的对齐方式
        For i = 0 To 6
            .ColAlignment(i) = 0
        Next i
        '表头项居中
        .FillStyle = flexFillRepeat
        .Col = 0
        .Row = 0
        .RowSel = 1
        .ColSel = .Cols - 1
        .CellAlignment = 4
        '设置单元大小
        .ColWidth(0) = 1000
        .ColWidth(1) = 1000
        .ColWidth(2) = 1000
        .ColWidth(3) = 1000
        .ColWidth(4) = 1000
        .ColWidth(5) = 1000
        .ColWidth(6) = 1000
        .Row = 1
    End With
End Sub

Private Sub Label2_Click()
Unload Me
End Sub

Private Sub msgList_DblClick()
    Dim intCount As Integer
    If flagSedit Then
        If msgList.Rows > 1 Then
            gintBmode = 1
            intCount = msgList.Row
            frmBookin1.txtSQL = "select * from rooms where roomNO = '" & Trim(msgList.TextMatrix(intCount, 1)) & "'"
            frmBookin1.Show
        End If
    End If
End Sub
Private Sub msgList_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '右键弹出
    If Button = 2 And Shift = 0 Then
        PopupMenu FrmMain.menuSetrooms
    End If
End Sub