frmcurvetest.frm

回流焊监控系统-DCS,VB编写,对PLC进行通讯采集和控制,界面直观,操作方便,可以作为同类软件系统提供示范

         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   4
      Left            =   5024
      TabIndex        =   41
      Top             =   8880
      Width           =   735
   End
   Begin VB.Label lbDT 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "0.0"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   5
      Left            =   6010
      TabIndex        =   40
      Top             =   8880
      Width           =   735
   End
   Begin VB.Label lbDT 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "0.0"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   6
      Left            =   6996
      TabIndex        =   39
      Top             =   8880
      Width           =   735
   End
   Begin VB.Label lbDT 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "0.0"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   7
      Left            =   7982
      TabIndex        =   38
      Top             =   8880
      Width           =   735
   End
   Begin VB.Label lbDT 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "0.0"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   8
      Left            =   8968
      TabIndex        =   37
      Top             =   8880
      Width           =   735
   End
   Begin VB.Label lbDT 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "0.0"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Index           =   9
      Left            =   9960
      TabIndex        =   36
      Top             =   8880
      Width           =   735
   End
   Begin VB.Label Label2 
      Caption         =   "平均值"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   5160
      TabIndex        =   35
      Top             =   6840
      Width           =   735
   End
   Begin VB.Label Label1 
      Caption         =   "斜率"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   0
      Left            =   4200
      TabIndex        =   34
      Top             =   6840
      Width           =   615
   End
   Begin VB.Label lbCurrent 
      Caption         =   "00:00"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   2760
      TabIndex        =   30
      Top             =   6840
      Width           =   975
   End
   Begin VB.Label lbLast 
      Caption         =   "00:00"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   1560
      TabIndex        =   29
      Top             =   6840
      Width           =   1095
   End
   Begin XPCURVELibCtl.OnCurve OnCurve2 
      Height          =   5955
      Left            =   10560
      OleObjectBlob   =   "frmCurveTest.frx":04FB
      TabIndex        =   59
      Top             =   0
      Width           =   270
   End
End
Attribute VB_Name = "frmCurveTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim flag_move As Boolean
Dim ptcount As Long
Dim largeX As Single
Dim startT As Single
Private Sub ckCurveShow_Click(Index As Integer)
OnCurve1.SetCurveVisual Index + 1

OnCurve1.UpdateDraw
End Sub

Private Sub ckHide_Click()
If ckHide.Value = 1 Then
  OnCurve1.GridColor = OnCurve1.GridBkColor
  
Else
  OnCurve1.GridColor = &H7800&
End If

OnCurve1.UpdateDraw
OnCurve2.GridColor = OnCurve1.GridColor
OnCurve2.UpdateDraw
End Sub

Private Sub ckShowX_Click()
If ckShowX.Value = 1 Then
  OnCurve1.GridXNum = 1
Else
  OnCurve1.GridXNum = 10
End If

OnCurve1.UpdateDraw
OnCurve2.GridXNum = OnCurve1.GridXNum
OnCurve2.UpdateDraw
End Sub

Private Sub ckShowY_Click()
If ckShowY.Value = 1 Then
  OnCurve1.GridYNum = 1
Else
  OnCurve1.GridYNum = 10
End If

OnCurve1.UpdateDraw
OnCurve2.GridYNum = OnCurve1.GridYNum
OnCurve2.UpdateDraw
End Sub

Private Sub ckStart_Click()
ckStart.Enabled = False
TimeDelay 500
If ckStart.Value = 0 Then
   bTimeEnd = False
   Timer1.Enabled = False
Else
   bTimeEnd = True
   Timer1.Enabled = True
End If
ckStart.Enabled = True
End Sub

Private Sub cmdMove_Click(Index As Integer)
 Dim dtime As Long
Select Case (Index)
  Case 0
    flag_move = True
    OnCurve1.TimeScrollMin
  Case 1
   flag_move = True
    OnCurve1.TimeScroll -1
  Case 2
     OnCurve1.GetCurveTime 0, dtime
     If OnCurve1.TimeAxisStartTime >= dtime Then
       flag_move = False
      End If
     OnCurve1.TimeScroll 1
  Case 3
   flag_move = False
   OnCurve1.TimeScrollMax
End Select
End Sub

Private Sub cmdOpen_Click()
CommonDialog1.Flags = cdlOFNHideReadOnly
' 设置过滤器
CommonDialog1.Filter = "All Files (*.*)|*.*|Curve Files (*.rec)|*.rec"
' 指定缺省的过滤器
CommonDialog1.FilterIndex = 2
CommonDialog1.ShowOpen
If CommonDialog1.filename <> "" Then
'  Debug.Print CommonDialog1.FileName
  OnCurve1.ClearData
  OnCurve1.ReadCurveData -1, CommonDialog1.filename, 1
End If
End Sub

Private Sub cmdPrinter_Click()
   OnCurve1.PrintCurve Printer.DeviceName, 10, 15, 10, 10, 1, 0
   OnCurve1.UpdateDraw
End Sub

Private Sub cmdSave_Click()
CommonDialog1.Flags = cdlOFNHideReadOnly
' 设置过滤器
CommonDialog1.Filter = "All Files (*.*)|*.*|Curve Files (*.rec)|*.rec"
' 指定缺省的过滤器
CommonDialog1.FilterIndex = 2

CommonDialog1.ShowSave
If CommonDialog1.filename <> "" Then
'  Debug.Print CommonDialog1.FileName
  OnCurve1.SaveCurveDataPt -1, CommonDialog1.filename, ptcount
  OnCurve1.UpdateDraw
End If
End Sub

Private Sub cmdStart_Click()
ckStart.Value = 1
cmdStart.Enabled = Not ckStart.Enabled
cmdStop.Enabled = ckStart.Enabled
startT = Timer
End Sub

Private Sub cmdStop_Click()
ckStart.Value = 0
cmdStart.Enabled = ckStart.Enabled
cmdStop.Enabled = Not ckStart.Enabled
End Sub

Private Sub cmdYlen_Click()
If Val(txtYLen.Text) < Val(txtYLow.Text) Then
  Exit Sub
End If
OnCurve1.DataAxisMin = Val(txtYLow.Text)
OnCurve1.DataAxisMax = Val(txtYLen.Text)
OnCurve2.DataAxisMin = Val(txtYLow.Text)
OnCurve2.DataAxisMax = Val(txtYLen.Text)
End Sub

Private Sub cmdZoom_Click(Index As Integer)
  On Error Resume Next
  If Index = 0 Then
   If OnCurve1.TimeAxisTimePix < 150 Then
    OnCurve1.TimeAxisTimePix = OnCurve1.TimeAxisTimePix * 2
   End If
'   largeX = largeX * 2
  Else
   If OnCurve1.TimeAxisTimePix > 0.03 Then
    OnCurve1.TimeAxisTimePix = OnCurve1.TimeAxisTimePix / 2
   End If
'   largeX = largeX / 2
  End If
  OnCurve1.TimeAxisDiffTime = 100 / OnCurve1.TimeAxisTimePix
'  Debug.Print OnCurve1.TimeAxisTimePix
'  If largeX > 2 ^ 2 Then
'    OnCurve1.TimeAxisShowType = 12
'  ElseIf largeX < 2 ^ (-1) Then
'   OnCurve1.TimeAxisShowType = 1
'  Else
'   OnCurve1.TimeAxisShowType = 2
'  End If
  OnCurve1.UpdateDraw
  OnCurve2.TimeAxisTimePix = OnCurve1.TimeAxisTimePix
  OnCurve2.TimeAxisDiffTime = OnCurve1.TimeAxisDiffTime
  OnCurve2.UpdateDraw
End Sub

Private Sub Form_Load()
   Dim dtime As String
   dtime = Format(Date, "yyyy-mm-dd") & "#" & Format(Time, "hh:mm:ss")
   With OnCurve1
      .CurveNum = 3
      .SetCurveBufPt 8640
      .SetCurveLine 1, 0, 1, &HFF00&                '上行温度0-600
      .SetCurveLine 2, 0, 1, &HFF&                '下行温度曲线0-600
      .SetCurveLine 3, 0, 1, &HFFFF&             '入炉蒸气压力0-0.16
      .RecPath = App.Path & "\history"
      .SetCurveYSize 1, 0, 300
      .SetCurveYSize 2, 0, 300
      .SetCurveYSize 3, 0, 300

      .SetRMouseLine 1, &HFF&
      .SetRMouseLine 2, &HFF&
      .RMouseNum = 2
'      .ReadCurveData -1, .RecPath & "\\" & Date & ".REC", 1
      .InputC3Data dtime, 0, 0, 0   '打印温度曲线,夹套液位
      .UpdateDraw
   End With
   largeX = 1
   ckCurveShow(0).BackColor = &HFF00&
   ckCurveShow(1).BackColor = &HFF&
   ckCurveShow(2).BackColor = &HFFFF&
   largeX = 1
End Sub

Private Sub OnCurve1_ClickIn(ByVal X As Long, ByVal Y As Long, ByVal btime As String)
Static lastdata(0 To 3) As Double
Static lasttime As Single
Static lastT As String
On Error Resume Next
Dim currenttime As Single
Dim i As Long
Dim currentdata(0 To 3) As Double
Dim k As Date
For i = 1 To OnCurve1.CurveNum
   OnCurve1.GetTimeData btime, i, currentdata(i - 1)
'   Debug.Print btime
   
   currenttime = CDate(Right(btime, 8)) '& "#")
   If currenttime <> lasttime Then
     txtRate(i - 1).Text = Format((currentdata(i - 1) - lastdata(i - 1)) / (currenttime - lasttime) / 24 / 60 / 60, "0.000")
   End If
   txtLast(i - 1).Text = Format(lastdata(i - 1), "0.000")
   txtCurrent(i - 1).Text = Format(currentdata(i - 1), "0.000")
   lastdata(i - 1) = currentdata(i - 1)
   txtAve(i - 1) = Format(OnCurve1.GetTimeAveData(i), "0.000")
Next
lbLast.Caption = lastT
lastT = Right(btime, 8)
lbCurrent.Caption = lastT
lasttime = currenttime
OnCurve1.UpdateDraw
End Sub

Private Sub optShow_Click(Index As Integer)
OnCurve1.GridYType = 1 - Index
OnCurve1.UpdateDraw
OnCurve2.GridYType = 1 - Index
OnCurve2.UpdateDraw
End Sub

Private Sub Timer1_Timer()
 Dim dtime As String, ss As String
 Dim curData(0 To 2) As Single
 Dim i As Long, j As Long
 Dim prg As Single
 On Error Resume Next
 If ckStart.Value = 1 Then
    For i = 1 To 2
       ss = frmMain.PLCCommand(1, 3, DeviceAbsAdd("D43"), 3, 0, "")
       If ss = "" Then
         TimeDelay 100
       Else
         Exit For
       End If
    Next
    If ss <> "" Then
      ss = Mid(ss, 8, 12)
      For j = 0 To 2
         curData(j) = Hex2Dec(Mid(ss, 4 * j + 1, 4))
      Next
    End If
    dtime = Format(Date, "yyyy-mm-dd") & "#" & Format(Time, "hh:mm:ss") '
    OnCurve1.InputC3Data dtime, curData(0), curData(1), curData(2)   '打印温度曲线
    If Not flag_move Then
      OnCurve1.SetShowTimeStart dtime
    End If
    ptcount = ptcount + 1
    prg = (Timer - startT + 86400) Mod 86400
    If Val(txtTime.Text) <> 0 Then
      prgTest.Value = 1000 * prg / Val(txtTime.Text)
    End If
    If prg > Val(txtTime.Text) Then
       Call cmdStop_Click
    End If
 End If
End Sub

Private Sub CancelButton_Click()
 Me.Hide
 If ckStart.Value = 1 Then
   ckStart.Value = 0
 End If
 ptcount = 0
 OnCurve1.ClearData
 frmMain.Enabled = True
End Sub

Private Sub Form_Activate()
Dim i As Long, j As Long
SetDlgBackColor Me
OnCurve1.GridBkColor = colorSet.colorBackCurve
OnCurve2.GridBkColor = colorSet.colorBackCurve

For i = 0 To lbUT.UBound
  lbUT(i).Caption = frmMain.lbUT(i).Caption
  lbUT(i).Visible = frmMain.lbUT(i).Visible
  lbDT(i).Caption = frmMain.lbDT(i).Caption
  lbDT(i).Visible = frmMain.lbDT(i).Visible
  Label1(1).Visible = oOption(iCurrentOption).bOption(22)
Next


End Sub
Private Sub Form_Unload(Cancel As Integer)
Call CancelButton_Click
Cancel = 1
End Sub