📄 selfrm1.frm
字号:
VERSION 5.00
Object = "{FE0065C0-1B7B-11CF-9D53-00AA003C9CB6}#1.1#0"; "COMCT232.OCX"
Begin VB.Form selfrm1
Caption = "历史曲线选择"
ClientHeight = 3120
ClientLeft = 2700
ClientTop = 2430
ClientWidth = 4185
ControlBox = 0 'False
LinkTopic = "Form1"
ScaleHeight = 3120
ScaleWidth = 4185
Begin VB.Frame Frame1
Caption = "日期:"
BeginProperty Font
Name = "System"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2550
Left = 210
TabIndex = 2
Top = 210
Width = 1650
Begin VB.TextBox Textrq
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Index = 2
Left = 480
TabIndex = 10
Text = "1"
Top = 1920
Width = 550
End
Begin ComCtl2.UpDown UpDown1
Height = 360
Index = 0
Left = 1000
TabIndex = 8
Top = 435
Width = 270
_ExtentX = 476
_ExtentY = 635
_Version = 327681
Enabled = -1 'True
End
Begin VB.TextBox Textrq
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Index = 1
Left = 480
TabIndex = 4
Text = "1"
Top = 1177
Width = 550
End
Begin VB.TextBox Textrq
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Index = 0
Left = 480
TabIndex = 3
Text = "1999"
Top = 435
Width = 550
End
Begin ComCtl2.UpDown UpDown1
Height = 360
Index = 1
Left = 1000
TabIndex = 9
Top = 1177
Width = 270
_ExtentX = 476
_ExtentY = 635
_Version = 327681
Enabled = -1 'True
End
Begin ComCtl2.UpDown UpDown1
Height = 360
Index = 2
Left = 1000
TabIndex = 11
Top = 1920
Width = 270
_ExtentX = 476
_ExtentY = 635
_Version = 327681
Enabled = -1 'True
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
Caption = "日:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 105
TabIndex = 7
Top = 1995
Width = 375
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "月:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 105
TabIndex = 6
Top = 1252
Width = 375
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "年:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 90
TabIndex = 5
Top = 510
Width = 375
End
End
Begin VB.CommandButton Comlsjlexit
Caption = "取消(&X)"
BeginProperty Font
Name = "System"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2310
TabIndex = 1
Top = 1785
Width = 1200
End
Begin VB.CommandButton Comlsjlok
Caption = "确认(&O)"
Default = -1 'True
BeginProperty Font
Name = "System"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2310
TabIndex = 0
Top = 630
Width = 1215
End
End
Attribute VB_Name = "selfrm1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Comlsjlexit_Click()
Unload Me
End Sub
Private Sub Comlsjlok_Click()
'--------------------
nia$ = Mid$(Textrq(0), 3, 2) '生成数据文件名
yu$ = Format$(Val(Textrq(1)), "00")
rii$ = Format$(Val(Textrq(2)), "00")
date1$ = DateAdd("d", 1, DateSerial(nia$, yu$, rii$))
date1$ = Format$(date1$, "yyyy/mm/dd")
filena3 = datadir + "\" + "y" + Mid$(date1$, 3, 2) + Mid$(date1$, 6, 2) + "\" '下一天文件名
filena3 = filena3 + shiydwjc + Mid$(date1$, 3, 2) + Mid$(date1$, 6, 2) + Mid$(date1, 9, 2) + ".dat"
FileName1$ = datadir + "\" + "y" + nia$ + yu$ + "\" + shiydwjc + nia$ + yu$
filena1 = FileName1$ + rii$ + ".dat" '当天文件名
'==============================检查文件存在否------
Select Case frmselec
Case 5 '回路状态
If Dir$(filena1) = "" Then '当天
aaa$ = "日期输入错误或 " + nia$ + "-" + yu$ + "-" + rii$ + "记录不存在,!"
rel = MsgBox(aaa$, 1, SysTitle)
Exit Sub
End If
datetime = Textrq(0) + "-" + yu$ + "-" + rii$ '为曲线窗口提供日期，时间
FrmState.Show
Case 6 '日报表
If Dir$(filena1) = "" Or Dir$(filena1) = "" Then '当天
aaa$ = "日期输入错误或 " + nia$ + "/" + yu$ + "/" + rii$ + " 日数据不全!"
rel = MsgBox(aaa$, 1, SysTitle)
Exit Sub
End If
datetime = nia$ & "年" & yu$ & "月" & rii$ & "日" '为曲线窗口提供日期，时间
FrmDatall.Show
Case 7 '报警
datetime = Textrq(0) & "-" & Textrq(1) & "-" & Textrq(2)
filena1 = datadir & "\" & "y" & nia$ & yu$ & "\baoj.dat"
If Dir$(filena1) = "" Then '当天
aaa$ = "日期输入错误或 " + "无报警记录!"
rel = MsgBox(aaa$, 1, SysTitle)
Exit Sub
End If
baojfrm.Show
Unload Me
Exit Sub
Case 8 '月报表
datetime = Textrq(0) & "年" & yu$ & "月"
filena3 = FileName1$
rii$ = "01"
yu12$ = yu$
Do While yu12$ = yu$
i% = i% + 1
date1$ = DateAdd("d", 1, DateSerial(nia$, yu$, rii$)) '以日("d")为单位
dat1$ = Format$(date1$, "yyyy/mm/dd")
nia$ = Mid$(dat1$, 3, 2)
yu$ = Mid$(dat1$, 6, 2)
rii$ = Mid$(dat1$, 9, 2)
Loop
FileName1$ = datadir + "\" + "y" + nia$ + yu$ + "\" + shiydwjc + nia$ + yu$
filena1 = FileName1$ + rii$ + ".dat" '当天文件名
nyr = i%
lssjfrm21.Show
End Select
End Sub
Private Sub Form_Load()
Me.Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
Textrq(0).Text = Mid$(Date$, 1, 4)
Textrq(1).Text = Mid$(Date$, 6, 2)
Textrq(2).Text = Mid$(Date$, 9, 2)
'------------------------------------
If frmselec <> 5 Then
' UpDown1_UpClick (2)
End If
'------------------------
Select Case frmselec
Case 5
Me.Caption = "回路状态选项"
Case 6 '日开停状态
Me.Caption = "历史数据时间选择"
Case 7 '日开停状态
Me.Caption = "报警时间选择"
'Textrq(2).Enabled = False
'UpDown1(2).Enabled = False
'Label3.Enabled = False
End Select
End Sub
Private Sub Textlsri_GotFocus()
'On Error Resume Next
Textlsri.SelStart = 0
Textlsri.SelLength = Len(Textlsri.Text)
End Sub
Private Sub Textlsri_LostFocus()
'On Error Resume Next
If Val(Textlsri.Text) < 1 Or Val(Textlsri.Text) > 31 Then
MsgBox "日输入错误!"
Textlsri.SetFocus
End If
End Sub
Private Sub Textlsyue_LostFocus()
'On Error Resume Next
If Val(Textlsyue.Text) > 12 Or Val(Textlsyue.Text) < 1 Then
MsgBox "月份输入错误!"
Textlsyue.SetFocus
End If
End Sub
Private Sub Textrq_GotFocus(Index As Integer)
'On Error Resume Next
Textrq(Index).SelStart = 0
Textrq(Index).SelLength = Len(Textrq(Index).Text)
End Sub
Private Sub UpDown1_DownClick(Index As Integer)
'On Error Resume Next
nian1$ = Trim$(Textrq(0).Text)
yue1$ = Trim$(Textrq(1).Text)
ri1$ = Trim$(Textrq(2).Text)
Select Case Index
Case 0
date1$ = DateAdd("yyyy", -1, DateSerial(nian1$, yue1$, ri1$)) '以 年("yyyy")为单位
date1$ = Format$(date1$, "yyyy/mm/dd") '计算下一天的日期
Case 1
date1$ = DateAdd("m", -1, DateSerial(nian1$, yue1$, ri1$)) '以年("yyyy")为单位
date1$ = Format$(date1$, "yyyy/mm/dd") '计算下一天的日期
Case 2
date1$ = DateAdd("d", -1, DateSerial(nian1$, yue1$, ri1$)) '以日("d")为单位
date1$ = Format$(date1$, "yyyy/mm/dd") '计算下一天的日期
Case 3
End Select
Textrq(0) = Mid$(date1$, 1, 4)
Textrq(1) = Mid$(date1$, 6, 2)
Textrq(2) = Mid$(date1$, 9, 2)
End Sub
Private Sub UpDown1_UpClick(Index As Integer)
'On Error Resume Next
nian1$ = Trim$(Textrq(0).Text)
yue1$ = Trim$(Textrq(1).Text)
ri1$ = Trim$(Textrq(2).Text)
Select Case Index
Case 0
date1$ = DateAdd("yyyy", 1, DateSerial(nian1$, yue1$, ri1$)) '以 年("yyyy")为单位
date1$ = Format$(date1$, "yyyy/mm/dd") '计算下一天的日期
Case 1
date1$ = DateAdd("m", 1, DateSerial(nian1$, yue1$, ri1$)) '以年("yyyy")为单位
date1$ = Format$(date1$, "yyyy/mm/dd") '计算下一天的日期
Case 2
date1$ = DateAdd("d", 1, DateSerial(nian1$, yue1$, ri1$)) '以日("d")为单位
date1$ = Format$(date1$, "yyyy/mm/dd") '计算下一天的日期
End Select
If date1$ > Date$ Then Exit Sub
Textrq(0) = Mid$(date1$, 1, 4)
Textrq(1) = Mid$(date1$, 6, 2)
Textrq(2) = Mid$(date1$, 9, 2)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -