VB.Net绘制参数曲线走势图的完整类

Public Class DrawCurveClass DrawCurve

定义变量#Region "定义变量"

    Const XOffset As Integer = 50, Yoffset As Integer = 20

    Dim WithEvents PicCurve As PictureBox
    Dim xStep As Single = 5, yStep As Single
    Dim ValueArray As ArrayList
    Dim ThresHold() As Single 'HIHI、HI、LO、LOLO
    Dim Name As String = "参数名"
    Dim Unit As String = "单位"
#End Region

构造函数、析构函数#Region "构造函数、析构函数"
    Public Sub New()Sub New(ByVal mPictureBox As PictureBox, ByVal mThresHold() As Single, ByVal mName As String)
        ValueArray = New ArrayList
        PicCurve = mPictureBox
        ThresHold = mThresHold
        mPictureBox.BorderStyle = BorderStyle.None
        Name = mName
    End Sub

    Protected Overrides Sub Finalize()Sub Finalize()
        MyBase.Finalize()
        ValueArray.Clear()
    End Sub
#End Region

添加要绘制的点的信息#Region "添加要绘制的点的信息"
    Public Sub AddValue()Sub AddValue(ByVal Value As Single)
        'Value = ThresHold(0) * Rnd() + ThresHold(3) '测试代码
        ValueArray.Add(Value)

        Call DrawCurve(GetGraphics(PicCurve))
    End Sub

    Public Sub AddValues()Sub AddValues(ByVal Values() As Single, ByVal G As Graphics)
        For i As Integer = 0 To Values.Length - 1
            ValueArray.Add(Values(i))
        Next
        Call DrawCurve(G)
    End Sub
#End Region

绘制点之间的连线#Region "绘制点之间的连线"
    Private Sub DrawCurve()Sub DrawCurve(ByVal G As Graphics, Optional ByVal mClear As Boolean = True)
        If ValueArray.Count > 0 Then
            If mClear Then G.Clear(Color.White)
            G.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
            Dim mPoints(ValueArray.Count - 1) As Point, Position As Integer = XOffset

            For i As Integer = ValueArray.Count - 1 To 0 Step -1
                Dim ThisValue As Single = CType(ValueArray(i), Single)
                'If Position < PicCurve.Width Then Position += xStep Else Exit For
                Position += xStep
                mPoints(i) = New Point(Position, (ThresHold(0) - ThisValue) * yStep + Yoffset)
            Next
            G.DrawCurve(Pens.Blue, mPoints)

            mPoints = Nothing
        End If
    End Sub
#End Region

绘制坐标系统#Region "绘制坐标系统"
    Private Sub DrawReferenceFrame()Sub DrawReferenceFrame(ByVal G As Graphics)
        Dim mPoint1 As New Point, mPoint2 As New Point
        '定义绘图画笔
        Dim MyPen As New Pen(Color.Black, 3)
        Dim MyStringFormat As New System.Drawing.StringFormat
        MyStringFormat.Alignment = StringAlignment.Center
        Dim mSize As New SizeF

        MyPen.SetLineCap(Drawing2D.LineCap.NoAnchor, Drawing2D.LineCap.ArrowAnchor, Drawing2D.DashCap.Flat)
        Dim mFont As Font = New Font(FontFamily.GenericSansSerif, 12.0F, FontStyle.Bold)

        '绘制Y轴
        MyPen.Color = Color.Black
        mPoint1 = New Point(XOffset, PicCurve.Height)
        mPoint2 = New Point(XOffset, 0)
        G.DrawLine(MyPen, mPoint1, mPoint2)
        '绘制X轴
        MyPen.Color = Color.LightGreen
        mPoint1 = New Point(XOffset, PicCurve.Height / 2)
        mPoint2 = New Point(PicCurve.Width, PicCurve.Height / 2)
        G.DrawLine(MyPen, mPoint1, mPoint2)
        '绘制参数名
        MyStringFormat.FormatFlags = StringFormatFlags.DirectionVertical
        mSize = G.MeasureString(Name, mFont)
        mPoint1.Offset(-mSize.Height, 0)
        G.DrawString(Name, mFont, Brushes.Black, mPoint1, MyStringFormat)

        '绘制参数各门限
        MyPen.DashStyle = Drawing2D.DashStyle.Dash : MyPen.Width = 2
        MyPen.SetLineCap(Drawing2D.LineCap.NoAnchor, Drawing2D.LineCap.NoAnchor, Drawing2D.DashCap.Round)
        'HI
        If ThresHold(1) <> ThresHold(0) Then
            MyPen.Color = Color.Yellow
            mPoint1 = New Point(XOffset, (ThresHold(0) - ThresHold(1)) * yStep + Yoffset)
            mPoint2 = New Point(PicCurve.Width, (ThresHold(0) - ThresHold(1)) * yStep + Yoffset)
            G.DrawLine(MyPen, mPoint1, mPoint2)
            mSize = G.MeasureString(ThresHold(1).ToString, mFont)
            mPoint1.Offset(-mSize.Width, -mSize.Height / 2)
            G.DrawString(ThresHold(1).ToString, mFont, Brushes.Yellow, mPoint1)
        End If
        'LO
        If ThresHold(2) <> ThresHold(3) Then
            mPoint1 = New Point(XOffset, (ThresHold(0) - ThresHold(2)) * yStep + Yoffset)
            mPoint2 = New Point(PicCurve.Width, (ThresHold(0) - ThresHold(2)) * yStep + Yoffset)
            G.DrawLine(MyPen, mPoint1, mPoint2)
            mSize = G.MeasureString(ThresHold(2).ToString, mFont)
            mPoint1.Offset(-mSize.Width, -mSize.Height / 2)
            G.DrawString(ThresHold(2).ToString, mFont, Brushes.Yellow, mPoint1)
        End If
        'HIHI
        MyPen.Color = Color.Red
        mPoint1 = New Point(XOffset, Yoffset)
        mPoint2 = New Point(PicCurve.Width, Yoffset)
        G.DrawLine(MyPen, mPoint1, mPoint2)
        mSize = G.MeasureString(ThresHold(0).ToString, mFont)
        mPoint1.Offset(-mSize.Width, -mSize.Height / 2)
        G.DrawString(ThresHold(0).ToString, mFont, Brushes.Red, mPoint1)
        'LOLO
        mPoint1 = New Point(XOffset, PicCurve.Height - Yoffset)
        mPoint2 = New Point(PicCurve.Width, PicCurve.Height - Yoffset)
        G.DrawLine(MyPen, mPoint1, mPoint2)
        mSize = G.MeasureString(ThresHold(3).ToString, mFont)
        mPoint1.Offset(-mSize.Width, -mSize.Height / 2)
        G.DrawString(ThresHold(3).ToString, mFont, Brushes.Red, mPoint1)

        MyPen.Dispose()
        mFont.Dispose()
    End Sub
#End Region

要在其上绘制的控件事件#Region "要在其上绘制的控件事件"
    Private Sub PicCurve_Paint()Sub PicCurve_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PicCurve.Paint
        Call DrawReferenceFrame(e.Graphics)
    End Sub

    Private Sub PicCurve_Resize()Sub PicCurve_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles PicCurve.Resize
        On Error Resume Next
        xStep = 5
        yStep = (PicCurve.Height - 2 * Yoffset) / (ThresHold(0) - ThresHold(3))
    End Sub
#End Region

绘制永久图像#Region "绘制永久图像"
    Function GetGraphics()Function GetGraphics(ByRef pic As PictureBox) As Graphics
        Dim bmp As Bitmap = New Bitmap(pic.Width, pic.Height)
        pic.Image = bmp

        Dim g As System.Drawing.Graphics = Graphics.FromImage(bmp)
        Return g
    End Function
#End Region

保存图形#Region "保存图形"
    Public Sub SaveCurve()Sub SaveCurve(ByVal FileName As String)
        Dim bmp As New Bitmap(PicCurve.Width, PicCurve.Height)
        Dim g As Graphics = Graphics.FromImage(bmp)
        Call DrawReferenceFrame(g)
        Call DrawCurve(g, False)

        bmp.Save(FileName)
    End Sub
#End Region

End Class