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

📄 drawcoordinate.vb

📁 项目是为日本瑞萨工作所做的BAKE炉温控系统 整个文件夹包括设计文档
💻 VB
字号:
Module DrawCoordinate


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

        Dim g As Graphics
        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

        REM 坐标轴的等分线
        g = PIC.CreateGraphics()
        For i = 1 To 10

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

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

        Next i

        REM 最大值处用一条红色横线标示
        x2 = New Point(x0, y0 - dy * (i - 1)) : y2 = New Point(x0 + dx * (i - 1), y0 - dy * (i - 1)) '线长:5
        g.DrawLine(Pens.Purple, x2, y2)

        REM print X单位
        drawString = "时间(s)" : printX = x0 + dx * i : printY = y0 + 5
        g.DrawString(drawString, drawFont, drawBrush, printX, printY, New StringFormat)

        REM 设定时间显示
        drawString = "设定时间 " & stime & " 分" : printX = x0 + dx * i - 20 : printY = y0 - 50
        g.DrawString(drawString, drawFont, drawBrush, printX, printY, New StringFormat)

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


        REM print Y单位
        drawString = "温度(℃)" : printX = x0 - 49 : printY = y0 - dy * i - 15
        g.DrawString(drawString, drawFont, drawBrush, printX, printY, New StringFormat)

        g.Dispose()

    End Sub


    '***********************************************************************************
    ' 模块名:DrawnLine(画各个连接线段)
    ' 功能:画各个连接线段
    ' 参数:(x0,y0)左下角坐标
    '===================================================================================
    Public Sub DrawnLine(ByVal Pic As PictureBox, 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 Ymax As Integer)
        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 g As Graphics
        Dim drawString As [String]
        Dim printX As Single, printY As Single


        g = Pic.CreateGraphics()
        REM 画点的连线
        For i = 0 To 10

            REM printX刻度
            drawString = X(i) : printX = x0 + dx * i - 5 : printY = y0 + 5 '横标刻度左(5)下(5)处开始标横刻度值

            g.DrawString(drawString, drawFont, drawBrush, printX, printY, New StringFormat)

            REM printY刻度
            If i < 10 Then
                If i = 9 Then
                    drawString = "设定温度" & Int(Ymax / 10 * (i + 1)) : printX = 1 : printY = y0 - dy * (i + 1) - 5 '竖标左(22)上(5)处开始标纵刻度值
                Else
                    drawString = Int(Ymax / 10 * (i + 1)) : printX = x0 - 22 : printY = y0 - dy * (i + 1) - 5 '竖标左(22)上(5)处开始标纵刻度值
                End If
                g.DrawString(drawString, drawFont, drawBrush, printX, printY, New StringFormat)
            End If

            REM 点和线   (最后一点无连线)
            If i < 10 Then      'if i<10 and Y(i+1)<30   then   当再次启动时(温度为最低)画线与先前的不连线
                dot1 = New Point(x0 + dx * (i), y0 - ((dy * 10) * Y(i)) / Ymax)
                dot2 = New Point(x0 + dx * (i + 1), y0 - ((dy * 10) * Y(i + 1)) / Ymax)

                REM Y值增到最大后变最小时,不连线
                'If Y(i) <= Ymax Then
                g.DrawLine(Pens.Blue, dot1, dot2)                '画点的连线
                'End If
            End If

        Next i

        g.Dispose()

    End Sub

    Public Sub Coordinate(ByVal Pic As PictureBox, 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 Ymax As Integer, ByVal clor As Color, ByVal stime As Integer, ByVal dtime As Integer)
        Dim g As Graphics

        g = Pic.CreateGraphics()
        '清空画的图
        g.Clear(clor)

        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 * 10 + 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 * 10 + 30) - 10, y0 - 3), New Point((x0 + dx * 10 + 30), y0)) 'X轴箭头上边
        g.DrawLine(Pens.Blue, New Point((x0 + dx * 10 + 30) - 10, y0 + 3), New Point((x0 + dx * 10 + 30), y0)) 'X轴箭头下边
        'Pic.BackColor = clor  '图片颜色    加此句后,第一次显示会有个"刷屏"变空白的现象

        REM  XY轴等分线和轴名
        DrawXY(Pic, x0, y0, dx, dy, stime, dtime)

        REM 标刻度和画线段
        DrawnLine(Pic, x0, y0, dx, dy, X, Y, Ymax)


    End Sub

End Module

⌨️ 快捷键说明

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