frmRoom.frm
资源名称:宾馆管理信息系统1.rar [点击查看]
上传用户:fulizhu2
上传日期:2007-06-21
资源大小:34k
文件大小:7k
源码类别:
酒店行业
开发平台:
Visual Basic
- VERSION 5.00
- Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
- Begin VB.Form frmRoom
- Caption = "客房信息列表"
- ClientHeight = 3972
- ClientLeft = 60
- ClientTop = 348
- ClientWidth = 7680
- LinkTopic = "Form1"
- MDIChild = -1 'True
- ScaleHeight = 3972
- ScaleWidth = 7680
- WindowState = 2 'Maximized
- Begin MSFlexGridLib.MSFlexGrid msgList
- Height = 3132
- Left = 120
- TabIndex = 1
- Top = 720
- Width = 7452
- _ExtentX = 13145
- _ExtentY = 5525
- _Version = 393216
- Cols = 4
- FixedCols = 3
- AllowUserResizing= 1
- End
- Begin VB.Label lblTitle
- Caption = "客 房 信 息 列 表"
- BeginProperty Font
- Name = "宋体"
- Size = 12
- Charset = 134
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- ForeColor = &H8000000D&
- Height = 255
- Left = 120
- TabIndex = 0
- Top = 240
- Width = 3015
- 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
- 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
- gsSql = " 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 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 fMainForm.menuSetrooms
- End If
- End Sub