p300 正常曲线图
发布网友
发布时间：2022-04-26 05:08
共1个回答
热心网友
时间：2022-06-21 00:27
窗体中的代码
Dim TmEnable As Boolean '记录是不是第一次日启动记时器
Dim VrrTmp(30, 30) As Double '记录横坐标，纵坐标
Dim vrrtmpA(30, 30) As Double, 第二条曲线
Dim intX, intX1 As Integer '直线两端的X坐标值
Dim rtn As String
Dim AllColor, AllColor1 As Double
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Dim RowWidth() As Integer '坚线下边的标识的横坐标
Dim ColHeight() As Integer '横线左边的标识的纵坐标
Private Sub CmdBegin_Click()
Dim i As Integer
Dim KeDu As Integer '定义横坐标的刻度
KeDu = PicSource.ScaleWidth / UBound(VrrTmp)
'数组附初值
For i = 0 To UBound(VrrTmp, 2) - 1
VrrTmp(i, 0) = Rnd * 1300 '纵坐标负值
If i <> 0 Then
VrrTmp(i, 1) = VrrTmp(i - 1, 1) + KeDu '横坐标负值
End If
Next
For i = 0 To UBound(vrrtmpA, 2) - 1
vrrtmpA(i, 0) = Rnd * 900 '纵坐标负值
If i <> 0 Then
vrrtmpA(i, 1) = vrrtmpA(i - 1, 1) + KeDu '横坐标负值
End If
Next
Call DrawLine
' Timer1.Enabled = True
End Sub
Private Sub Form_Load()
Dim i As Integer
PicSource.Scale (0, PicSource.Height)-(PicSource.Width, 0)
TmEnable = False
Call DrawRow(9)
For i = 0 To 8 '下边刻度的值
If i >= 8 Then Exit For
CreatControlRow i + 1, (i + 1) * 3, picwidth + RowWidth(i), PicSource.Top + PicSource.Height + 30
Next i
Call DrawCol(8)
For i = 0 To 7 '左边刻度的值
If i >= 7 Then Exit For
CreatControlCol i + 1, (i + 1) * 2, PicSource.Left - LabCol(0).Width, ColHeight(i)
Next i
End Sub
Private Sub LabT1_Click()
Dim Cc As ChooseColor
Cc.lStructSize = Len(Cc)
Cc.hwndOwner = Me.hWnd
Cc.hInstance = App.hInstance
Cc.flags = 0
Cc.lpCustColors = String$(16 * 4, 0)
rtn = ChooseColor(Cc)
If rtn >= 1 Then
Shape1.FillStyle = 0
Shape1.FillColor = Cc.rgbResult
AllColor = Cc.rgbResult
End If
End Sub
Private Sub LabT2_Click()
Dim Cc As ChooseColor
Cc.lStructSize = Len(Cc)
Cc.hwndOwner = Me.hWnd
Cc.hInstance = App.hInstance
Cc.flags = 0
Cc.lpCustColors = String$(16 * 4, 0)
rtn = ChooseColor(Cc)
If rtn >= 1 Then
Shape2.FillStyle = 0
Shape2.FillColor = Cc.rgbResult
AllColor1 = Cc.rgbResult
End If
End Sub
Private Sub DrawLine()
'画图
'数组的排序为从新到老
Dim TmpArr As Double
Dim i As Integer
PicSource.Cls
AllColor = Shape1.FillColor
If Check1.Value = 1 Then
DrawRow (9)
End If
If Check2.Value = 1 Then
DrawCol (8)
End If
TmpArr = Rnd * 1300
For i = UBound(VrrTmp, 2) - 1 To 1 Step -1
VrrTmp(i, 0) = VrrTmp(i - 1, 0)
Next
VrrTmp(0, 0) = TmpArr '将新得到的数据放到数组的起始位置即第一个
For i = UBound(VrrTmp, 2) - 1 To 1 Step -1
If VrrTmp(i, 0) <> 0 Then
PicSource.Line (VrrTmp(i, 1), -PicSource.ScaleHeight / 2 + VrrTmp(i, 0))-(VrrTmp(i - 1, 1), -PicSource.ScaleHeight / 2 + VrrTmp(i - 1, 0)), AllColor
End If
Next
'第二条曲线
TmpArr = Rnd * 900
For i = UBound(vrrtmpA, 2) - 1 To 1 Step -1
vrrtmpA(i, 0) = vrrtmpA(i - 1, 0)
Next
vrrtmpA(0, 0) = TmpArr '将新得到的数据放到数组的起始位置即第一个
For i = UBound(vrrtmpA, 2) - 1 To 1 Step -1
If vrrtmpA(i, 0) <> 0 Then
PicSource.Line (vrrtmpA(i, 1), -PicSource.ScaleHeight / 2 + vrrtmpA(i, 0))-(VrrTmp(i - 1, 1), -PicSource.ScaleHeight / 2 + vrrtmpA(i - 1, 0)), AllColor1
End If
Next
End Sub
Private Sub PicSource_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Bfb As Integer
LinMov.X1 = X
LinMov.X2 = X
LinMov.Y1 = 0
LinMov.Y2 = PicSource.Height
LinMov.Visible = True
If X <= 10 Or X >= PicSource.ScaleWidth - 180 Then LinMov.Visible = False
If Y <= 70 Or Y >= -(PicSource.ScaleHeight) - 70 Then LinMov.Visible = False
Bfb = PicSource.Height / 7
If LinMov.Visible = True Then
Text1.Text = (GetValue(X, AllColor) / Bfb) * 2
End If
End Sub
Private Function GetValue(ByVal X As Integer, ByVal Canshi As Double) As Double
'得到当前曲线的值
'传入参数：
'X--标准线的横坐标
'对比的条件，曲线的颜色值
Dim j As Integer
Dim TmpColor As Double
For j = 0 To PicSource.Height
TmpColor = GetPixel(PicSource.hdc, X / 15, j / 15)
If TmpColor = Canshi Then
GetValue = -PicSource.ScaleHeight - j
Exit For
End If
Next j
End Function
Private Sub DrawRow(ByVal IntPoint As Integer)
'画网络的竖线
'传入参数:IntPoint--横坐标上的点数
Dim MinUnit As Double '两点之间的距离
Dim H As Integer
ReDim RowWidth(IntPoint - 1)
PicSource.DrawStyle = 2
MinUnit = PicSource.Width / (IntPoint - 1)
For H = 0 To IntPoint - 1
PicSource.Line (MinUnit * (H + 1), 0)-(MinUnit * (H + 1), PicSource.Height), RGB(23, 43, 43)
RowWidth(H) = PicSource.Left + (H + 1) * MinUnit
Next H
PicSource.DrawStyle = 0
End Sub
Private Sub DrawCol(ByVal IntPoint As Integer)
'画网络的横线
'传入参数:IntPoint--横坐标上的点数
Dim MinUnit As Double '两点之间的距离
Dim H As Integer
ReDim ColHeight(IntPoint - 1)
PicSource.DrawStyle = 2
MinUnit = PicSource.Height / (IntPoint - 1)
For H = 0 To IntPoint - 1
PicSource.Line (0, MinUnit * (H + 1))-(PicSource.Width, MinUnit * (H + 1)), RGB(23, 43, 43)
ColHeight(H) = PicSource.Top + (PicSource.Height - MinUnit * (H + 1))
Next H
PicSource.DrawStyle = 0
End Sub
Private Sub CreatControlCol(ByVal Index As Integer, ByVal Name As String, ByVal X As Integer, ByVal Y As Integer)
'动态生成左边的Label控件
'输入参数：
'Index---控件索引
'Name----控件的Caption属性
Load Me.LabCol(Index)
LabCol(Index).Top = LabCol(Index - 1).Top + 2 * LabCol(Index).Height
LabCol(Index).Caption = Name
LabCol(Index).Visible = True
LabCol(Index).Left = X
LabCol(Index).Top = Y
End Sub
Private Sub CreatControlRow(ByVal Index As Integer, ByVal Name As String, ByVal X As Integer, ByVal Y As Integer)
'动态生成下边的Label控件
'输入参数：
'Index---控件索引
'Name----控件的Caption属性
Load Me.LabRow(Index)
LabRow(Index).Top = LabRow(Index - 1).Top + 2 * LabRow(Index).Height
LabRow(Index).Caption = Name & ":" & "00"
LabRow(Index).Visible = True
LabRow(Index).Left = X
LabRow(Index).Top = Y
End Sub
横块中的代码
Option Explicit
'调用颜色对话框
Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long
Type ChooseColor
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
以前写的不成熟的工业曲线画法，送你了
完全可以运行，只要你控件增加的是正确的
