📄 formqxls.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form FormQxls
BorderStyle = 3 'Fixed Dialog
Caption = "日曲线:"
ClientHeight = 6375
ClientLeft = 390
ClientTop = 1560
ClientWidth = 11085
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6375
ScaleWidth = 11085
ShowInTaskbar = 0 'False
Begin VB.PictureBox Picture3
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 375
Left = 120
ScaleHeight = 345
ScaleWidth = 945
TabIndex = 17
Top = 0
Visible = 0 'False
Width = 975
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
Height = 1635
Left = 210
TabIndex = 2
Top = 4560
Width = 8595
_ExtentX = 15161
_ExtentY = 2884
_Version = 393216
Rows = 9
BackColor = -2147483648
GridLines = 2
ScrollBars = 0
Appearance = 0
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
BackColor = &H80000005&
Height = 4290
Left = 240
ScaleHeight = 4230
ScaleWidth = 10575
TabIndex = 0
Top = 105
Width = 10635
Begin VB.Timer Timer1
Interval = 2000
Left = 2160
Top = 3120
End
Begin VB.PictureBox Picture2
Height = 2280
Left = 3000
ScaleHeight = 2220
ScaleWidth = 3600
TabIndex = 3
Top = 840
Visible = 0 'False
Width = 3660
Begin VB.CommandButton Command5
Caption = "取消"
Height = 350
Left = 1995
TabIndex = 16
Top = 1680
Width = 960
End
Begin VB.CommandButton Command4
Caption = "确定"
Height = 350
Left = 600
TabIndex = 15
Top = 1680
Width = 960
End
Begin VB.TextBox Textzb
Height = 330
Index = 3
Left = 2400
TabIndex = 14
Text = "24"
Top = 1245
Width = 855
End
Begin VB.TextBox Textzb
Height = 330
Index = 2
Left = 2400
TabIndex = 12
Text = "0"
Top = 825
Width = 855
End
Begin VB.TextBox Textzb
Height = 330
Index = 1
Left = 510
TabIndex = 9
Text = "100"
Top = 1245
Width = 855
End
Begin VB.TextBox Textzb
Height = 330
Index = 0
Left = 510
TabIndex = 7
Text = "0"
Top = 825
Width = 855
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "至"
Height = 180
Index = 6
Left = 2085
TabIndex = 13
Top = 1320
Width = 180
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "从"
Height = 180
Index = 5
Left = 2085
TabIndex = 11
Top = 900
Width = 180
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "时间范围"
ForeColor = &H8000000D&
Height = 180
Index = 4
Left = 2295
TabIndex = 10
Top = 510
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "至"
Height = 180
Index = 3
Left = 195
TabIndex = 8
Top = 1320
Width = 180
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "从"
Height = 180
Index = 2
Left = 195
TabIndex = 6
Top = 900
Width = 180
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "数值范围"
ForeColor = &H8000000D&
Height = 180
Index = 1
Left = 510
TabIndex = 5
Top = 510
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "曲线显示范围"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 285
Index = 0
Left = 1050
TabIndex = 4
Top = 105
Width = 1710
End
End
Begin VB.Label lablexy
AutoSize = -1 'True
Caption = "Label1"
Height = 180
Left = 1560
TabIndex = 1
Top = 600
Visible = 0 'False
Width = 540
End
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 9600
Top = 4920
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Menu exit1
Caption = "关闭(&X)"
End
Begin VB.Menu xuanx
Caption = "选项(&O)"
End
Begin VB.Menu xsfw1
Caption = "显示范围(&D)"
End
Begin VB.Menu prinview
Caption = "打印预览(&V)"
End
Begin VB.Menu print10
Caption = "打印(&P)"
Begin VB.Menu printset
Caption = "打印设置"
End
Begin VB.Menu printqx1
Caption = "打印"
End
End
End
Attribute VB_Name = "FormQxls"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim pvtt(9, 1440), couni
Dim blxuhao1(10)
Dim zbx1, zbx2, stx As Integer
Dim zby2, zby1, sty As Single
Dim MaxY, MinY
Dim qxtitle
Dim gConn As New ADODB.Connection '定义一个新的数据库连接,建立到数据源的连接
Dim rs As New ADODB.Recordset
Public Sub hzbx1()
''''On Error Resume Next
sty = Format((zby2 - zby1) / 10, "000.0")
If zbx2 - zbx1 = 12 Then
stx = 12
Else
stx = (zbx2 - zbx1) \ 24
End If
Picture1.Cls
' Picture1.ForeColor = &H80000008
Picture1.Scale (-stx * 2 + zbx1, zby1 - sty)-(zbx2 + stx * 1, zby2 + sty) '设定标尺
'---------------------------------------------------------------------------------
For p = zby1 To zby2 + sty / 10 Step sty
Picture1.Line (zbx1, p)-(zbx2, p), &HE0E0E0 '画横坐标线
Picture1.PSet (zbx1 - 1.3 * stx, p - sty / 6), &HFFFFFF
' If zby2 > 100 Then
' Picture1.Print Format$(zby2 + zby1 - p, "#000") '纵坐标
' Else
' Picture1.Print Format$(zby2 + zby1 - p, "#0.0#") '纵坐标
' Int(beishu(num1%) * (zby2 + zby1 - Y)) / beishu(num1%)
' End If
If blxuhao1(1) = 99 Then
Picture1.Print Int(beishu(blxuhao1(0)) * (zby2 + zby1 - p)) / beishu(blxuhao1(0)) '纵坐标
Else
Picture1.Print Format$(zby2 + zby1 - p, "#0.0#") '纵坐标
End If
Next p
Picture1.PSet (zbx1, zby1 - sty * 3 / 4), &HFFFFFF
aa% = Weekday(filena1)
' Label4.Caption = week1(aa%)
Picture1.Print filena1 & " " & Week1(aa%)
'================================
For q% = zbx1 To zbx2 Step stx
Picture1.Line (q%, zby1)-(q%, zby2), &HE0E0E0 '纵坐标线
Next q%
For q% = zbx1 To zbx2 Step stx * 4
Picture1.Line (q%, zby1)-(q%, zby2), &HC0C0C0
a1% = q% \ (60 / DataJg) ' 12
a2% = (q% - a1% * (60 / DataJg)) * DataJg
Picture1.PSet (q% - 0.5 * stx, zby2 + sty / 5), &HFFFFFF '横坐标值位置
Picture1.Print Format$(a1%, "00") + ":" + Format$(a2%, "00")
Next q% 'filena1
Picture1.Line (zbx1, zby2)-(zbx2, zby2), &H8000000C
Picture1.Line (zbx1, zby1)-(zbx2, zby1), &H8000000C
Picture1.Line (zbx1, zby2)-(zbx1, zby1), &H8000000C
Picture1.Line (zbx2, zby2)-(zbx2, zby1), &H8000000C
End Sub
Private Sub Command4_Click()
zbx1 = (60 / DataJg) * Val(Textzb(2))
zbx2 = (60 / DataJg) * Val(Textzb(3))
If zbx2 <= zbx1 Then
ww% = MsgBox("输入错误!,时间起点必须小于终点。", 1, "")
Textzb(2).SetFocus
Exit Sub
End If
If zbx2 - zbx1 = 12 Then
If zbx2 = 24 * (60 / DataJg) Then
zbx1 = zbx1 - 12
Else
zbx2 = zbx2 + 12
End If
End If
'--------------
zby2 = Val(Textzb(1))
zby1 = Val(Textzb(0))
If zby2 <= zby1 Then
ww% = MsgBox("输入错误!,数值起点必须小于终点。", 1, "")
Textzb(0).SetFocus
Exit Sub
End If
hzbx1
disp1
Picture2.Visible = False
End Sub
Private Sub Command5_Click()
Picture2.Visible = False
End Sub
Private Sub exit1_Click()
Timer1.Enabled = False
Unload Me
Unload sel24
End Sub
Private Sub Form_Deactivate()
exit1_Click
End Sub
Private Sub Form_Load()
Dim lcs, lcx
Me.Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
Me.Caption = "历史曲线 " & filena1
MaxY = -9999: MinY = 1000
For j% = 0 To 7
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -