ctlrtcurve.ctl

毕业设计 单片机 采集温度rs232上传 电脑显示温度曲线 包含源码 可以数据保存

VERSION 5.00
Begin VB.UserControl RTCu 
   AutoRedraw      =   -1  'True
   BackColor       =   &H8000000C&
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   5700
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   7620
   ClipBehavior    =   0  'None
   ControlContainer=   -1  'True
   EditAtDesignTime=   -1  'True
   FillStyle       =   0  'Solid
   MouseIcon       =   "CTLRTC~1.ctx":0000
   PropertyPages   =   "CTLRTC~1.ctx":0152
   ScaleHeight     =   5700
   ScaleWidth      =   7620
   ToolboxBitmap   =   "CTLRTC~1.ctx":01A9
   Begin VB.PictureBox pBox 
      BackColor       =   &H00000000&
      FillStyle       =   0  'Solid
      Height          =   4965
      Left            =   120
      ScaleHeight     =   4905
      ScaleWidth      =   7230
      TabIndex        =   0
      Top             =   120
      Width           =   7290
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Height          =   180
         Left            =   1650
         TabIndex        =   1
         Top             =   2250
         Visible         =   0   'False
         Width           =   90
      End
      Begin VB.Line LineX 
         BorderStyle     =   3  'Dot
         Visible         =   0   'False
         X1              =   -15
         X2              =   2085
         Y1              =   690
         Y2              =   690
      End
      Begin VB.Line LineY 
         BorderStyle     =   3  'Dot
         Visible         =   0   'False
         X1              =   1005
         X2              =   1005
         Y1              =   0
         Y2              =   1530
      End
   End
   Begin VB.Menu munuPoup 
      Caption         =   "munuPoup"
      Visible         =   0   'False
      Begin VB.Menu manuZoomIn 
         Caption         =   "放大"
      End
      Begin VB.Menu manuZoomOut 
         Caption         =   "缩小"
      End
      Begin VB.Menu manuAll 
         Caption         =   "全部"
      End
   End
End
Attribute VB_Name = "RTCu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
'2。实时曲线
'3。历史曲线 V
'     时间轴X  单一
'     数据值Y
Option Explicit                          '声明属性
Private mCaption As String               'TITLE
Private mXParName As String             '参数名

Private ValueArray() As Single '存放数据的数组
Private mLineColor As OLE_COLOR '= Propbag.ReadProperty("BackColor", &H80000005)
Private mGridColor As OLE_COLOR 'GridColor
Private mShowGrid As Boolean
Private mMovingGrid As Boolean
Private mHorzSplits As Long
Private mVertSplits As Long
Private mMax As Single


Private pBoxHeight As Long
Private pBoxWidth As Long
Private StartPosition As Long
Private GridPosition As Long

Public Enum DrawLineType
    TYPE_LINE = 0
    TYPE_POINT = 1
End Enum
Public LineType As DrawLineType '划线的类型：线或点
Const const_tolerance = 0.0001 '误差

'声明事件
Event MyError(MyErrorString As String)
Event MenuInfor(munIndex As Integer)
Event Click()
Event DbClick()
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)
Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Event Resize()

Public Function InitDrawLine()
    pBox.ScaleMode = vbPixels
    pBoxHeight = pBox.ScaleHeight
    pBoxWidth = pBox.ScaleWidth
    '分配数组
    ReDim ValueArray(pBoxWidth - 1)
   StartPosition = pBoxWidth - 1
     'StartPosition = 1
    GridPosition = 0
    pBox.BackColor = UserControl.BackColor
End Function
Public Sub AddValue(value As Single, iPix As Integer)
    Dim l As Long
    Dim ii As Integer
    For ii = 0 To iPix
        '将数组所有值移动一位。
        For l = 1 To pBoxWidth - 1
            ValueArray(l - 1) = ValueArray(l)
        Next
        If mMax <= 0 Then mMax = 1
        '把新的值添加到数组的最后一个元素。
        ValueArray(l - 1) = pBoxHeight - ((value / mMax) * pBoxHeight)
        If StartPosition >= 1 Then StartPosition = StartPosition - 1
        GridPosition = GridPosition - 1
    Next
End Sub
Public Sub RePaint()
    Dim x As Single
    Dim y As Single
    Dim l As Long
    '首先清除图片，然后画网格(如果有的话)，最后画线。
    pBox.Cls
    If (mShowGrid) Then '如果使用网格，则画网格
        pBox.ForeColor = mGridColor
        If (mMovingGrid) Then
            For x = GridPosition To pBoxWidth - 1 Step ((pBoxWidth - 1) / (mVertSplits + 1)) - const_tolerance
                pBox.Line (x, 0)-(x, pBoxHeight)
            Next
        Else:
            For x = 0 To pBoxWidth - 1 Step ((pBoxWidth - 1) / (mVertSplits + 1)) - const_tolerance
                pBox.Line (x, 0)-(x, pBoxHeight)
            Next
        End If
        For y = 0 To pBoxHeight - 1 Step ((pBoxHeight - 1) / (mHorzSplits + 1)) - const_tolerance
            pBox.Line (0, y)-(pBoxWidth, y)
        Next
        '网格复位
        If GridPosition <= -Int((pBoxWidth - 1 / (mHorzSplits + 1))) Then
            GridPosition = 0
        End If
    End If
    '画数据线
    If StartPosition <= pBoxWidth - 1 Then
        pBox.ForeColor = mLineColor
        Select Case LineType
            Case TYPE_LINE
                For l = StartPosition + 1 To pBoxWidth - 2
                pBox.Line (l, ValueArray(l))-(l + 1, ValueArray(l + 1))
            Next
            Case TYPE_POINT
                For l = StartPosition + 1 To pBoxWidth - 2
                pBox.PSet (l + 1, ValueArray(l + 1))
            Next
        End Select
    End If

End Sub

Private Sub pBox_Click()
  RaiseEvent Click
End Sub

Private Sub pBox_DblClick()
  RaiseEvent DbClick
End Sub

Private Sub UserControl_Initialize()
Dim Li As Integer
Dim sstime As Double
On Error Resume Next
End Sub

Private Sub UserControl_InitProperties()
Dim Li As Integer
On Error Resume Next

End Sub

Public Sub meResize()
    Call UserControl_Resize
End Sub

Private Sub UserControl_Resize() '重画
Dim Li As Integer
'Dim mline As Object
Dim xPre As Single, yPre As Single
'On Error Resume Next
    pBox.Left = 30
    pBox.Width = UserControl.Width - 130
    pBox.Top = 30
    pBox.Height = UserControl.Height - 130

    pBox.Cls

    pBox.Refresh
End Sub

Private Sub UserControl_AmbientChanged(PropertyName As String)
    PropertyName = "BackColor"
    UserControl.BackColor = Ambient.BackColor
End Sub

'Caption Property
Public Property Get Caption() As String
Attribute Caption.VB_ProcData.VB_Invoke_Property = "PropertyPage1"
    Caption = mCaption
End Property
Public Property Let Caption(ByVal vNewValue As String)
    mCaption = vNewValue
    PropertyChanged "Caption"
End Property


'ToolTipText Property
Public Property Get ToolTipText() As String
Attribute ToolTipText.VB_ProcData.VB_Invoke_Property = "PropertyPage1"
    ToolTipText = pBox.ToolTipText
End Property
Public Property Let ToolTipText(ByVal vNewValue As String)
    pBox.ToolTipText = vNewValue
    PropertyChanged "ToolTipText"
End Property

Public Property Get BackColor() As OLE_COLOR
    BackColor = UserControl.BackColor
End Property

Public Static Property Let BackColor(ByVal vNewValue As OLE_COLOR)
     UserControl.BackColor = vNewValue
     pBox.BackColor = vNewValue
     PropertyChanged "BackColor"
End Property

'LineColor
Public Property Get LineColor() As OLE_COLOR
    LineColor = mLineColor
End Property

Public Static Property Let LineColor(ByVal vNewValue As OLE_COLOR)
     mLineColor = vNewValue
     PropertyChanged "LineColor"
End Property

'mGridColor
Public Property Get GridColor() As OLE_COLOR
    GridColor = mGridColor
End Property

Public Static Property Let GridColor(ByVal vNewValue As OLE_COLOR)
     mGridColor = vNewValue
     PropertyChanged "GridColor"
End Property

'mShowGrid
Public Property Get ShowGrid() As Boolean
    ShowGrid = mShowGrid
End Property

Public Static Property Let ShowGrid(ByVal vNewValue As Boolean)
     mShowGrid = vNewValue
     PropertyChanged "ShowGrid"
End Property
 
'mMovingGrid
Public Property Get MovingGrid() As Boolean
    MovingGrid = mMovingGrid
End Property

Public Static Property Let MovingGrid(ByVal vNewValue As Boolean)
     mMovingGrid = vNewValue
     PropertyChanged "MovingGrid"
End Property

' mHorzSplits As Long
Public Property Get HorzSplits() As Long
    HorzSplits = mHorzSplits
End Property

Public Static Property Let HorzSplits(ByVal vNewValue As Long)
     mHorzSplits = vNewValue
     PropertyChanged "HorzSplits"
End Property

' mVertSplits As Long
Public Property Get VertSplits() As Long
    VertSplits = mVertSplits
End Property

Public Static Property Let VertSplits(ByVal vNewValue As Long)
     mVertSplits = vNewValue
     PropertyChanged "VertSplits"
End Property

'mMax As Single
Public Property Get Max() As Single
    Max = mMax
End Property

Public Static Property Let Max(ByVal vNewValue As Single)
     mMax = vNewValue
     PropertyChanged "Max"
End Property

'读取属性值
Private Sub UserControl_ReadProperties(Propbag As PropertyBag)
    UserControl.BackColor = Propbag.ReadProperty("BackColor", &H0)
    mLineColor = Propbag.ReadProperty("LineColor", vbRed)
    mGridColor = Propbag.ReadProperty("GridColor", vbGreen)
    pBox.ToolTipText = Propbag.ReadProperty("ToolTipText", "")
    mShowGrid = Propbag.ReadProperty("ShowGrid", True)
    mMovingGrid = Propbag.ReadProperty("MovingGrid", True)
    mHorzSplits = Propbag.ReadProperty("HorzSplits", 9)
    mVertSplits = Propbag.ReadProperty("VertSplits", 9)
    mMax = Propbag.ReadProperty("Max", 100)
End Sub

'保存属性值
Private Sub UserControl_WriteProperties(Propbag As PropertyBag)
    Propbag.WriteProperty "BackColor", UserControl.BackColor, &H0
    Propbag.WriteProperty "LineColor", mLineColor, vbRed
    Propbag.WriteProperty "GridColor", mGridColor, vbGreen
    Propbag.WriteProperty "ToolTipText", pBox.ToolTipText, ""

    Propbag.WriteProperty "ShowGrid", mShowGrid, True
    Propbag.WriteProperty "MovingGrid", mMovingGrid, True
    Propbag.WriteProperty "HorzSplits", mHorzSplits, 9
    Propbag.WriteProperty "VertSplits", mVertSplits, 9
    Propbag.WriteProperty "Max", mMax, 200
    
End Sub