📄 frm_quxian.frm
字号:
SubItemIndex = 1
Text = "时间"
Object.Width = 3881
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "数据"
Object.Width = 2540
EndProperty
End
Begin MSComCtl2.FlatScrollBar FlatScrollBar1
Height = 255
Left = 240
TabIndex = 32
Top = 7800
Width = 11445
_ExtentX = 20188
_ExtentY = 450
_Version = 393216
Enabled = 0 'False
Arrows = 65536
Orientation = 1245185
End
Begin MSChart20Lib.MSChart MSChart1
Height = 7215
Left = 240
OleObjectBlob = "Frm_Quxian.frx":04B2
TabIndex = 33
Top = 480
Width = 11445
End
Begin VB.Label Label8
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "单位：立方米"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 210
Left = -66240
TabIndex = 29
Top = 0
Width = 1335
End
End
Begin MSComctlLib.TreeView TreeView1
Height = 8175
Left = 120
TabIndex = 30
Top = 1320
Width = 3015
_ExtentX = 5318
_ExtentY = 14420
_Version = 393217
HideSelection = 0 'False
Style = 7
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
End
Attribute VB_Name = "Frm_Quxian"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Node_Name As String '表示节点名字
Private Sub Check2_Click()
'显示比例
On Error GoTo Err:
MSChart1.Refresh
If Check2.Value = 1 Then
MSChart1.ShowLegend = True
Else
MSChart1.ShowLegend = False
End If
MSChart1.Refresh
Err:
End Sub
Private Sub Check3_Click()
'Y轴
On Error GoTo Err:
If Check3.Value = 1 Then
MSChart1.Plot.Axis(VtChAxisIdY).AxisGrid.MajorPen.Style = VtPenStyleSolid
MSChart1.Plot.Axis(VtChAxisIdY).AxisGrid.MinorPen.Style = VtPenStyleSolid
Else
MSChart1.Plot.Axis(VtChAxisIdY).AxisGrid.MajorPen.Style = VtPenStyleNull
MSChart1.Plot.Axis(VtChAxisIdY).AxisGrid.MinorPen.Style = VtPenStyleNull
End If
Err:
End Sub
Private Sub Check4_Click()
'X轴
On Error GoTo Err:
If Check4.Value = 1 Then
MSChart1.Plot.Axis(VtChAxisIdX).AxisGrid.MajorPen.Style = VtPenStyleSolid
MSChart1.Plot.Axis(VtChAxisIdX).AxisGrid.MinorPen.Style = VtPenStyleSolid
Else
MSChart1.Plot.Axis(VtChAxisIdX).AxisGrid.MajorPen.Style = VtPenStyleNull
MSChart1.Plot.Axis(VtChAxisIdX).AxisGrid.MinorPen.Style = VtPenStyleNull
End If
Err:
End Sub
Private Sub Check5_Click()
'分页显示
On Error GoTo Err:
Dim S_count As Integer '防止一行时出错
If ListView1.ListItems.Count = 1 Then
S_count = 2
Else
S_count = ListView1.ListItems.Count
End If
MSChart1.Plot.Axis(VtChAxisIdY).ValueScale.Auto = True
Text3.Text = "默认"
If ListView1.ListItems.Count = 0 Then
FlatScrollBar1.Value = 0
FlatScrollBar1.Enabled = False
Exit Sub
End If
If S_count - 2 < Val(Text1.Text) Then GoTo ee:
If Check5.Value = 1 Then
FlatScrollBar1.Enabled = True
MSChart1.ColumnCount = Val(Text1)
If (S_count - 1) / Val(Text1) = Format((S_count - 1) / Val(Text1), 0) Then
FlatScrollBar1.Max = (S_count - 1) / Val(Text1) - 1 'MSChart1.ColumnCount
Else
FlatScrollBar1.Max = (S_count - 1) \ Val(Text1) 'MSChart1.ColumnCount
End If
FlatScrollBar1.Value = 0
''''''''''''''''''''''''''''''根据表格画曲线
MSChart1.Repaint = False
For i = 1 To Val(Text1)
MSChart1.Column = i
MSChart1.Row = 1
MSChart1.ColumnLabel = Format(ListView1.ListItems(i).SubItems(1), "yyyy-mm-dd")
MSChart1.Data = ListView1.ListItems(i).SubItems(2)
Next i
MSChart1.TitleText = ListView1.ListItems(1).SubItems(1) & " 至 " & ListView1.ListItems(i).SubItems(1) & " " & Combo1.Text & "变化图"
MSChart1.RowLabel = Node_Name
MSChart1.Repaint = True '允许刷新
Else
ee:
FlatScrollBar1.Value = 0
FlatScrollBar1.Enabled = False
''''''''''''''根据表格画曲线
MSChart1.TitleText = ListView1.ListItems(1).SubItems(1) & " 至 " & ListView1.ListItems(S_count).SubItems(1) & " " & Combo1.Text & "变化图"
MSChart1.RowLabel = Node_Name
MSChart1.Repaint = False
MSChart1.ColumnCount = S_count + 1
For i = 1 To S_count
MSChart1.Column = i
MSChart1.Row = 1
MSChart1.ColumnLabel = Format(ListView1.ListItems(i).SubItems(1), "yyyy-mm-dd")
MSChart1.Data = ListView1.ListItems(i).SubItems(2)
Next i
MSChart1.Repaint = True '允许刷新
End If
Err:
End Sub
Private Sub Cmd_Clear_Click()
ListView1.ListItems.Clear
Check5_Click
End Sub
Private Sub Cmd_Exit_Click()
Unload Me
End Sub
Private Sub Cmd_Print_Click()
'打印
On Error GoTo Err:
Me.MousePointer = 11
Dim exApp As New Excel.Application
Dim exbook As New Excel.Workbook
Dim exsheet As New Excel.Worksheet
Dim exchar As New Excel.Chart
Set exApp = CreateObject("Excel.Application")
Set exbook = exApp.Workbooks().Add
Set exsheet = exbook.Worksheets("sheet1")
Dim sumcol As Integer
exApp.Range("a:c").HorizontalAlignment = xlCenter
exApp.Range("1:3").Font.Bold = True
'设置列宽
exApp.Columns("a:a").ColumnWidth = 15
exApp.Columns("b:b").ColumnWidth = 20
exApp.Columns("c:c").ColumnWidth = 26
'合并单元格
exsheet.Range("A1:C1").Select
exApp.Selection.MergeCells = True
exApp.Selection.HorizontalAlignment = xlCenter
exApp.Selection.VerticalAlignment = xlCenter
exsheet.Range("A2:C2").Select
exApp.Selection.MergeCells = True
exApp.Selection.HorizontalAlignment = xlLeft
exApp.Selection.VerticalAlignment = xlCenter
exsheet.Cells(1, 1) = Node_Com & "数据查询表"
exsheet.Cells(2, 1) = "打印时间：" & Now()
For i = 1 To 3
exsheet.Cells(3, i) = ListView1.ColumnHeaders(i)
Next i
For i = 1 To ListView1.ListItems.Count
Set ite = ListView1.ListItems.Item(i)
exsheet.Cells(3 + i, 1) = i
exsheet.Cells(3 + i, 2) = ite.SubItems(1)
exsheet.Cells(3 + i, 3) = ite.SubItems(2)
Next i
'设置字体
exApp.Range("1:1").Font.Size = 16
exApp.Range("2:3").Font.Size = 11
exApp.Range("4:" & i + 2).Font.Size = 10
'设置行高
exApp.Range("1:1").RowHeight = 24
exApp.Range("2:2").RowHeight = 20
exApp.Range("3:" & i + 2).RowHeight = 16
exsheet.Range(exsheet.Cells(3, 1), exsheet.Cells(2 + i, 3)).Borders.LineStyle = xlContinuous '设置网格
If 2 + i > 3 Then
exsheet.Range(exsheet.Cells(4, 5), exsheet.Cells(2 + i, 3)).HorizontalAlignment = xlRight '设置单元格居右
exsheet.Range(exsheet.Cells(4, 5), exsheet.Cells(2 + i, 3)).NumberFormatLocal = "0.00_ " '设置小数位数
End If
'chart图表
If ListView1.ListItems.Count < 2 Then
Else
Set exchar = exApp.Charts.Add
exchar.ChartType = xlLine
exchar.HasLegend = True
exchar.SetSourceData exApp.Sheets("Sheet1").Range(exsheet.Cells(3, 2), exsheet.Cells(i + 2, 3)), PlotBy:=xlColumns
exchar.HasAxis(xlCategory, xlPrimary) = True
exchar.HasAxis(xlValue, xlPrimary) = True
exchar.Axes(xlCategory, xlPrimary).CategoryType = xlCategoryScale
exchar.HasTitle = True
exchar.ChartTitle.Text = exsheet.Cells(4, 2) & " 至 " & exsheet.Cells(i + 2, 2) & " " & Combo1.Text & "变化图"
End If
' '页边距设置
' With exsheet.PageSetup
' .LeftMargin = 0
' .RightMargin = 0
' .TopMargin = 30
' .BottomMargin = 30
' .CenterHorizontally = True
' .PaperSize = xlPaperA4
' End With
' With exsheet.PageSetup
' .PrintTitleRows = "$3:$3"
' End With
exApp.Visible = True
'释放对象
Set exbook = Nothing
Set exsheet = Nothing
Set exApp = Nothing
Err:
Me.MousePointer = 0
End Sub
Private Sub Cmd_Query_Click()
On Error GoTo Err:
Me.MousePointer = 11
Dim Max_v As Double
Dim Min_v As Double
Min_v = 100000
ListView1.ListItems.Clear
Open_Data ("select * from ST_River_R,ST_STBPRP_B where ST_River_R.STCD=ST_STBPRP_B.STCD AND tm>='" & DTPicker1.Value & " 00:00:00' and tm<'" & DTPicker2.Value & " 23:59:59' AND ST_STBPRP_B.STNM='" & Node_Name & "' order by tm")
Lab_Where = "查询：" & Node_Name
If rs.RecordCount > 0 Then
i = 1
While Not rs.EOF
Set ite = ListView1.ListItems.Add(, , i)
ite.SubItems(1) = rs.Fields("TM")
If Combo1.Text = "库水位" Then
ite.SubItems(2) = Val(Trim(rs.Fields("Z") & ""))
ElseIf Combo1.Text = "入库流量" Then
ite.SubItems(2) = Val(Trim(rs.Fields("Q") & ""))
ElseIf Combo1.Text = "蓄水量" Then
ite.SubItems(2) = Val(Trim(rs.Fields("XSA") & ""))
ElseIf Combo1.Text = "出库流量" Then
ite.SubItems(2) = Val(Trim(rs.Fields("XSAVV") & ""))
End If
If ite.SubItems(2) > Max_v Then Max_v = ite.SubItems(2)
If ite.SubItems(2) < Min_v Then Min_v = ite.SubItems(2)
rs.MoveNext
i = i + 1
Wend
Else
End If
Text1.Text = ListView1.ListItems.Count - 1
Check5.Enabled = True
Check5_Click
'设置最大、最小值
MSChart1.Plot.Axis(VtChAxisIdY).ValueScale.Auto = False
MSChart1.Plot.Axis(VtChAxisIdY).ValueScale.Minimum = Min_v
MSChart1.Plot.Axis(VtChAxisIdY).ValueScale.Maximum = Max_v
Err:
Me.MousePointer = 0
End Sub
Private Sub Command4_Click()
'设置最大、最小值
MSChart1.Plot.Axis(VtChAxisIdY).ValueScale.Auto = False
MSChart1.Plot.Axis(VtChAxisIdY).ValueScale.Minimum = Val(Text2.Text)
MSChart1.Plot.Axis(VtChAxisIdY).ValueScale.Maximum = Val(Text3.Text)
End Sub
Private Sub Command5_Click()
'自动缩放
MSChart1.Plot.Axis(VtChAxisIdY).ValueScale.Auto = True
Text3.Text = "默认"
End Sub
Private Sub FlatScrollBar1_Change()
On Error GoTo Err:
Dim S_count As Integer '防止一行时出错
If ListView1.ListItems.Count = 1 Then
S_count = 2
Else
S_count = ListView1.ListItems.Count
End If
MSChart1.Plot.Axis(VtChAxisIdY).ValueScale.Auto = True
Text3.Text = "默认"
MSChart1.Repaint = False
If (FlatScrollBar1.Value * Val(Text1) + Val(Text1)) > S_count - 1 Then
n = S_count - Val(Text1) - 1
Else
n = FlatScrollBar1.Value * Val(Text1)
End If
For i = 1 To Val(Text1)
MSChart1.Column = i
MSChart1.Row = 1
MSChart1.ColumnLabel = Format(ListView1.ListItems(n + i).SubItems(1), "yyyy-mm-dd")
MSChart1.Data = ListView1.ListItems(n + i).SubItems(2)
Next i
MSChart1.TitleText = ListView1.ListItems(n + 1).SubItems(1) & " 至 " & ListView1.ListItems(n + i).SubItems(1) & " " & Combo1.Text & "变化图"
MSChart1.RowLabel = Node_Name
MSChart1.Repaint = True '允许刷新
Err:
End Sub
Private Sub Form_Load()
DTPicker1.Value = Year(Date) & "-1-1"
DTPicker2.Value = Date
LoadDataToTree TreeView1
If TreeView1.Nodes.Count > 1 Then Node_Name = TreeView1.Nodes(2).Text
Cmd_Query_Click
End Sub
Private Sub MSChart1_PointSelected(Series As Integer, DataPoint As Integer, MouseFlags As Integer, Cancel As Integer)
On Error GoTo Err:
MSChart1.Column = DataPoint ' "米"
MSChart1.Row = Series
MSChart1.ToolTipText = MSChart1.ColumnLabel & " " & Combo1.Text & "：" & MSChart1.Data & "立方米"
Err:
End Sub
Private Sub MSChart1_SeriesSelected(Series As Integer, MouseFlags As Integer, Cancel As Integer)
CurSerIndex = Series
End Sub
Private Sub Text1_Change()
On Error GoTo Err:
If Val(Text1) < 1 Then Text1 = 1
If Check5 Then Check5_Click
Err:
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
Node_Name = Node.Text
End Sub
Private Sub UpDown2_Change()
'图形类型
On Error GoTo Err:
MSChart1.ChartType = UpDown2.Value
Err:
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -