drawcoordinate.vb

项目是为日本瑞萨工作所做的BAKE炉温控系统 整个文件夹包括设计文档

Imports System.Drawing.Pens
Module DrawCoordinate


    '***********************************************************************************
    ' 模块名:DrawXY(画XY的刻度及单位)
    ' 功能:画XY的刻度及单位
    ' 参数:(x,y)左下角坐标
    '===================================================================================
    Public Sub DrawXY(ByRef g As Graphics, ByVal x0 As Single, ByVal y0 As Single, ByVal dx As Single, ByVal dy As Single)

        Dim i As Integer
        Dim x1 As Point, y1 As Point, x2 As Point, y2 As Point

        Dim drawString As [String]
        Dim drawFont As New Font("Arial", 8)
        Dim drawBrush As New SolidBrush(Color.Black)
        Dim printX As Single, printY As Single

        Dim Xmax As Byte = 24
        Dim Ymax As Integer = 200

        REM 画XY轴,               因为之前清掉所有已画的图行,所以坐标也要重新画
        g.DrawLine(Pens.Blue, New Point(x0, y0 - dy * 10 - 30), New Point(x0, y0)) 'Y轴   30为空出长度
        g.DrawLine(Pens.Blue, New Point(x0, y0), New Point(x0 + dx * 24 + 30, y0)) 'X轴   30为空出长度

        g.DrawLine(Pens.Blue, New Point(x0, y0 - dy * 10 - 30), New Point(x0 - 3, (y0 - dy * 10 - 30) + 10)) 'Y轴箭头左边
        g.DrawLine(Pens.Blue, New Point(x0, y0 - dy * 10 - 30), New Point(x0 + 3, (y0 - dy * 10 - 30) + 10)) 'Y轴箭头右边

        g.DrawLine(Pens.Blue, New Point((x0 + dx * 24 + 30) - 10, y0 - 3), New Point((x0 + dx * 24 + 30), y0)) 'X轴箭头上边
        g.DrawLine(Pens.Blue, New Point((x0 + dx * 24 + 30) - 10, y0 + 3), New Point((x0 + dx * 24 + 30), y0)) 'X轴箭头下边


        REM 画Y坐标的等分线
        For i = 1 To 10
            x2 = New Point(x0, y0 - dy * i) : y2 = New Point(x0 + 5, y0 - dy * i) '线长:5
            g.DrawLine(Pens.Purple, x2, y2)

            REM printY刻度
            drawString = Int(Ymax / 10 * i) : printX = x0 - 22 : printY = y0 - dy * i - 5 '竖标左(22)上(5)处开始标纵刻度值
            g.DrawString(drawString, drawFont, drawBrush, printX, printY, New StringFormat)
        Next i
        REM print Y单位
        drawString = "温度(℃)" : printX = x0 - 49 : printY = y0 - dy * i - 10
        g.DrawString(drawString, drawFont, drawBrush, printX, printY, New StringFormat)

        REM 画X坐标的等分线
        For i = 1 To 24
            x1 = New Point(x0 + dx * i, y0) : y1 = New Point(x0 + dx * i, y0 - 10) '线长:10
            g.DrawLine(Pens.Red, x1, y1)

            REM printX刻度
            drawString = Int(Xmax / 24 * i) : printX = x0 + dx * i - 5 : printY = y0 + 5 '横标刻度左(5)下(5)处开始标横刻度值
            g.DrawString(drawString, drawFont, drawBrush, printX, printY, New StringFormat)
        Next i
        REM print X单位
        drawString = "时间(h)" : printX = x0 + dx * i : printY = y0 + 5
        g.DrawString(drawString, drawFont, drawBrush, printX, printY, New StringFormat)

        g.Dispose()

    End Sub


    '***********************************************************************************
    ' 模块名:DrawnLine(画各个连接线段)
    ' 功能:画各个连接线段
    ' 参数:(x0,y0)左下角坐标
    '===================================================================================
    Public Sub DrawnLine(ByRef g As Graphics, ByVal x0 As Single, ByVal y0 As Single, ByVal dx As Single, ByVal dy As Single, ByVal X As Byte, ByVal Y As Integer, ByVal stemp As Integer, ByVal stime As Int16, ByVal dtime As Int16)
        Dim i, j As Integer
        Dim dot1 As Point, dot2 As Point
        Dim drawFont As New Font("Arial", 8)
        Dim drawBrush As New SolidBrush(Color.Black)
        Dim drawString As [String]
        Dim printX As Single, printY As Single
        Dim Ymax As Integer = 200

        ''''REM 点   
        ''''If Y <> 0 Then
        ''''    Dim tmpTime As Long
        ''''    tmpTime = Microsoft.VisualBasic.DateAndTime.Timer    '获取系统时间
        ''''    Dim t1, t2 As Integer
        ''''    t1 = Int(tmpTime / 3600)        '获取当前小时数
        ''''    t2 = tmpTime Mod 3600           '获取当前一小时内的秒数
        ''''    Dim x1, y1, y2 As Single
        ''''    x1 = x0 + dx * t1 + (dx * t2) / 3600
        ''''    y1 = y0 - ((dy * 10) * Y) / Ymax
        ''''    y2 = y1 + 1.5
        ''''    ' g.DrawEllipse(Pens.Blue, x1, y1, 2, 2)    '以小椭圆
        ''''    g.DrawLine(Pens.Blue, x1, y1, x1, y2)
        ''''End If
        REM 设定时间显示
        drawString = "设定时间 " & stime & " 分" : printX = x0 + dx * 25 - 20 : printY = y0 - 50
        g.DrawString(drawString, drawFont, drawBrush, printX, printY, New StringFormat)

        REM 当前时间显示
        drawString = "当前时间 " & dtime & " 分" : printX = x0 + dx * 25 - 20 : printY = y0 - 30
        g.DrawString(drawString, drawFont, drawBrush, printX, printY, New StringFormat)


        REM 设定温度显示
        drawString = "设定温度" : printX = 1 : printY = y0 - ((dy * 10) * stemp) / Ymax - 5
        g.DrawString(drawString, drawFont, drawBrush, printX, printY, New StringFormat)

        REM 设定温度处用一条黄色横线标示
        dot1 = New Point(x0, y0 - ((dy * 10) * stemp) / Ymax) : dot2 = New Point(x0 + dx * 24, y0 - ((dy * 10) * stemp) / Ymax) '线长:5
        g.DrawLine(Pens.Yellow, dot1, dot2)

        REM 自定义虚线类型
        Dim newPen As New Pen(Color.Red)
        Dim s As Single() = {4, 4, 4, 4}
        newPen.DashPattern = s

        REM 设定温度上10度处用红色虚线表示
        dot1 = New Point(x0, y0 - ((dy * 10) * (stemp + 10)) / Ymax) : dot2 = New Point(x0 + dx * 24, y0 - ((dy * 10) * (stemp + 10)) / Ymax) '线长:5
        g.DrawLine(newPen, dot1, dot2)

        REM 设定温度下10度处用红色虚线表示
        dot1 = New Point(x0, y0 - ((dy * 10) * (stemp - 10)) / Ymax) : dot2 = New Point(x0 + dx * 24, y0 - ((dy * 10) * (stemp - 10)) / Ymax) '线长:5
        g.DrawLine(newPen, dot1, dot2)

        g.Dispose()

    End Sub

    Public Sub DrawnPoint(ByRef g As Graphics, ByVal x0 As Single, ByVal y0 As Single, ByVal dx As Single, ByVal dy As Single, ByVal Y As Integer)
        Dim Ymax As Integer = 200

        REM 点   
        If Y <> 0 Then
            Dim tmpTime As Long
            tmpTime = Microsoft.VisualBasic.DateAndTime.Timer    '获取系统时间
            Dim t1, t2 As Integer
            t1 = Int(tmpTime / 3600)        '获取当前小时数
            t2 = tmpTime Mod 3600           '获取当前一小时内的秒数
            Dim x1, y1, y2 As Single
            x1 = x0 + dx * t1 + (dx * t2) / 3600
            y1 = y0 - ((dy * 10) * Y) / Ymax
            y2 = y1 + 1.5
            ' g.DrawEllipse(Pens.Blue, x1, y1, 2, 2)    '以小椭圆
            g.DrawLine(Pens.Blue, x1, y1, x1, y2)
        End If

    End Sub

    Public Sub Coordinate(ByVal Pic As PictureBox, ByVal X() As Byte, ByVal Y() As Integer, ByVal clor As Color, ByVal stime As Integer, ByVal dtime As Integer, ByVal stemp As Integer)
        Dim g1, g2, g0, g3 As Graphics
        Dim x0, y0 As Single
        Dim dx, dy As Single
        Dim buffer0 As New Bitmap(1056, 472)  '由图片框大小确定
        Dim buffer2 As New Bitmap(1056, 472)  '由图片框大小确定

        '      Dim buffer2 As New Bitmap(992, 472)

        REM 坐标原点
        x0 = 70 : y0 = 420

        REM 每刻度的缇数***************注意:y0>(dy*10 +30)
        dx = 35 : dy = 35

        REM  XY轴、等分线和轴名
        Pic.Image = buffer1
        g1 = Graphics.FromImage(buffer1)
        DrawXY(g1, x0, y0, dx, dy)
        '        buffer1.Save(System.IO.Directory.GetParent(Application.StartupPath).FullName & "\DataBase\tmp1.bmp")

        REM 标刻度和画线段
        Pic.Image = buffer2
        g2 = Graphics.FromImage(buffer2)
        DrawnLine(g2, x0, y0, dx, dy, X(24), Y(24), stemp, stime, dtime)
        '        buffer2.Save(System.IO.Directory.GetParent(Application.StartupPath).FullName & "\DataBase\tmp2.bmp")

        g0 = Graphics.FromImage(buffer0)
        '        g0.Clear(clor)      '清空画的图     （加此句后，不可重叠到buffer0图片上）
        buffer1.MakeTransparent(Color.Fuchsia)
        g0.DrawImage(buffer1, New Point(0, 0))
        '        buffer0.Save(System.IO.Directory.GetParent(Application.StartupPath).FullName & "\DataBase\tmp4.bmp")

        Pic.Image = buffer3
        g3 = Graphics.FromImage(buffer3)
        DrawnPoint(g3, x0, y0, dx, dy, Y(24))

        buffer3.MakeTransparent(Color.Fuchsia)
        g0.DrawImage(buffer3, New Point(0, 0))

        g0 = Graphics.FromImage(buffer0)
        buffer2.MakeTransparent(Color.Fuchsia)
        g0.DrawImage(buffer2, New Point(0, 0))
        '        buffer0.Save(System.IO.Directory.GetParent(Application.StartupPath).FullName & "\DataBase\tmp.bmp")


        Pic.Image = buffer0
        Pic.Refresh()



    End Sub

End Module