📄 drawcoordinate.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 + -