📄 bargraph.vb
字号:
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 + -