📄 frmchaxun.frm
字号:
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
BeginProperty Column00
ColumnWidth = 450.142
EndProperty
BeginProperty Column01
ColumnWidth = 1230.236
EndProperty
BeginProperty Column02
ColumnWidth = 1305.071
EndProperty
BeginProperty Column03
ColumnWidth = 1574.929
EndProperty
BeginProperty Column04
ColumnWidth = 464.882
EndProperty
BeginProperty Column05
ColumnWidth = 705.26
EndProperty
BeginProperty Column06
ColumnWidth = 720
EndProperty
BeginProperty Column07
ColumnWidth = 734.74
EndProperty
BeginProperty Column08
ColumnWidth = 689.953
EndProperty
BeginProperty Column09
ColumnWidth = 705.26
EndProperty
BeginProperty Column10
ColumnWidth = 734.74
EndProperty
BeginProperty Column11
ColumnWidth = 750.047
EndProperty
EndProperty
End
Begin MSAdodcLib.Adodc Adodc1
Height = 375
Left = 10560
Top = 2400
Visible = 0 'False
Width = 1200
_ExtentX = 2117
_ExtentY = 661
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin VB.Frame Frame1
Caption = "查询条件"
Height = 735
Left = 0
TabIndex = 10
Top = 0
Width = 11775
Begin VB.CheckBox Check1
Caption = "按编号查询："
Height = 255
Left = 240
TabIndex = 12
Top = 240
Width = 1455
End
Begin VB.ComboBox Combo1
Enabled = 0 'False
Height = 300
Left = 1800
TabIndex = 11
Top = 240
Width = 1215
End
End
End
Attribute VB_Name = "Frmchaxun"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim strsql As String
Private NumPoints As Integer
Dim rs As New ADODB.Recordset
Dim dbcn As New ADODB.Connection
Private Sub Check1_Click()
Combo1.Clear '清空下拉列表中的内容
CommandQuery.Enabled = True '激活开始查询按钮
strsql = "SELECT id,sum(v) FROM data GROUP BY id;"
'按照不同的编号进行分组，取得所有的编号
excutesql (strsql) '调用函数，执行SQL语句
While Not rs.EOF
If rs!id <> "" Then
Combo1.AddItem (rs!id) '将编号的数据插入到下拉列表里，供用户选择
End If
rs.MoveNext
Wend
rs.Close
dbcn.Close
End Sub
Private Sub CommadnAll_Click()
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "SELECT * FROM data"
'设置ADODC控件的RecordSource属性为取所有的数据
Adodc1.Refresh
End Sub
Private Sub CommandChA_Click()
If Combo1.Text <> "" Then '调用MakeChart函数，绘制图表
makechart ("a1")
End If
End Sub
Private Sub CommandChB_Click()
If Combo1.Text <> "" Then
makechart ("a2")
End If
End Sub
Private Sub CommandChC_Click()
If Combo1.Text <> "" Then
makechart ("a3")
End If
End Sub
Private Sub CommandChV_Click()
If Combo1.Text <> "" Then
makechart ("v")
End If
End Sub
Private Sub CommandDel_Click()
Dim varBmk As Variant
For Each varBmk In DataGrid1.SelBookmarks 'varBmk保存的是用户要删除的行
Adodc1.Recordset.Bookmark = varBmk '把该行作上标记
Adodc1.Recordset.Delete '删除该行
Adodc1.Refresh '更新显示
Set DataGrid1.DataSource = Adodc1 '将DataGrid控件于ADODC绑定，以更新DataGrid的显示
Next
Unload Me
Me.Show
End Sub
Private Sub CommandExit_Click()
Unload Me
End Sub
Private Sub CommandQuery_Click()
Adodc1.CommandType = adCmdText
If Check1.Value = 1 And Combo1.Text = "" Then '判断是否选择查询条件
MsgBox "对不起！请输入您的查询条件！", vbOKOnly, "错误"
Else
Adodc1.RecordSource = "SELECT * FROM data where id='" & Combo1.Text & "'"
'执行查询语句
End If
Adodc1.Refresh '刷新ADODC，即更新了DataGrid的显示
Chart1.Refresh
End Sub
Private Sub Form_Load()
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db\db1.mdb;Persist Security Info=False"
'指定ADODC控件的连接对象
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "SELECT * FROM data order by time DESC"
'按照时间降序的方式取得所有的数据
Adodc1.Refresh '更新显示
End Sub
Public Function excutesql(strsql As String)
Dim filename As String
filename = App.Path + "\db\db1.mdb"
dbcn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & filename
dbcn.Open
rs.ActiveConnection = dbcn
rs.Source = strsql
rs.Open
End Function
Public Function makechart(m As String)
Dim Count As Integer
Dim ValueTemp() As Integer
Dim Value() As Variant
strsql = "select " & m & ",time from data where id = " & Combo1.Text & ""
'根据编码进行查询
excutesql (strsql)
NumPoints = 0 '存放数组的上限
While Not rs.EOF
ReDim Preserve ValueTemp(2, NumPoints + 1)
'循环语句，由于设置MSChart控件显示的是二维的图表,
'因此将查询的结果，保存在一个二维数组中，同时由于动态
'设定数组的上限时，只能设定二维数组的第二维，因此，这里改变了
'数组的两个维的维度大小，即两行数据，列的大小动态确定
ValueTemp(0, NumPoints) = NumPoints + 1
'第一行的数据存放的是数字编号
Select Case m
Case "a1" '根据判断，第二行存放的是电流或者电压的数据
ValueTemp(1, NumPoints) = rs!a1
Case "a2"
ValueTemp(1, NumPoints) = rs!a2
Case "a3"
ValueTemp(1, NumPoints) = rs!a3
Case "v"
ValueTemp(1, NumPoints) = rs!v
End Select
NumPoints = NumPoints + 1
rs.MoveNext
Wend
ReDim values1(NumPoints - 1, 2)
For Count = 0 To NumPoints - 1 '保存完毕后，将数组的行列互换
Value(Count, 0) = ValueTemp(0, Count)
Value(Count, 1) = ValueTemp(1, Count)
Next
Chart1.chartType = VtChChartType2dXY '指定MSChart控件的样式为二维图表
Chart1.RowCount = NumPoints '指定MSChart控件的最大行数
Chart1.ColumnCount = 2 '指定MSChart控件的最大列数
Chart1.ChartData = values1 ''指定MSChart控件的数据
rs.Close
dbcn.Close
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -