📄 发车日期.frm

📁 一个客车售票系统
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
Close #1
         Open App.Path + "\" + "Dd.txt" For Output As #1
            Write #1, Rx1
         Close #1
         Open App.Path + "\" + "Bz.txt" For Output As #1
            Write #1, T7
         Close #1
         Open App.Path + "\" + "Cc.txt" For Output As #1
           Write #1, "238"
         Close #1
Unload Me
数据录入.Show
End Sub
Private Sub Option1_Click()
T7 = "第一组"
 Cxs = "[" + Cxtj1 + "]" + "=" + "'" + Rx2 + "'" + _
 "And" + "[" + Cxtj2 + "]" + "=" + "'" + T7 + "'" + _
  "And" + "[" + Cxtj3 + "]" + "=" + "'" + CC + "'"
 Data1.RecordSource = "Select * from 日期车次 where" & Cxs
 Data1.Refresh
' If Text1 <> Rx2 And Text2 <> T7 And Text3 <> CC Then
  Result = MsgBox("     您选择的班组是第一组，是否正确 ？ " + Chr$(13) + "点击取消按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
        If Result = 1 Then
          Command4.Enabled = True
          Else
          Option1.Value = False
        End If
'   Else
'  Result = MsgBox("     " & T7 & " 还没有返回，请重择其他班组 ？ " + Chr$(13) + "点击确定按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
'        If Result = 1 Then
'          Option1.Value = False
'          Else
'          Unload Me
'        End If
'End If
End Sub
Private Sub Option2_Click()
T7 = "第二组"

 Cxs = "[" + Cxtj1 + "]" + "=" + "'" + Rx2 + "'" + _
 "And" + "[" + Cxtj2 + "]" + "=" + "'" + T7 + "'" + _
  "And" + "[" + Cxtj3 + "]" + "=" + "'" + CC + "'"
 Data1.RecordSource = "Select * from 日期车次 where" & Cxs
 Data1.Refresh
 If Text1 <> Rx2 And Text2 <> T7 And Text3 <> CC Then
  Result = MsgBox("     您选择的班组是第二组，是否正确 ？ " + Chr$(13) + "点击取消按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
        If Result = 1 Then
          Command4.Enabled = True
          Else
          Option1.Value = False
        End If
   Else
  Result = MsgBox("     " & T7 & " 还没有返回，请重择其他班组 ？ " + Chr$(13) + "点击确定按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
        If Result = 1 Then
'          Command4.Enabled = True
'          Else
          Option2.Value = False
          Else
          Unload Me
        End If
End If

'  Result = MsgBox("     您选择的班组是第组，是否正确 ？ " + Chr$(13) + "点击取消按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
'        If Result = 1 Then
'          Command4.Enabled = True
'          Else
'          Option2.Value = False
'        End If
End Sub
Private Sub Option3_Click()
T7 = "第三组"
Debug.Print Rx1, Rx2, T7, CC
 Cxs = "[" + Cxtj1 + "]" + "=" + "'" + Rx2 + "'" + _
 "And" + "[" + Cxtj2 + "]" + "=" + "'" + T7 + "'" + _
  "And" + "[" + Cxtj3 + "]" + "=" + "'" + CC + "'"
 Data1.RecordSource = "Select * from 日期车次 where" & Cxs
 Data1.Refresh
 If Text1 <> Rx2 And Text2 <> T7 And Text3 <> CC Then
  Result = MsgBox("     您选择的班组是第三组，是否正确 ？ " + Chr$(13) + "点击取消按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
        If Result = 1 Then
          Command4.Enabled = True
          Else
          Option1.Value = False
        End If
   Else
  Result = MsgBox("     " & T7 & " 还没有返回，请重择其他班组 ？ " + Chr$(13) + "点击确定按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
        If Result = 1 Then
          Option3.Value = False
          Else
          Unload Me
        End If
End If
End Sub
Private Sub Option4_Click()
T7 = "第四组"
 Cxs = "[" + Cxtj1 + "]" + "=" + "'" + Rx2 + "'" + _
 "And" + "[" + Cxtj2 + "]" + "=" + "'" + T7 + "'" + _
  "And" + "[" + Cxtj3 + "]" + "=" + "'" + CC + "'"
 Data1.RecordSource = "Select * from 日期车次 where" & Cxs
 Data1.Refresh
 If Text1 <> Rx1 And Text2 <> T7 And Text3 <> CC Then
  Result = MsgBox("     您选择的班组是第四组，是否正确 ？ " + Chr$(13) + "点击取消按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
        If Result = 1 Then
          Command4.Enabled = True
          Else
          Option1.Value = False
        End If
   Else
  Result = MsgBox("     " & T7 & " 还没有返回，请重择其他班组 ？ " + Chr$(13) + "点击确定按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
        If Result = 1 Then
'          Command4.Enabled = True
'          Else
          Option4.Value = False
          Else
          Unload Me
        End If
End If

'  Result = MsgBox("     您选择的班组是第四组，是否正确 ？ " + Chr$(13) + "点击取消按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
'        If Result = 1 Then
'          Command4.Enabled = True
'          Else
'          Option4.Value = False
'        End If
End Sub
Private Sub Option5_Click()
T7 = "第五组"

 Cxs = "[" + Cxtj1 + "]" + "=" + "'" + Rx2 + "'" + _
 "And" + "[" + Cxtj2 + "]" + "=" + "'" + T7 + "'" + _
  "And" + "[" + Cxtj3 + "]" + "=" + "'" + CC + "'"
 Data1.RecordSource = "Select * from 日期车次 where" & Cxs
 Data1.Refresh
 If Text1 <> Rx1 And Text2 <> T7 And Text3 <> CC Then
  Result = MsgBox("     您选择的班组是第五组，是否正确 ？ " + Chr$(13) + "点击取消按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
        If Result = 1 Then
          Command4.Enabled = True
          Else
          Option1.Value = False
        End If
   Else
  Result = MsgBox("     " & T7 & " 还没有返回，请重择其他班组 ？ " + Chr$(13) + "点击确定按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
        If Result = 1 Then
'          Command4.Enabled = True
'          Else
          Option5.Value = False
          Else
          Unload Me
        End If
End If

End Sub
Private Sub Option6_Click()
T7 = "第六组"

 Cxs = "[" + Cxtj1 + "]" + "=" + "'" + Rx2 + "'" + _
 "And" + "[" + Cxtj2 + "]" + "=" + "'" + T7 + "'" + _
  "And" + "[" + Cxtj3 + "]" + "=" + "'" + CC + "'"
 Data1.RecordSource = "Select * from 日期车次 where" & Cxs
 Data1.Refresh
 If Text1 <> Rx1 And Text2 <> T7 And Text3 <> CC Then
  Result = MsgBox("     您选择的班组是第六组，是否正确 ？ " + Chr$(13) + "点击取消按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
        If Result = 1 Then
          Command4.Enabled = True
          Else
          Option1.Value = False
        End If
   Else
  Result = MsgBox("     " & T7 & " 还没有返回，请重择其他班组 ？ " + Chr$(13) + "点击确定按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
        If Result = 1 Then
'          Command4.Enabled = True
'          Else
          Option6.Value = False
          Else
          Unload Me
        End If
End If
End Sub
Private Sub Option7_Click()
T7 = "第七组"

 Cxs = "[" + Cxtj1 + "]" + "=" + "'" + Rx2 + "'" + _
 "And" + "[" + Cxtj2 + "]" + "=" + "'" + T7 + "'" + _
  "And" + "[" + Cxtj3 + "]" + "=" + "'" + CC + "'"
 Data1.RecordSource = "Select * from 日期车次 where" & Cxs
 Data1.Refresh
 If Text1 <> Rx1 And Text2 <> T7 And Text3 <> CC Then
  Result = MsgBox("     您选择的班组是第七组，是否正确 ？ " + Chr$(13) + "点击取消按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
        If Result = 1 Then
          Command4.Enabled = True
          Else
          Option7.Value = False
        End If
   Else
  Result = MsgBox("     " & T7 & " 还没有返回，请重择其他班组 ？ " + Chr$(13) + "点击确定按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
        If Result = 1 Then
'          Command4.Enabled = True
'          Else
          Option7.Value = False
          Else
          Unload Me
        End If
End If
End Sub
Private Sub Option8_Click()
T7 = "第八组"
 Cxs = "[" + Cxtj1 + "]" + "=" + "'" + Rx1 + "'" + _
 "And" + "[" + Cxtj2 + "]" + "=" + "'" + T7 + "'" + _
  "And" + "[" + Cxtj3 + "]" + "=" + "'" + CC + "'"
 Data1.RecordSource = "Select * from 日期车次 where" & Cxs
 Data1.Refresh
 If Text1 <> Rx1 And Text2 <> T7 And Text3 <> CC Then
  Result = MsgBox("     您选择的班组是第八组，是否正确 ？ " + Chr$(13) + "点击取消按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
        If Result = 1 Then
         Command4.Enabled = True
          Else
          Option8.Value = False
        End If
   Else
    If Falg <> 1 Then
         Result = MsgBox("    点击确定按钮重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
        If Result = 1 Then
'          Command4.Enabled = True
'          Else
          Option8.Value = False
          Else
          Unload Me
        End If
      Else
        Result = MsgBox("     是否更新" & T7 & " 记录  ？ " + Chr$(13) + "点击取消按钮可以重新选择班组    ！    ", vbQuestion + vbOKCancel, "提示信息")
         If Result = 1 Then
          Command4.Enabled = True
           Else
          Option8.Enabled = True
          Option8.Value = False
         End If
    End If
End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
         If IsNumeric(Text4) = False Or Val(Text4) < 2002 Then
          MsgBox "不能输入符号或小于 2002 的数据，请重新输入数据 ！  ", vbExclamation + vbOKOnly, "提示信息"
          Text4 = ""
          Text4.SetFocus
         Else
    Text5.BackColor = &H80000005
    Text5.SetFocus
    Text5 = ""
 End If
End If
End Sub

Private Sub Text5_Click()
    Text5.BackColor = &H80000005
    Text5 = ""
End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
         If IsNumeric(Text5) = False Or Val(Text5) > 12 Then
          MsgBox "不能输入符号或大于 12 的数据，请重新输入数据 ！  ", vbExclamation + vbOKOnly, "提示信息"
          Text5 = ""
          Text5.SetFocus
         Else
    Text6.BackColor = &H80000005
    Text6.SetFocus
    Text6 = ""
 End If
End If
End Sub
Private Sub Text6_Click()
    Text6.BackColor = &H80000005
    Text6 = ""
End Sub
Private Sub Text6_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
      If Leap(Text4) = True And Text5 = 2 And (IsNumeric(Text6) = False Or Val(Text6) > 29) Then
          MsgBox "不能输入符号或大于 29 的日期，请重新输入日期 ！  ", vbExclamation + vbOKOnly, "提示信息"
          Text6 = ""
          Text6.SetFocus
      End If
      If Leap(Text4) = False And Text5 = 2 And (IsNumeric(Text6) = False Or Val(Text6) > 28) Then
          MsgBox "不能输入符号或大于 28 的日期，请重新输入日期 ！  ", vbExclamation + vbOKOnly, "提示信息"
          Text6 = ""
          Text6.SetFocus
      End If
Select Case Val(Text5)
   Case 4, 6, 9, 11
         If (IsNumeric(Text6) = False Or Val(Text6) > 30) Then
          MsgBox "不能输入符号或大于 30 的日期，请重新输入日期 ！  ", vbExclamation + vbOKOnly, "提示信息"
          Text6 = ""
          Text6.SetFocus
      End If
End Select
Select Case Val(Text5)
   Case 1, 3, 5, 7, 8, 10, 11
         If (IsNumeric(Text6) = False Or Val(Text6) > 31) Then
          MsgBox "不能输入符号或大于 31 的日期，请重新输入日期 ！  ", vbExclamation + vbOKOnly, "提示信息"
          Text6 = ""
          Text6.SetFocus
      End If
      VScroll3.Value = Val(Text6)
End Select
End If
Rx1 = Text4 + "年" + Text5 + "月" + Text6 + "日"
End Sub
Private Sub VScroll1_Change()
Text4 = VScroll1.Value
Rx1 = Text4 + "年" + Text5 + "月" + Text6 + "日"
Rx2 = Format(CDate(Rx1) - 3, "yyyy年m月d日")
End Sub
Private Sub VScroll2_Change()
Text5.BackColor = &H80000005
Text5 = CStr(VScroll2.Value)
VScroll3.Min = 31
If Leap(Text4) = True And Val(Text5) = 2 And (Val(Text6) = 30 Or Val(Text6) = 31) Then Text6 = 29
If Leap(Text4) = False And Val(Text5) = 2 And (Val(Text6) = 30 Or Val(Text6) = 31) Then Text6 = 28
Select Case Val(Text5)
   Case 4, 6, 9, 11
   If Val(Text6) = 31 Then
      Text6 = 30
   End If
      VScroll3.Min = 30
End Select
Rx1 = Text4 + "年" + Text5 + "月" + Text6 + "日"
Rx2 = Format(CDate(Rx1) - 3, "yyyy年m月d日")
End Sub
Private Sub VScroll3_Change()
Text6.BackColor = &H80000005
    If Leap(Text4) = True And Val(Text5) = 2 Then VScroll3.Min = 29
    If Leap(Text4) = False And Val(Text5) = 2 Then VScroll3.Min = 28
Text6 = VScroll3.Value
Rx1 = Text4 + "年" + Text5 + "月" + Text6 + "日"
Rx2 = Format(CDate(Rx1) - 3, "yyyy年m月d日")
End Sub
Private Function Leap(ByVal Year As Integer) As Boolean
    If ((Year Mod 4 = 0 And Year Mod 400 <> 0) Or (Year Mod 100 = 0)) Then
     Leap = True
         Else
     Leap = False
    End If
End Function
Private Sub X1()
       Frame2.Enabled = False
       Option1.Enabled = False: Option2.Enabled = False: Option3.Enabled = False: Option4.Enabled = False
       Option5.Enabled = False: Option6.Enabled = False: Option7.Enabled = False: Option8.Enabled = False
End Sub
Private Sub X2()
        Frame2.Enabled = True
        Option1.Enabled = True: Option2.Enabled = True: Option3.Enabled = True: Option4.Enabled = True
        Option5.Enabled = True: Option6.Enabled = True: Option7.Enabled = True: Option8.Enabled = True
End Sub
Private Sub Timer1_Timer()
    Chc Label1, 12, 9, 12
End Sub
上一页 12
💿 文件大小 1252 K
👤 上传用户 zzxt
📂 所属分类压缩解压
🏷️ 相关标签

#售票系统
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -