📄 日期选择.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Begin VB.Form 日期选择
BorderStyle = 1 'Fixed Single
Caption = "日期选择"
ClientHeight = 3660
ClientLeft = 2970
ClientTop = 2595
ClientWidth = 7110
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
Moveable = 0 'False
ScaleHeight = 3660
ScaleWidth = 7110
Begin VB.TextBox Text5
DataField = "车次"
DataSource = "Data1"
Height = 270
Left = 3240
TabIndex = 11
Text = "Text5"
Top = 3360
Visible = 0 'False
Width = 825
End
Begin VB.TextBox Text4
DataField = "班组"
DataSource = "Data1"
Height = 270
Left = 4320
TabIndex = 10
Text = "Text4"
Top = 3360
Visible = 0 'False
Width = 825
End
Begin VB.Frame Frame1
Caption = "行驶方向选择"
Height = 705
Left = 270
TabIndex = 7
Top = 2550
Width = 4125
Begin VB.OptionButton Option2
Caption = "下 行"
Height = 285
Left = 2310
TabIndex = 9
Top = 300
Width = 1005
End
Begin VB.OptionButton Option1
Caption = "上 行"
Height = 255
Left = 660
TabIndex = 8
Top = 300
Width = 975
End
End
Begin VB.CommandButton Command2
Caption = "取 消"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5070
TabIndex = 6
Top = 2370
Width = 1305
End
Begin VB.TextBox Text3
Alignment = 2 'Center
BackColor = &H8000000A&
BorderStyle = 0 'None
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 4740
MultiLine = -1 'True
TabIndex = 5
Text = "日期选择.frx":0000
Top = 240
Width = 1905
End
Begin VB.TextBox Text2
Alignment = 2 'Center
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00008000&
Height = 405
Left = 4650
TabIndex = 4
Top = 1050
Width = 2115
End
Begin MSComCtl2.MonthView MonthView1
Height = 2220
Left = 300
TabIndex = 3
Top = 120
Width = 4065
_ExtentX = 7170
_ExtentY = 3916
_Version = 393216
ForeColor = 0
BackColor = 8421631
Appearance = 1
MonthBackColor = 16777215
StartOfWeek = 49807361
TitleBackColor = 16711680
TitleForeColor = -2147483634
TrailingForeColor= 32768
CurrentDate = 37510
End
Begin VB.CommandButton Command1
Caption = "确 定"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5070
TabIndex = 2
Top = 2880
Width = 1305
End
Begin VB.ComboBox Combo1
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 1410
TabIndex = 1
Top = 1080
Width = 1905
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 360
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "日期车次"
Top = 3300
Visible = 0 'False
Width = 1725
End
Begin VB.TextBox Text1
DataField = "发车日期"
DataSource = "Data1"
Height = 270
Left = 2220
TabIndex = 0
Text = "Text1"
Top = 3360
Visible = 0 'False
Width = 825
End
End
Attribute VB_Name = "日期选择"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim X() As String, Rx As String, Datedata As String
Dim Cxtj1 As String, Cxtj2 As String, Cxs As String, Nx As Integer, Gcc As String, CC As String
Private Sub Form_Activate()
Dim Num As Integer, I As Integer
Data1.DatabaseName = App.Path + "\" + "原始记录.mdb"
MonthView1.Value = Date
Command1.Enabled = False
Frame1.Enabled = True
Cxtj1 = "发车日期": Cxtj2 = "车次"
Option1.Enabled = False
Option2.Enabled = False
Open App.Path + "\" + "Ni.txt" For Input As #1
Input #1, Nx, Gcc
Close #1
If Nx = 1 Then
Frame1.Enabled = False
Else
Frame1.Enabled = True
End If
End Sub
Private Sub Command1_Click()
Open App.Path + "\" + "Date.txt" For Output As #1
Write #1, Datedata
Close #1
Open App.Path + "\" + "Cc.txt" For Output As #1
Write #1, CC
Close #1
If Nx = 1 Then
Nx = 0: Gcc = ""
Open App.Path + "\" + "Ni.txt" For Output As #1
Write #1, Nx, Gcc
Close #1
Unload Me
End If
工作选项.Enabled = True
工作选项.Show
Unload Me
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
Datedata = Format(MonthView1.Value, "yyyy年m月d日")
Text2 = Datedata
Cxs = "[" + Cxtj1 + "]" + "=" + "'" + Text2 + "'"
Data1.RecordSource = "Select * from 日期车次 where" & Cxs
Data1.Refresh
If Text1 = "" Then
MsgBox " 没有 " + Text2 + " 的记录，请重作日期选择 ！ ", vbExclamation, "提示信息"
Option1.Value = False
Option2.Value = False
Command1.Enabled = False
Command2.SetFocus
Text2 = ""
Text2.SetFocus
Exit Sub
Else
If Nx <> 1 Then
Option1.Enabled = True
Option2.Enabled = True
Else
If Text5 <> Gcc Then
MsgBox " 请选择上行的起始日期 ！ ", vbExclamation, "提示信息"
End If
End If
Command1.Enabled = True
Command1.SetFocus
End If
End Sub
Private Sub Option1_Click()
Close #1
CC = "238"
Cxs = "[" + Cxtj1 + "]" + "=" + "'" + Datedata + "'" + "And" + "[" + Cxtj2 + "]" + "=" + "'" + CC + "'"
Data1.RecordSource = "Select * from 日期车次 where" & Cxs
Data1.Refresh
If Text1 = "" Then
MsgBox " 没有 " + Text2 + "上行方向的记录，请重新选择日期或行驶方向 ！ ", vbExclamation, "提示信息"
Option1.Value = False
Command1.Enabled = False
Command2.SetFocus
Exit Sub
Else
Command1.Enabled = True
Command1.SetFocus
End If
End Sub
Private Sub Option2_Click()
CC = "237"
Cxs = "[" + Cxtj1 + "]" + "=" + "'" + Datedata + "'" + "And" + "[" + Cxtj2 + "]" + "=" + "'" + CC + "'"
Data1.RecordSource = "Select * from 日期车次 where" & Cxs
Data1.Refresh
If Text1 = "" Then
MsgBox " 没有 " + Text2 + "下行方向的记录，请重新选择日期或行驶方向 ！ ", vbExclamation, "提示信息"
Option2.Value = False
Command1.Enabled = False
Command2.SetFocus
Exit Sub
Else
Close #1
Command1.Enabled = True
Command1.SetFocus
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -