📄 form1.frm
字号:
VERSION 5.00
Object = "{65E121D4-0C60-11D2-A9FC-0000F8754DA1}#2.0#0"; "mschrt20.ocx"
Begin VB.Form Form1
BorderStyle = 4 'Fixed ToolWindow
Caption = "Form1"
ClientHeight = 9675
ClientLeft = 45
ClientTop = 225
ClientWidth = 14310
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 9675
ScaleWidth = 14310
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin MSChart20Lib.MSChart MSc1
Height = 9645
Left = 0
OleObjectBlob = "Form1.frx":0000
TabIndex = 0
Top = 90
Width = 14295
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim cn As New ADODB.Connection, crs As New ADODB.Recordset
Private Sub Form_Load()
cn.Open "provider=microsoft.jet.oledb.4.0;data source=e:\temp\backup\hotel.mdb"
crs.Open "select 菜类,count(*) as 品种 from 菜单 group by 菜类", cn, adOpenStatic, adLockReadOnly, adCmdText
AddToMschart crs, MSc1, , True, VtChChartType3dBar
'Plot的View3D对象(设置三维特性)
'Rotation属性为设置其旋转角度
'Elevation属性为设置其仰角
'Set方法为一次设置以上两个属性值
'-------------------------------------------------------------
'Plot的Wall对象(设置图例后面的墙)
'Brush子对象返回或设置墙体的一些属性
'Style设置填充模式
'PatternColor设置Style属性设置为VtBrushStylePattern时的填充色
'FillColor设置墙体的前景色
'Index设置Style属性为VtBrushStyleHatched、VtBrushStylePattern时墙体的填充模式(如斜线、网格等)
'------------------------------------------
'Pen子对象设置墙体上的边线
'------------------------------------------
'Light子对象设置三维灯光效果
'AmbientIntensity设置三维柱面及墙面、底坐的亮度(单精度值)
'EdgeIntensity设置三维柱体的边线亮度(单精度值)
'EdgeVisible设置三维柱体的边线是否可见(布尔值)
'LightSources设置光源(可添加、删除)
'------------------------------------------
'LocationRect设置图列的大小
'MAX
'MIN
'------------------------------------------
'Plot的PlotBase对象用于设置底坐
'BaseHeight属性设置底坐的高度
'Brush对象设置底坐的填充样式等
'------------------------------------------
'SeriesCollection对象设置单个列
'Count方法得到列数
'Item(Index as integer)对象设置单个列
'Mschart.plot.SeriesCollection.Item(1).Position.Excluded=True(去掉指定列)
'Mschart.plot.SeriesCollection.Item(1).Position.Hidden=True(隐藏指定列)
'Mschart.Plot.SeriesCollection.Item(1).LegendText = "中国"(设置第一列的列标签为"中国")
'Mschart.Plot.SeriesCollection.Item(1).SeriesMarker.Show=True(设置标记)
'------------------------------------------
'Legend对象用于设置列标签
'BackDrop用于设置列标签背景等设置
'Fill例:用于设置列标签的样式、颜色填充
'Legend.Backdrop.Fill.Style = VtFillStyleBrush'设置使刷子
'Legend.Backdrop.Fill.Brush.Index = VtBrushPattern88Percent'填充样式
'Legend.Backdrop.Fill.Brush.Style = VtBrushStyleHatched'模式
'---------------------------------------------------------
'Location设置列标签的位置、可见状态
'LocationType定义列标签位置
'VtFont设置字体属性
With MSc1
.Plot.SeriesCollection.Item(1).SeriesMarker.Show = True
.Plot.SeriesCollection.Item(2).SeriesMarker.Show = True
.Plot.PlotBase.Brush.Index = VtBrushPattern88Percent
.Plot.PlotBase.Brush.Style = VtBrushStylePattern
.Plot.View3d.Rotation = 180
.Plot.View3d.Elevation = 0
.Legend.VtFont.Size = 12
End With
End Sub
Private Sub AddToMschart(Rst As ADODB.Recordset, MSChart As MSChart20Lib.MSChart, Optional Title As String = "", Optional ForceMulitColumn As Boolean = False, Optional ChartType As VtChChartType = VtChChartType2dBar, Optional RowLableCount As Integer = 1, Optional ColumnLableCount As Integer = 1)
Dim RecordCount As Long, i As Long, j As Long, Fid As ADODB.Field, n As Integer, fldnum As Integer
RecordCount = Rst.RecordCount '得到记录数为设定图表行数做准备
fldnum = Rst.Fields.Count '得到记录集字段数为设定图表列数做准备
If fldnum > 2 Then ForceMulitColumn = False '如果记录集列表数大于2列则不能使用强制单行多列模式
If ForceMulitColumn Then '如果强制使用单行多列模式(强制单行多列模式只能用于只有两个字段的记录集,且第二字段为数据段)
ReDim Value(1 To fldnum - 1, 1 To RecordCount + 1)
Else
ReDim Value(1 To RecordCount, 1 To fldnum) '定义二维数组的各维大小
End If
With MSChart
.Legend.VtFont.Size = 35
.ChartType = ChartType
.DataGrid.ColumnCount = fldnum - 1 '定义MsChart的列数
.DataGrid.RowCount = RecordCount '定义MsChart的行数
.DataGrid.ColumnLabelCount = ColumnLabelCount '定义MsChart的列级别数
.DataGrid.RowLabelCount = RowLabelCount '定义MsChart的行级别数
For Each Fid In Rst.Fields '向数组中添加数据
n = n + 1
Rst.MoveFirst
For i = 1 To RecordCount
If ForceMulitColumn Then '为强制单行多列模式下的数组添加数据
If n > fldnum - 1 Then Exit For
If n < Rst.Fields.Count Then
If i = 1 Then Value(n, i) = Rst.Fields(fldnum - 1).Name '得到行名
Value(n, i + 1) = Rst.Fields(fldnum - 1).Value '得到列数据
End If
Else
Value(i, n) = Fid.Value '为标准模式添加数据
End If
Rst.MoveNext
Next
Next
.ChartData = Value '填充MsChar数据
.Title = Title '设置标题
n = 0
Rst.MoveFirst
If ForceMulitColumn Then
For i = 1 To RecordCount '为强制单行多列模式添加列标签
.DataGrid.ColumnLabel(i, 1) = Rst.Fields(fldnum - 2).Value
Rst.MoveNext
Next
Else
For Each Fid In Rst.Fields '为标准模式添加列标签
n = n + 1
If n > 1 Then .DataGrid.ColumnLabel(n - 1, 1) = Fid.Name
Next
End If
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -