⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form1.frm

📁 vb控件vb控件vb控件vb控件vb控件vb控件vb控件
💻 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 + -