frmtest.frm

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

FRM
744 行
字号
12
      Height          =   255
      Index           =   13
      Left            =   1950
      TabIndex        =   16
      Top             =   6120
      Width           =   1845
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Info foreground color"
      Height          =   255
      Index           =   12
      Left            =   1950
      TabIndex        =   13
      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        =   12
      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        =   11
      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        =   10
      Top             =   4920
      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 varYears As Variant
    Dim varYearsExt As Variant
    
    varYears = Array("2000", "2001", "2002", "2003", "2004", "2005", "2006", "2007", "2008", "2009", "2010", "2011", "2012", "2013", "2014", "2015")
    varYearsExt = Array("2000", "2001", "2002", "2003", "2004", "2005", "2006", "2007", "2008", "2009", "2010", "2011", "2012", "2013", "2014", "2015")

    Randomize
    grd.Rows = 1
    With XQuadrant1
        .Clear
        .CustomMenuItems = "&Hello|&World|Print legend text"
        For X = 1 To UBound(varYears) + 1
            Randomize
            If .MinY < 0 And .MaxY >= 0 Then
                intSign = CInt(Rnd * 1)
                If intSign = 0 Then
                    oChartItem.YValue = CDbl(Rnd * .MaxY)
                Else
                    oChartItem.YValue = -CDbl(Rnd * Abs(.MinY))
                End If
            ElseIf .MinY >= 0 And .MaxY >= 0 Then
                oChartItem.YValue = .MinY + CDbl(Rnd * (.MaxY - .MinY))
            ElseIf .MinY < 0 And .MaxY < 0 Then
                oChartItem.YValue = .MaxY - CDbl(Rnd * (Abs(.MinY) - Abs(.MaxY)))
            End If
            
            Randomize
            If .Minx < 0 And .Maxx >= 0 Then
                intSign = CInt(Rnd * 1)
                If intSign = 0 Then
                    oChartItem.XValue = CDbl(Rnd * .Maxx)
                Else
                    oChartItem.XValue = -CDbl(Rnd * Abs(.Minx))
                End If
            ElseIf .Minx >= 0 And .Maxx >= 0 Then
                oChartItem.XValue = .Minx + CDbl(Rnd * (.Maxx - .Minx))
            ElseIf .Minx < 0 And .Maxx < 0 Then
                oChartItem.XValue = .Maxx - CDbl(Rnd * (Abs(.Minx) - Abs(.Maxx)))
            End If
            
            With oChartItem
                .XValue = Round(oChartItem.XValue, 2)
                .YValue = Round(oChartItem.YValue, 2)
                .ItemID = X
                .Description = varYears(X - 1)
                .SelectedDescription = "Year" & vbCrLf & varYearsExt(X - 1)
                .LegendDescription = "Year " & varYearsExt(X - 1)
            End With
            .AddItem oChartItem
    
            grd.AddItem X & vbTab & oChartItem.SelectedDescription & vbTab & oChartItem.XValue & "/" & oChartItem.YValue
        Next X
    End With
    
End Sub

Private Sub RefreshData()
    
    Dim intIdx As Integer
    
    With XQuadrant1
        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 = .MarkerLabelColor
        Label1(8).BackColor = .QuadrantDividerColor
        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 = .SelectedColor
        Label1(16).BackColor = .MarkerColor
        Label1(17).BackColor = .InfoQuadrantforeColor
        Label1(18).BackColor = .InfoQuadrantBackColor
        Option1(.MenuType).Value = True
        Check1(1).Value = IIf((.PictureTile = True), vbChecked, vbUnchecked)
        txtMinY.Text = .MinY
        txtMaxY.Text = .MaxY
        txtMinX.Text = .Minx
        txtMaxX.Text = .Maxx
        txtMarkerWidth.Text = CStr(.markerWidth)
        For intIdx = 0 To cboType.ListCount - 1
            If cboType.ItemData(intIdx) = .MarkerSymbol 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 XQuadrant1
        .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
        .LegendForeColor = Label1(9).BackColor
        .LegendbackColor = Label1(10).BackColor
        .InfoForeColor = Label1(11).BackColor
        .InfoBackColor = Label1(12).BackColor
        .MinorGridColor = Label1(13).BackColor
        .MajorGridColor = Label1(14).BackColor
        .SelectedColor = Label1(15).BackColor
        .MarkerColor = Label1(16).BackColor
        .MarkerLabelColor = Label1(7).BackColor
        .QuadrantDividerColor = Label1(8).BackColor
        .InfoQuadrantforeColor = Label1(17).BackColor
        .InfoQuadrantBackColor = Label1(18).BackColor
        If Option1(0).Value = True Then
            .MenuType = xcPopUpMenu
        Else
            .MenuType = xcButtonMenu
        End If
        .PictureTile = IIf((Check1(1).Value = vbChecked), True, False)
        
        .markerWidth = CInt(txtMarkerWidth.Text)
        .MinY = CDbl(txtMinY.Text)
        .MaxY = CDbl(txtMaxY.Text)
        .Minx = CDbl(txtMinX.Text)
        .Maxx = CDbl(txtMaxX.Text)
        PrepareData
        If Check1(2).Value = vbUnchecked Then
            Set .Picture = Nothing
        Else
            Set .Picture = LoadPicture(App.Path & "\stonehng.jpg")
        End If
        .MarkerSymbol = cboType.ItemData(cboType.ListIndex)
        .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 XQuadrant1_ItemClick(cItem As ActiveQuadrant.ChartItem)
    grd.SelectionMode = flexSelectionByRow
    grd.Row = cItem.ItemID
    grd.ColSel = 2
End Sub

Private Sub Form_Load()
    
    PrepareData
        
    With cboType
        .Clear
        .AddItem "Box":             .ItemData(.NewIndex) = xcMarkerSymBox
        .AddItem "Circle":          .ItemData(.NewIndex) = xcMarkerSymCircle
        .AddItem "Triangle":        .ItemData(.NewIndex) = xcMarkerSymTriangle
        .AddItem "Trapezium":       .ItemData(.NewIndex) = xcMarkerSymTrapezium
        .AddItem "Rhombus":         .ItemData(.NewIndex) = xcMarkerSymRhombus
    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
    
    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
'    XQuadrant1.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
End Sub



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

    If intMenuItemIndex = 2 Then
        XQuadrant1.PrintLegend
    End If

End Sub
12

frmtest.frm - 源码说明

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

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

⌨️ 快捷键说明

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