frmtest.frm

来自「多种图表的绘制及其运用」· FRM 代码 · 共 769 行 · 第 1/2 页

FRM
769 行
字号
12
      Index           =   12
      Left            =   1950
      TabIndex        =   15
      Top             =   5520
      Width           =   1845
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Info background color"
      Height          =   255
      Index           =   11
      Left            =   1950
      TabIndex        =   14
      Top             =   5820
      Width           =   1845
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Legend background color"
      Height          =   255
      Index           =   10
      Left            =   1950
      TabIndex        =   13
      Top             =   5220
      Width           =   1845
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Legend foreground color"
      Height          =   255
      Index           =   9
      Left            =   1950
      TabIndex        =   12
      Top             =   4920
      Width           =   1845
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Bar color"
      Height          =   255
      Index           =   8
      Left            =   60
      TabIndex        =   11
      Top             =   7320
      Width           =   1845
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Selected bar color"
      Height          =   255
      Index           =   7
      Left            =   60
      TabIndex        =   10
      Top             =   7020
      Width           =   1845
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Y axis items color"
      Height          =   255
      Index           =   6
      Left            =   60
      TabIndex        =   9
      Top             =   6720
      Width           =   1845
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Y axis label color"
      Height          =   255
      Index           =   5
      Left            =   60
      TabIndex        =   8
      Top             =   6420
      Width           =   1845
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "X axis items color"
      Height          =   255
      Index           =   4
      Left            =   60
      TabIndex        =   7
      Top             =   6120
      Width           =   1845
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "X axis label color"
      Height          =   255
      Index           =   3
      Left            =   60
      TabIndex        =   6
      Top             =   5820
      Width           =   1845
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Subtitle color"
      Height          =   255
      Index           =   2
      Left            =   60
      TabIndex        =   5
      Top             =   5520
      Width           =   1845
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Title color"
      Height          =   255
      Index           =   1
      Left            =   60
      TabIndex        =   4
      Top             =   5220
      Width           =   1845
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Background color"
      Height          =   255
      Index           =   0
      Left            =   60
      TabIndex        =   2
      Top             =   4920
      Width           =   1845
   End
End
Attribute VB_Name = "frmTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub PrepareData()
    
    Dim X As Integer
    Dim intSign As Integer
    Dim oChartItem As ChartItem
    Dim varMonths As Variant
    Dim varMonthsExt As Variant
    
    varMonths = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
    varMonthsExt = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")

    Randomize
    grd.Rows = 1
    With XChart1
        .AutoRedraw = True
        .Clear
        .CustomMenuItems = "&Hello|&World|Print legend text"
        For X = 1 To 12
            If .MinY < 0 And .MaxY >= 0 Then
                intSign = CInt(Rnd * 1)
                If intSign = 0 Then
                    oChartItem.Value = CInt(Rnd * .MaxY)
                Else
                    oChartItem.Value = -CInt(Rnd * Abs(.MinY))
                End If
            ElseIf .MinY >= 0 And .MaxY >= 0 Then
                oChartItem.Value = .MinY + CInt(Rnd * (.MaxY - .MinY))
            ElseIf .MinY < 0 And .MaxY < 0 Then
                oChartItem.Value = .MaxY - CInt(Rnd * (Abs(.MinY) - Abs(.MaxY)))
            End If
            oChartItem.ItemID = X
            oChartItem.XAxisDescription = "Month" & vbCrLf & varMonths(X - 1)
            oChartItem.SelectedDescription = varMonthsExt(X - 1)
            oChartItem.LegendDescription = "Month " & varMonthsExt(X - 1)
            .AddItem oChartItem
    
            grd.AddItem X & vbTab & oChartItem.SelectedDescription & vbTab & oChartItem.Value
        Next X
    End With
    
End Sub

Private Sub RefreshData()
    
    Dim intIdx As Integer
    
    With XChart1
        Label1(0).BackColor = .BackColor
        Label1(1).BackColor = .ChartTitleColor
        Label1(2).BackColor = .ChartSubTitleColor
        Label1(3).BackColor = .AxisLabelXColor
        Label1(4).BackColor = .AxisItemsXColor
        Label1(5).BackColor = .AxisLabelYColor
        Label1(6).BackColor = .AxisItemsYColor
        Label1(7).BackColor = .SelectedBarColor
        Label1(8).BackColor = .BarColor
        Label1(9).BackColor = .LegendForeColor
        Label1(10).BackColor = .LegendbackColor
        Label1(11).BackColor = .InfoForeColor
        Label1(12).BackColor = .InfoBackColor
        Label1(13).BackColor = .MinorGridColor
        Label1(14).BackColor = .MajorGridColor
        Label1(15).BackColor = .LineColor
        Label1(16).BackColor = .BarSymbolColor
        Label1(17).BackColor = .BarShadowColor
        Option1(.MenuType).Value = True
        Check1(0).Value = IIf((.HotTracking = True), vbChecked, vbUnchecked)
        Check1(1).Value = IIf((.PictureTile = True), vbChecked, vbUnchecked)
        Check1(3).Value = IIf((.BarShadow = True), vbChecked, vbUnchecked)
        Check1(5).Value = IIf((.BarPictureTile = True), vbChecked, vbUnchecked)
        Check1(6).Value = IIf((.MeanOn = True), vbChecked, vbUnchecked)
        txtMin.Text = .MinY
        txtMax.Text = .MaxY
        txtBarPerc.Text = CStr(.BarWidthPercentage)
        txtLineWidth.Text = CStr(.LineWidth)
        txtSymbol.Text = .BarSymbol
        For intIdx = 0 To cboType.ListCount - 1
            If cboType.ItemData(intIdx) = .ChartType Then
                cboType.ListIndex = intIdx
                Exit For
            End If
        Next
        For intIdx = 0 To cboPrtMode.ListCount - 1
            If cboPrtMode.ItemData(intIdx) = .printerfit Then
                cboPrtMode.ListIndex = intIdx
                Exit For
            End If
        Next
    End With

End Sub

Private Sub Command1_Click()

    With XChart1
        .AutoRedraw = False
        .BackColor = Label1(0).BackColor
        .ChartTitleColor = Label1(1).BackColor
        .ChartSubTitleColor = Label1(2).BackColor
        .AxisLabelXColor = Label1(3).BackColor
        .AxisItemsXColor = Label1(4).BackColor
        .AxisLabelYColor = Label1(5).BackColor
        .AxisItemsYColor = Label1(6).BackColor
        .SelectedBarColor = Label1(7).BackColor
        .BarColor = Label1(8).BackColor
        .LegendForeColor = Label1(9).BackColor
        .LegendbackColor = Label1(10).BackColor
        .InfoForeColor = Label1(11).BackColor
        .InfoBackColor = Label1(12).BackColor
        .MinorGridColor = Label1(13).BackColor
        .MajorGridColor = Label1(14).BackColor
        .LineColor = Label1(15).BackColor
        .BarSymbolColor = Label1(16).BackColor
        .BarShadowColor = Label1(17).BackColor
        If Option1(0).Value = True Then
            .MenuType = xcPopUpMenu
        Else
            .MenuType = xcButtonMenu
        End If
        .HotTracking = IIf((Check1(0).Value = vbChecked), True, False)
        .PictureTile = IIf((Check1(1).Value = vbChecked), True, False)
        .BarShadow = IIf((Check1(3).Value = vbChecked), True, False)
        .BarPictureTile = IIf((Check1(5).Value = vbChecked), True, False)
        .MeanOn = IIf((Check1(6).Value = vbChecked), True, False)
        
        .LineWidth = CInt(txtLineWidth.Text)
        .BarWidthPercentage = CInt(txtBarPerc.Text)
        .MinY = CDbl(txtMin.Text)
        .MaxY = CDbl(txtMax.Text)
        PrepareData
        .ChartType = cboType.ItemData(cboType.ListIndex)
        If Check1(2).Value = vbUnchecked Then
            Set .Picture = Nothing
        Else
            Set .Picture = LoadPicture(App.Path & "\stonehng.jpg")
        End If
        If Check1(4).Value = vbUnchecked Then
            Set .BarPicture = Nothing
        Else
            Set .BarPicture = LoadPicture(App.Path & "\tile1.jpg")
        End If
        .BarSymbol = Left$(txtSymbol.Text, 1)
        .printerfit = cboPrtMode.ItemData(cboPrtMode.ListIndex)
        .AutoRedraw = True
    End With
    RefreshData

End Sub

Private Sub Label1_Click(Index As Integer)
    
    dlgColor.Color = Label1(Index).BackColor
    dlgColor.ShowColor
    If dlgColor.Color <> Label1(Index).BackColor Then
        Label1(Index).BackColor = dlgColor.Color
    End If

End Sub

Private Sub xchart1_ItemClick(cItem As ActiveChart.ChartItem)
    grd.SelectionMode = flexSelectionByRow
    grd.Row = cItem.ItemID
    grd.ColSel = 2
End Sub

Private Sub Form_Load()
    
    With cboType
        .Clear
        .AddItem "Bar":             .ItemData(.NewIndex) = xcBar
        .AddItem "Symbol":          .ItemData(.NewIndex) = xcSymbol
        .AddItem "Line":            .ItemData(.NewIndex) = xcLine
        .AddItem "BarLine":         .ItemData(.NewIndex) = xcBarLine
        .AddItem "SymbolLine":      .ItemData(.NewIndex) = xcSymbolLine
        .AddItem "Oval":            .ItemData(.NewIndex) = xcOval
        .AddItem "OvalLine":        .ItemData(.NewIndex) = xcOvalLine
        .AddItem "Triangle":        .ItemData(.NewIndex) = xcTriangle
        .AddItem "TriangleLine":    .ItemData(.NewIndex) = xcTriangleLine
        .AddItem "Rhombus":         .ItemData(.NewIndex) = xcRhombus
        .AddItem "RhombusLine":     .ItemData(.NewIndex) = xcRhombusLine
        .AddItem "Trapezium":       .ItemData(.NewIndex) = xcTrapezium
        .AddItem "TrapeziumLine":   .ItemData(.NewIndex) = xcTrapeziumLine
    End With
    
    With cboPrtMode
        .Clear
        .AddItem "Stretched":      .ItemData(.NewIndex) = prtFitStretched
        .AddItem "Centered":       .ItemData(.NewIndex) = prtFitCentered
        .AddItem "TopLeft":        .ItemData(.NewIndex) = prtFitTopLeft
        .AddItem "TopRight":       .ItemData(.NewIndex) = prtFitTopRight
        .AddItem "BottomLeft":     .ItemData(.NewIndex) = prtFitBottomLeft
        .AddItem "BottomRight":    .ItemData(.NewIndex) = prtFitBottomRight
    End With
    
    PrepareData
        
    With grd
        .FixedRows = 1
        .TextMatrix(0, 0) = "Item"
        .TextMatrix(0, 1) = "Description"
        .TextMatrix(0, 2) = "Value"
        .ColWidth(0) = 800
        .ColWidth(1) = 3500
        .ColWidth(2) = 1000
    End With

    RefreshData
    
End Sub

Private Sub Form_Resize()
'    grd.Width = Me.ScaleWidth
'    XChart1.Width = Me.ScaleWidth

'    grd.ColWidth(0) = 960
'    grd.ColWidth(1) = Me.ScaleWidth - 960 - 2025
'    grd.ColWidth(2) = 2025
End Sub

Private Sub grd_Click()
    DoEvents
    XChart1.SelectedColumn = grd.Row - 1
End Sub



Private Sub XChart1_MenuItemClick(intMenuItemIndex As Integer, stgMenuItemCaption As String)
    
    MsgBox "You clicked " & intMenuItemIndex & ":" & stgMenuItemCaption, _
            vbOKOnly, "CustomMenuItem"

    If intMenuItemIndex = 2 Then
        XChart1.PrintLegend
    End If
    
End Sub
12

frmtest.frm - 源码说明

本页面展示了「多种图表的绘制及其运用」中的 frmtest.frm 源码文件，采用 FRM 编程语言编写，共 769 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫下载站收录了大量与图表相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?