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

📄 bargraph.vb

📁 This ASP.NET (VB.NET) sample demonstrates how to create chart.
💻 VB
📖 第 1 页 / 共 2 页
字号:
                Dim i As Integer
                For i = 0 To _yTickCount - 1
                    Dim currentY As Single = _topBuffer + i * _yTickValue / _scaleFactor ' Position for tick mark
                    Dim labelY As Single = currentY - lblFont.Height / 2 ' Place label in the middle of tick
                    Dim lblRec As New RectangleF(_spacer, labelY, _maxTickValueWidth, lblFont.Height)
                    Dim currentTick As Single = _maxValue - i * _yTickValue ' Calculate tick value from top to bottom
                    graph.DrawString(currentTick.ToString("#,###.##"), lblFont, brs, lblRec, lblFormat) ' Draw tick value  
                    graph.DrawLine(pen, _xOrigin, currentY, _xOrigin - 4.0F, currentY) ' Draw tick mark
                Next i

                ' Draw y axis
                graph.DrawLine(pen, _xOrigin, _yOrigin, _xOrigin, _yOrigin + _graphHeight)
            Finally
                If Not (lblFont Is Nothing) Then
                    lblFont.Dispose()
                End If
                If Not (brs Is Nothing) Then
                    brs.Dispose()
                End If
                If Not (lblFormat Is Nothing) Then
                    lblFormat.Dispose()
                End If
                If Not (pen Is Nothing) Then
                    pen.Dispose()
                End If
                If Not (sfVLabel Is Nothing) Then
                    sfVLabel.Dispose()
                End If
            End Try
        End Sub 'DrawVerticalLabelArea

        '*********************************************************************
        '
        ' This method draws x axis and all x labels
        '
        '*********************************************************************

        Private Sub DrawXLabelArea(ByVal graph As Graphics)
            Dim lblFont As Font = Nothing
            Dim brs As SolidBrush = Nothing
            Dim lblFormat As StringFormat = Nothing
            Dim pen As Pen = Nothing

            Try
                lblFont = New Font(_fontFamily, _labelFontSize)
                brs = New SolidBrush(_fontColor)
                lblFormat = New StringFormat
                pen = New Pen(_fontColor)

                lblFormat.Alignment = StringAlignment.Center

                ' Draw x axis
                graph.DrawLine(pen, _xOrigin, _yOrigin + _graphHeight, _xOrigin + _graphWidth, _yOrigin + _graphHeight)

                Dim currentX As Single
                Dim currentY As Single = _yOrigin + _graphHeight + 2.0F ' All x labels are drawn 2 pixels below x-axis
                Dim labelWidth As Single = _barWidth + _spaceBtwBars ' Fits exactly below the bar
                Dim i As Integer = 0

                ' Draw x labels
                Dim item As ChartItem
                For Each item In DataPoints
                    currentX = _xOrigin + i * labelWidth
                    Dim recLbl As New RectangleF(currentX, currentY, labelWidth, lblFont.Height)
                    Dim lblString As String = IIf(_displayLegend, item.Label, item.Description)
                    graph.DrawString(lblString, lblFont, brs, recLbl, lblFormat)
                    i += 1
                Next item
            Finally
                If Not (lblFont Is Nothing) Then
                    lblFont.Dispose()
                End If
                If Not (brs Is Nothing) Then
                    brs.Dispose()
                End If
                If Not (lblFormat Is Nothing) Then
                    lblFormat.Dispose()
                End If
                If Not (pen Is Nothing) Then
                    pen.Dispose()
                End If
            End Try
        End Sub 'DrawXLabelArea

        '*********************************************************************
        '
        ' This method determines where to place the legend box.
        ' It draws the legend border, legend description, and legend color code.
        '
        '*********************************************************************

        Private Sub DrawLegend(ByVal graph As Graphics)
            Dim lblFont As Font = Nothing
            Dim brs As SolidBrush = Nothing
            Dim lblFormat As StringFormat = Nothing
            Dim pen As Pen = Nothing

            Try
                lblFont = New Font(_fontFamily, _legendFontSize)
                brs = New SolidBrush(_fontColor)
                lblFormat = New StringFormat
                pen = New Pen(_fontColor)
                lblFormat.Alignment = StringAlignment.Near

                ' Calculate Legend drawing start point
                Dim startX As Single = _xOrigin + _graphWidth + _graphLegendSpacer
                Dim startY As Single = _yOrigin

                Dim xColorCode As Single = startX + _spacer
                Dim xLegendText As Single = xColorCode + _legendRectangleSize + _spacer
                Dim legendHeight As Single = 0.0F
                Dim i As Integer
                For i = 0 To DataPoints.Count - 1
                    Dim point As ChartItem = DataPoints(i)
                    Dim [text] As String = point.Description + " (" + point.Label + ")"
                    Dim currentY As Single = startY + _spacer + i * (lblFont.Height + _spacer)
                    legendHeight += lblFont.Height + _spacer

                    ' Draw legend description
                    graph.DrawString([text], lblFont, brs, xLegendText, currentY, lblFormat)

                    ' Draw color code
                    graph.FillRectangle(New SolidBrush(DataPoints(i).ItemColor), xColorCode, currentY + 3.0F, _legendRectangleSize, _legendRectangleSize)
                Next i

                ' Draw legend border
                graph.DrawRectangle(pen, startX, startY, _legendWidth, legendHeight + _spacer)
            Finally
                If Not (lblFont Is Nothing) Then
                    lblFont.Dispose()
                End If
                If Not (brs Is Nothing) Then
                    brs.Dispose()
                End If
                If Not (lblFormat Is Nothing) Then
                    lblFormat.Dispose()
                End If
                If Not (pen Is Nothing) Then
                    pen.Dispose()
                End If
            End Try
        End Sub 'DrawLegend

        '*********************************************************************
        '
        ' This method calculates all measurement aspects of the bar graph from the given data points
        '
        '*********************************************************************

        Private Sub CalculateGraphDimension()
            FindLongestTickValue()

            ' Need to add another character for spacing; this is not used for drawing, just for calculation
            _longestTickValue += "0"
            _maxTickValueWidth = CalculateImgFontWidth(_longestTickValue, _labelFontSize, FontFamily)
            Dim leftOffset As Single = _spacer + _maxTickValueWidth
            Dim rtOffset As Single = 0.0F

            If _displayLegend Then
                _legendWidth = _spacer + _legendRectangleSize + _spacer + _maxLabelWidth + _spacer
                rtOffset = _graphLegendSpacer + _legendWidth + _spacer
            Else
                rtOffset = _spacer ' Make graph in the middle
            End If
            _graphHeight = _totalHeight - _topBuffer - _bottomBuffer ' Buffer spaces are used to print labels
            _graphWidth = _totalWidth - leftOffset - rtOffset
            _xOrigin = leftOffset
            _yOrigin = _topBuffer

            ' Once the correct _maxValue is determined, then calculate _scaleFactor
            _scaleFactor = _maxValue / _graphHeight
        End Sub 'CalculateGraphDimension

        '*********************************************************************
        '
        ' This method determines the longest tick value from the given data points.
        ' The result is needed to calculate the correct graph dimension.
        '
        '*********************************************************************

        Private Sub FindLongestTickValue()
            Dim currentTick As Single
            Dim tickString As String
            Dim i As Integer
            For i = 0 To _yTickCount - 1
                currentTick = _maxValue - i * _yTickValue
                tickString = currentTick.ToString("#,###.##")
                If _longestTickValue.Length < tickString.Length Then
                    _longestTickValue = tickString
                End If
            Next i
        End Sub 'FindLongestTickValue

        '*********************************************************************
        '
        ' This method calculates the image width in pixel for a given text
        '
        '*********************************************************************

        Private Function CalculateImgFontWidth(ByVal [text] As String, ByVal size As Integer, ByVal family As String) As Single
            Dim bmp As Bitmap = Nothing
            Dim graph As Graphics = Nothing
            Dim font As Font = Nothing

            Try
                font = New Font(family, size)

                ' Calculate the size of the string.
                bmp = New Bitmap(1, 1, PixelFormat.Format32bppArgb)
                graph = Graphics.FromImage(bmp)
                Dim oSize As SizeF = graph.MeasureString([text], font)

                Return oSize.Width
            Finally
                If Not (graph Is Nothing) Then
                    graph.Dispose()
                End If
                If Not (bmp Is Nothing) Then
                    bmp.Dispose()
                End If
                If Not (font Is Nothing) Then
                    font.Dispose()
                End If
            End Try
        End Function 'CalculateImgFontWidth

        '*********************************************************************
        '
        ' This method creates abbreviation from long description; used for making legend
        '
        '*********************************************************************

        Private Function MakeShortLabel(ByVal [text] As String) As String
            Dim label As String = [text]
            If [text].Length > 2 Then
                Dim midPostition As Integer = Convert.ToInt32(Math.Floor(([text].Length / 2)))
                label = [text].Substring(0, 1) + [text].Substring(midPostition, 1) + [text].Substring([text].Length - 1, 1)
            End If
            Return label
        End Function 'MakeShortLabel

        '*********************************************************************
        '
        ' This method calculates the max value and each tick mark value for the bar graph.
        '
        '*********************************************************************

        Private Sub CalculateTickAndMax()
            Dim tempMax As Single = 0.0F

            ' Give graph some head room first about 10% of current max
            _maxValue *= 1.1F

            If _maxValue <> 0.0F Then
                ' Find a rounded value nearest to the current max value
                ' Calculate this max first to give enough space to draw value on each bar
                Dim exp As Double = Convert.ToDouble(Math.Floor(Math.Log10(_maxValue)))
                tempMax = Convert.ToSingle((Math.Ceiling((_maxValue / Math.Pow(10, exp))) * Math.Pow(10, exp)))
            Else
                tempMax = 1.0F
            End If
            ' Once max value is calculated, tick value can be determined; tick value should be a whole number
            _yTickValue = tempMax / _yTickCount
            Dim expTick As Double = Convert.ToDouble(Math.Floor(Math.Log10(_yTickValue)))
            _yTickValue = Convert.ToSingle((Math.Ceiling((_yTickValue / Math.Pow(10, expTick))) * Math.Pow(10, expTick)))

            ' Re-calculate the max value with the new tick value
            _maxValue = _yTickValue * _yTickCount
        End Sub 'CalculateTickAndMax

        '*********************************************************************
        '
        ' This method calculates the height for each bar in the graph
        '
        '*********************************************************************

        Private Sub CalculateSweepValues()
            ' Called when all values and scale factor are known
            ' All values calculated here are relative from (_xOrigin, _yOrigin)
            Dim i As Integer = 0
            Dim item As ChartItem
            For Each item In DataPoints
                ' This implementation does not support negative value
                If item.Value >= 0 Then
                    item.SweepSize = item.Value / _scaleFactor
                End If
                ' (_spaceBtwBars/2) makes half white space for the first bar
                item.StartPos = _spaceBtwBars / 2 + i * (_barWidth + _spaceBtwBars)
                i += 1
            Next item
        End Sub 'CalculateSweepValues

        '*********************************************************************
        '
        ' This method calculates the width for each bar in the graph
        '
        '*********************************************************************

        Private Sub CalculateBarWidth(ByVal dataCount As Integer, ByVal barGraphWidth As Single)
            ' White space between each bar is the same as bar width itself
            _barWidth = barGraphWidth / (dataCount * 2) ' Each bar has 1 white space 
            _spaceBtwBars = _barWidth
        End Sub 'CalculateBarWidth

        '*********************************************************************
        '
        ' This method assigns default value to the bar graph properties and is only 
        ' called from BarGraph constructors
        '
        '*********************************************************************

        Private Sub AssignDefaultSettings()
            ' default values
            _totalWidth = 700.0F
            _totalHeight = 450.0F
            _fontFamily = "Verdana"
            _backColor = Color.White
            _fontColor = Color.Black
            _topBuffer = 30.0F
            _bottomBuffer = 30.0F
            _yTickCount = 2
            _displayLegend = False
            _displayBarData = False
        End Sub 'AssignDefaultSettings
    End Class 'BarGraph
End Namespace

⌨️ 快捷键说明

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