frmtime.frm

星级酒店管理系统（附带系统自写控件源码）

      X2              =   5355
      Y1              =   2715
      Y2              =   2715
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "结束时间："
      Height          =   210
      Index           =   5
      Left            =   750
      TabIndex        =   14
      Top             =   2235
      Width           =   1050
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "结束时间："
      Height          =   210
      Index           =   4
      Left            =   750
      TabIndex        =   13
      Top             =   1515
      Width           =   1050
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "结束时间："
      Height          =   210
      Index           =   3
      Left            =   750
      TabIndex        =   12
      Top             =   780
      Width           =   1050
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "晚上开始时间："
      ForeColor       =   &H8000000D&
      Height          =   210
      Index           =   2
      Left            =   330
      TabIndex        =   11
      Top             =   1875
      Width           =   1470
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "下午开始时间："
      ForeColor       =   &H8000000D&
      Height          =   210
      Index           =   1
      Left            =   330
      TabIndex        =   10
      Top             =   1140
      Width           =   1470
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "中午开始时间："
      ForeColor       =   &H8000000D&
      Height          =   210
      Index           =   0
      Left            =   330
      TabIndex        =   9
      Top             =   420
      Width           =   1470
   End
End
Attribute VB_Name = "frmTime"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdCancel_Click()

  SaveFormSet Me
 '放弃修改，关闭返回
  Unload Me
  
End Sub

Private Sub cmdDefault_Click()

 '给出缺省值
  ftLunch1.Text = "10"
  ftLunch2.Text = "14"
  ftSupper1.Text = "14"
  ftSupper2.Text = "18"
  ftNight1.Text = "18"
  ftNight2.Text = "23"
  
End Sub

Private Sub cmdSave_Click()

   On Error GoTo CheckErr
   
  '检测各时间段时否正常，否则提示修改
   If CCur(ftLunch1.Text) > CCur(ftLunch2.Text) Then
      MsgBox "中午的结束时间小于开始时间？", vbInformation
      ftLunch2.SetFocus
      Exit Sub
   End If
   If CCur(ftSupper1.Text) > CCur(ftSupper2.Text) Then
      MsgBox "下午的结束时间小于开始时间？", vbInformation
      ftSupper2.SetFocus
      Exit Sub
   End If
   If CCur(ftNight1.Text) > CCur(ftNight2.Text) Then
      MsgBox "晚上的结束时间小于开始时间？", vbInformation
      ftNight2.SetFocus
      Exit Sub
   End If
   
  '开始保存记录
   Dim fIni As RegClass
   Set fIni = New RegClass
       fIni.WriteINIString "DatePart", "Lunch1", ftLunch1.Text, SystemConfigFile
       fIni.WriteINIString "DatePart", "Lunch2", ftLunch2.Text, SystemConfigFile
       fIni.WriteINIString "DatePart", "Supper1", ftSupper1.Text, SystemConfigFile
       fIni.WriteINIString "DatePart", "Supper2", ftSupper2.Text, SystemConfigFile
       fIni.WriteINIString "DatePart", "Night1", ftNight1.Text, SystemConfigFile
       fIni.WriteINIString "DatePart", "Night2", ftNight2.Text, SystemConfigFile
   Set fIni = Nothing
   
  '立即更新时间段
   Lunch1 = CCur(ftLunch1.Text)
   Lunch2 = CCur(ftLunch2.Text)
   Supper1 = CCur(ftSupper1.Text)
   Supper2 = CCur(ftSupper2.Text)
   Night1 = CCur(ftNight1.Text)
   NIght2 = CCur(ftNight2.Text)
   
   Unload Me
   
   Exit Sub
CheckErr:
   MsgBox "对不起，保存时间段设置错误:" & Err.Description, vbCritical
   
End Sub

Private Sub Form_Load()

  On Error Resume Next
  
  GetFormSet Me, Screen
  
 '给出原来的配置
  ftLunch1.Text = Lunch1
  ftLunch2.Text = Lunch2
  ftSupper1.Text = Supper1
  ftSupper2.Text = Supper2
  ftNight1.Text = Night1
  ftNight2.Text = NIght2
     
End Sub

Private Sub ftLunch1_Change()

  On Error Resume Next
  
  If ftLunch1.Text = "" Then
     ftLunch1.Text = "0"
     ftLunch1.SelStart = 0
     ftLunch1.SelLength = 1
  End If
  If CCur(ftLunch1.Text) > 23 Then
     MsgBox "时间段为 0-23 点之间？  ", vbInformation
     ftLunch1.Text = "23"
     Exit Sub
  End If
  
End Sub

Private Sub ftLunch2_Change()
  
  On Error Resume Next
  
  If ftLunch2.Text = "" Then
     ftLunch2.Text = "0"
     ftLunch2.SelStart = 0
     ftLunch2.SelLength = 1
  End If
  
 '某一段结束为下一段的开始
  ftSupper1.Text = ftLunch2.Text
  
  If CCur(ftLunch2.Text) > 23 Then
     MsgBox "时间段为 0-23 点之间？  ", vbInformation
     ftLunch2.Text = "23"
     Exit Sub
  End If
  
End Sub

Private Sub ftNight1_Change()

  On Error Resume Next
  
  If ftNight1.Text = "" Then
     ftNight1.Text = "0"
     ftNight1.SelStart = 0
     ftNight1.SelLength = 1
  End If
  
  ftSupper2.Text = ftNight1.Text
  
  If CCur(ftNight1.Text) > 23 Then
     MsgBox "时间段为 0-23 点之间？  ", vbInformation
     ftNight1.Text = "23"
     Exit Sub
  End If

End Sub

Private Sub ftNight2_Change()

  On Error Resume Next
  
  If ftNight2.Text = "" Then
     ftNight2.Text = "0"
     ftNight2.SelStart = 0
     ftNight2.SelLength = 1
  End If
  If CCur(ftNight2.Text) > 23 Then
     MsgBox "时间段为 0-23 点之间？  ", vbInformation
     ftNight2.Text = "23"
     Exit Sub
  End If

End Sub

Private Sub ftSupper1_Change()

  On Error Resume Next
  
  If ftSupper1.Text = "" Then
     ftSupper1.Text = "0"
     ftSupper1.SelStart = 0
     ftSupper1.SelLength = 1
  End If
  
  ftLunch2.Text = ftSupper1.Text
  
  If CCur(ftSupper1.Text) > 23 Then
     MsgBox "时间段为 0-23 点之间？  ", vbInformation
     ftSupper1.Text = "23"
     Exit Sub
  End If

End Sub

Private Sub ftSupper2_Change()

  On Error Resume Next
  
  If ftSupper2.Text = "" Then
     ftSupper2.Text = "0"
     ftSupper2.SelStart = 0
     ftSupper2.SelLength = 1
  End If
  
  ftNight1.Text = ftSupper2.Text
  
  If CCur(ftSupper2.Text) > 23 Then
     MsgBox "时间段为 0-23 点之间？  ", vbInformation
     ftSupper2.Text = "23"
     Exit Sub
  End If

End Sub