fmdestine.frm

<Visual Basic 数据库开发实例精粹（第二版）>一书首先介绍了Visual Basic(简称VB)开发的技巧和重点技术

      End
      Begin VB.Label Label4 
         Caption         =   "房间编号:"
         Height          =   375
         Left            =   3360
         TabIndex        =   8
         Top             =   360
         Width           =   855
      End
      Begin VB.Label Label3 
         Caption         =   "客户姓名:"
         Height          =   375
         Left            =   600
         TabIndex        =   7
         Top             =   360
         Width           =   855
      End
   End
   Begin VB.Label LabelMemName 
      Height          =   255
      Left            =   4200
      TabIndex        =   6
      Top             =   240
      Width           =   735
   End
   Begin VB.Label Label2 
      Caption         =   "会员姓名:"
      Height          =   255
      Left            =   3120
      TabIndex        =   5
      Top             =   240
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "会员编号:"
      Height          =   255
      Left            =   1080
      TabIndex        =   3
      Top             =   240
      Width           =   855
   End
   Begin VB.Label LabelDate 
      Height          =   255
      Left            =   5280
      TabIndex        =   1
      Top             =   240
      Width           =   975
   End
End
Attribute VB_Name = "FMDestine"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Function ShowRoomInfo()
  Dim RoomQuery As New ADODB.Recordset
  Dim StrSql As String
  Dim sRoomID As String

  sRoomID = Trim(Me.CombRoomID.Text)
  StrSql = "select RoomTypeName,RoomPrice from RoomInfo " & "where RoomID='" & sRoomID & "'"
  RoomQuery.Open StrSql, g_DBConn, adOpenStatic, adLockOptimistic
    
  Me.CombRoomType.Text = RoomQuery.Fields("RoomTypeName").Value
  Me.CombRoomPrice.Text = RoomQuery.Fields("RoomPrice").Value
    
  RoomQuery.Close
  'Adodc1.Refresh
End Function

Private Sub Check1_Click()
  Me.Label1.Visible = True
  Me.CombMemID.Visible = True
  Me.Label2.Visible = True
  Me.LabelMemName.Visible = True

End Sub

Private Sub CombMemID_Click()
  Dim ReadMemberN As New ADODB.Recordset
  Dim Str As String
  Dim sMemberID As String

  sMemberID = Trim(Me.CombMemID.Text)
  Str = "select MemberName,Tel2 from MemberInfo where MemberID='" & sMemberID & "'"
  ReadMemberN.Open Str, g_DBConn, adOpenStatic, adLockOptimistic
  Me.LabelMemName.Caption = ReadMemberN.Fields("MemberName").Value
  Me.TextClientName.Text = ReadMemberN.Fields("MemberName").Value
  Me.TextClientTel.Text = ReadMemberN.Fields("Tel2").Value
  ReadMemberN.Close
End Sub

Private Sub CombRoomID_Click()
  Dim ReadRoomID As New ADODB.Recordset
  Dim Str As String
  Str = "select RoomTypeName,RoomPrice from RoomInfo where RoomID='" & Trim(Me.CombRoomID.Text) & "'"
  ReadRoomID.Open Str, g_DBConn, adOpenStatic, adLockOptimistic
  Me.CombRoomType.Text = ReadRoomID.Fields("RoomTypeName").Value
  Me.CombRoomPrice.Text = ReadRoomID.Fields("RoomPrice").Value
  ReadRoomID.Close
End Sub

Private Sub ComdCancel_Click()
  Unload Me
End Sub

Private Sub ComdModify_Click()
  Me.TextClientName.Text = ""
  Me.TextClientTel.Text = ""
  Me.TextCount.Text = ""
  Me.DTPicker1.Value = "2006-12-01"
  Me.DTPickerTime.Value = "0:00:00"
  Me.CombWaitor.Text = ""
  Me.TextPrepay.Text = ""
  Me.TextRemake.Text = ""
    
End Sub

Private Sub ComdOK_Click()
  Dim SqlStr As String
  Dim sRoomID As String
  Dim Str As String
  Dim sMemberID As String
  Dim sTime As String
  Dim a, b As String

  If Me.DTPickerTime.Value = "0:00:00" Or Me.DTPicker1.Value = "2006-12-1" Then
    MsgBox "请填写开房时间和开房日期！"
    Exit Sub
  End If

  sRoomID = Trim(Me.CombRoomID.Text)

  If Trim(Me.TextCount.Text) = "" Then
    a = "0"
  Else
    a = Trim(Me.TextCount.Text)
  End If

  If Trim(Me.TextPrepay.Text) = "" Then
    b = "0"
  Else
    b = Trim(Me.TextPrepay.Text)
  End If

  If Trim(Me.CombMemID.Text) = "" Then
    sMemberID = "000"
  Else
    sMemberID = Trim(Me.CombMemID.Text)
  End If

  sTime = Trim(Me.DTPicker1.Value) & " " & Right(Trim(Me.DTPickerTime.Value), 8)
    
                      
  g_DBConn.Execute SqlStr
    
  Str = "update RoomInfo set RoomState='预定' where RoomID='" & sRoomID & "'"
  g_DBConn.Execute Str
  MsgBox "预定成功!"
    
  Me.DTPicker1.Value = "2006-12-01"
  Me.DTPickerTime.Value = "0:00:00"
    
  Unload Me
End Sub

Private Sub Form_Load()
  Dim DBStr As String
  Dim AddDestineID As New ADODB.Recordset
  Dim i As Integer
  Dim sDestinedID As String

  Me.Top = (Screen.Height - Me.Height) / 2    '垂直方向居中
  Me.Left = (Screen.Width - Me.Height) / 2    '水平方向居中
    
  Me.Label1.Visible = False
  Me.CombMemID.Visible = False
  Me.Label2.Visible = False
  Me.LabelMemName.Visible = False
    
  Me.LabelDestineID.Visible = False
  Me.TextDestineID.Visible = False
    
  '当前日期
  Me.LabelDate.Caption = Date

  '自动生成预定单编号
  DBStr = "select DestineID from DestineInfo"
  AddDestineID.CursorType = adOpenStatic
  AddDestineID.CursorLocation = adUseClient
  AddDestineID.Open DBStr, g_DBConn, adOpenForwardOnly, adLockOptimistic
    
  If AddDestineID.EOF Then
    sDestinedID = "0001"
    Me.TextDestineID.Text = sDestinedID
  Else
    AddDestineID.MoveLast
    i = AddDestineID.Fields("DestineID").Value + 1

    If i < 10 Then
      Me.TextDestineID.Text = "000" & i
    ElseIf i >= 10 & i < 100 Then
      Me.TextDestineID.Text = "00" & i
    End If
        
  End If
    
  AddDestineID.Close
    
  '从数据库中读取数据写入房间编号下拉列表框
  Dim adoRs As New ADODB.Recordset
  DBStr = "select RoomID from RoomInfo where RoomState='空房'"
  adoRs.Open DBStr, g_DBConn, adOpenStatic, adLockReadOnly

  If adoRs.RecordCount > 0 Then
    adoRs.MoveFirst

    Do While Not adoRs.EOF
      CombRoomID.AddItem adoRs.Fields(0).Value
      adoRs.MoveNext
    Loop

  Else
    MsgBox "无空房！"
    Exit Sub
  End If

  adoRs.Close
  Set adoRs = Nothing
    
  '从数据库中读取数据写入会员编号下拉列表框
  Dim adoMs As New ADODB.Recordset
  DBStr = "select MemberID from MemberInfo"
  adoMs.Open DBStr, g_DBConn, adOpenStatic, adLockReadOnly

  If adoMs.RecordCount > 0 Then
    adoMs.MoveFirst
    adoMs.MoveNext

    Do While Not adoMs.EOF
      CombMemID.AddItem adoMs.Fields(0).Value
      adoMs.MoveNext
    Loop

  End If

  adoMs.Close
  Set adoMs = Nothing

End Sub

Private Sub TextCount_KeyPress(KeyAscii As Integer)
  KeyAscii = sffunLimitNumber(KeyAscii)
End Sub

Private Sub TextPrepay_KeyPress(KeyAscii As Integer)
  KeyAscii = sffunLimitNumber(KeyAscii)
End Sub