frmcurve.frm

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

      Height          =   255
      Index           =   3
      Left            =   1200
      TabIndex        =   76
      Top             =   4704
      Width           =   375
   End
   Begin VB.Label lbY 
      Alignment       =   1  'Right Justify
      Caption         =   "0"
      Height          =   255
      Index           =   2
      Left            =   1200
      TabIndex        =   75
      Top             =   5376
      Width           =   375
   End
   Begin VB.Label lbY 
      Alignment       =   1  'Right Justify
      Caption         =   "0"
      Height          =   255
      Index           =   1
      Left            =   1200
      TabIndex        =   74
      Top             =   6048
      Width           =   375
   End
   Begin VB.Label lbY 
      Alignment       =   1  'Right Justify
      Caption         =   "0"
      Height          =   235
      Index           =   0
      Left            =   1200
      TabIndex        =   73
      Top             =   6720
      Width           =   375
   End
End
Attribute VB_Name = "frmCurve"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Public MCNum As Long '鼠标点击次数
Public x1 As Single
Public x2 As Single

Dim bShowGrid As Boolean
Dim curData(0 To 2) As Single
Dim curPoint As Long
Dim IsNotFirst As Boolean
 
Private Sub CancelButton_Click()
 Me.Hide
 Call cmdStop_Click
 curPoint = 0
 frmMain.Enabled = True
End Sub

Private Sub ReUpdate()
Dim i As Long, j As Long
If bShowGrid Then
    Pct1.AutoRedraw = True
    Pct1.Cls
    Pct1.Picture = Nothing
    Call DrawXGrid
    Call DrawYGrid
Else
   Pct1.Picture = Nothing
End If
If curPoint > 0 Then
  Pct1.DrawStyle = 0
  For i = 1 To curPoint - 1
    For j = 0 To 2
    If ckCurve(j).Value = 1 Then
     Call Printer(j, i)
    End If
    Next
  Next
End If
Call SetCurrentBackGround
End Sub

Private Sub ckCurve_Click(Index As Integer)
Call ReUpdate
End Sub

Private Sub cmdGridShow_Click()
bShowGrid = Not bShowGrid
Call ReUpdate
End Sub

Private Sub cmdOpen_Click()
On Error Resume Next
Dim i As Long
Dim ss As String
Dim sp() As String
CommonDialog1.Flags = cdlOFNHideReadOnly
' 设置过滤器
CommonDialog1.Filter = "All Files (*.*)|*.*|Curve Files (*.cur)|*.cur"
' 指定缺省的过滤器
CommonDialog1.FilterIndex = 2
CommonDialog1.ShowOpen
If CommonDialog1.filename <> "" Then
    Open CommonDialog1.filename For Input As #1
    curPoint = 0
    Do While Not EOF(1)   ' 循环至文件尾。
       Input #1, ss
       Call ParseStringToStr(ss, sp, "|")
       For i = 0 To 2
         curvep.point(i, curPoint) = Val(sp(i))
       Next
       curPoint = curPoint + 1
    Loop
    Close #1
    Call ReUpdate
End If

End Sub

Private Sub cmdSave_Click()
On Error Resume Next
Dim i As Long
If curPoint = 0 Then
   MsgBox "无曲线保存！", vbOKOnly + vbExclamation, "提示"
   Exit Sub
End If

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

CommonDialog1.ShowSave
If CommonDialog1.filename <> "" Then
    Open CommonDialog1.filename For Output As #1
    For i = 0 To curPoint - 1
      Write #1, curvep.point(0, i) & "|" & curvep.point(1, i) & "|" & curvep.point(2, i) ' 将报警信息写入文件。
    Next
    Close #1
End If
End Sub

Private Sub cmdSet_Click()
Dim i As Long, j As Long
frmXYSet.Show 1
Call ResetXY
End Sub

Private Sub DrawXGrid()
   Dim i As Long
  Dim Xx1 As Long
  Pct1.DrawStyle = vbDot
  Xx1 = Pct1.Width / 20
  For i = 1 To 20
     If i Mod 4 = 0 Then
       Pct1.Line (Xx1 * i, 0)-(Xx1 * i, Pct1.Height), vbBlue
     Else
       Pct1.Line (Xx1 * i, 0)-(Xx1 * i, Pct1.Height), RGB(10, 50, 100)
     End If
  Next
End Sub

Private Sub DrawYGrid()
   Dim i As Long
  Dim Xx1 As Long
  Pct1.DrawStyle = vbDot
  Xx1 = Pct1.Height / 10
  For i = 1 To 10
     If i Mod 3 = 0 Then
       Pct1.Line (0, Xx1 * i)-(Pct1.Width, Xx1 * i), vbBlue
     Else
       Pct1.Line (0, Xx1 * i)-(Pct1.Width, Xx1 * i), RGB(10, 50, 100)
     End If
  Next
End Sub

Private Sub ResetXY()
  Dim i As Long
  For i = 1 To lbX.UBound
     lbX(i).Caption = i * curvep.Xmax / lbX.UBound
  Next
  For i = 1 To lbY.UBound
     lbY(i).Caption = i * curvep.Ymax / lbY.UBound
  Next
End Sub

Private Sub cmdStart_Click()
curPoint = 0
Call ReUpdate
Pct1.DrawStyle = 0
Timer1.Enabled = True
bTimeEnd = True
cmdStart.Enabled = False
cmdStop.Enabled = True
cmdOpen.Enabled = False
cmdSave.Enabled = False
TimeDelay 600
Timer2.Enabled = True
cmdSet.Enabled = False
End Sub

Private Sub cmdStop_Click()
Timer2.Enabled = False
Timer1.Enabled = False
cmdStart.Enabled = True
cmdStop.Enabled = False
cmdSet.Enabled = True
cmdOpen.Enabled = True
cmdSave.Enabled = True
Call ReUpdate
bTimeEnd = False
Ack = False
End Sub

Private Sub cmdX_Click()
Call DrawXGrid
End Sub

Private Sub cmdy_Click()
Call DrawYGrid
End Sub

Private Sub Form_Load()
Call ResetXY
curPoint = 0
bShowGrid = True
IsNotFirst = True
Call ReUpdate
End Sub

Private Sub Form_Activate()
Dim i As Long
If Not IsNotFirst Then
  Exit Sub
End If
SetDlgBackColor Me
Pct1.BackColor = colorSet.colorBackCurve
For i = 0 To ckCurve.UBound
  ckCurve(i).ForeColor = curvep.Color(i)
  picColor(i).BackColor = curvep.Color(i)
Next
Call ReUpdate
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 SetCurrentBackGround()
   SavePicture Pct1.Image, App.Path & "\temp.bmp"
   Pct1.Picture = LoadPicture(App.Path & "\temp.bmp")
End Sub

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

Private Sub ClearBackground()
  Pct1.Picture = Nothing
  Pct1.BackColor = colorSet.colorBackCurve
End Sub

Private Sub Pct1_DblClick()
MCNum = 0
End Sub

Private Sub Pct1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim i As Long, tmp1 As Long, tmp2 As Long
  If cmdStart.Enabled And Button = 1 And curPoint > 0 Then
    MCNum = (MCNum + 1) Mod 3
    If MCNum = 1 Then
       Pct1.Line (X, 0)-(X, Pct1.Height), &HFFFF&
       Call SetCurrentBackGround
       x1 = X
    ElseIf MCNum = 2 Then
       If x1 <> X Then
            Pct1.Line (X, 0)-(X, Pct1.Height), &HFFFF&
            Call SetCurrentBackGround
            x2 = X
            tmp1 = 2 * x1 * curvep.Xmax / Pct1.Width
            tmp2 = 2 * x2 * curvep.Xmax / Pct1.Width
            For i = 0 To 2
              txtRate(i).Text = Format(2 * (curvep.point(i, tmp2) - curvep.point(i, tmp1)) / (tmp2 - tmp1), "0.000")
            Next
       Else
           MCNum = 1
       End If
    Else
       Call ReUpdate
    End If
  End If
End Sub

Private Sub Pct1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim t As Single
Dim i As Long, tmp As Long
lbXY.Caption = Format(X * Val(lbX(20).Caption) * 1# / Pct1.ScaleWidth, "0.00") & ":" & Format((Pct1.ScaleHeight - Y) * Val(lbY(10).Caption) * 1# / Pct1.ScaleHeight, "0.00")
If cmdStart.Enabled And curPoint > 0 Then
   Pct1.Cls
   Pct1.Line (X, 0)-(X, Pct1.Height), RGB(255, 255, 255)
   t = X * curvep.Xmax / Pct1.Width
   tmp = CLng(2 * t)
   For i = 0 To 2
     txtTime(i).Text = Format(t, "0.00")
     txtTemp(i).Text = Format(curvep.point(i, tmp), "0.00")
   Next
End If
End Sub

Private Sub picColor_Click(Index As Integer)
    On Error GoTo Errhandle
    CDlog1.ShowColor
    If CDlog1.Color <> curvep.Color(Index) Then
     curvep.Color(Index) = CDlog1.Color
     ckCurve(Index).ForeColor = curvep.Color(Index)
     picColor(Index).BackColor = curvep.Color(Index)
     Call ReUpdate
     WritePrivateProfileString "Curve", "Color" & Index, CStr(curvep.Color(Index)), iniFile
    End If
    Exit Sub
Errhandle:
    MsgBox Err.description
    Err.Clear
End Sub

Private Sub Timer1_Timer()
    On Error Resume Next
    Dim i As Long, j As Long
    Dim ss As String
'    If Not bTimeEnd Then
'      bTimeEnd = True
'    End If
    If (Not Ack) Then
      Exit Sub
    End If
    For i = 1 To 2
       ss = frmMain.PLCCommand(1, 3, DeviceAbsAdd("D43"), 3, 0, "")
       If ss = "" Then
         TimeDelay 300
       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
    Else
'      For j = 0 To 2
'         curData(j) = 150 + 150 * Cos(second(Time) * 3.14 / 30)
'      Next
    End If
'    bTimeEnd = False
End Sub

Private Sub Timer2_Timer()
    Static b As Boolean
    Dim i As Long, j As Long
    For i = 0 To 2
      curvep.point(i, curPoint) = curData(i)
    Next
    For j = 0 To 2
     If ckCurve(j).Value = 1 Then
       Call Printer(j, curPoint)
     End If
    Next
    curPoint = curPoint + 1
    If curPoint > 2 * Val(lbX(20).Caption) Then
       Call cmdStop_Click
    End If
End Sub

Private Sub Printer(ByVal Index As Long, ByVal p As Long)
  Dim i As Long
  Dim tmpX1 As Single, tmpY1 As Single, tmpX2 As Single, tmpY2 As Single
    If p > 0 Then
       tmpX1 = (p - 1) * Pct1.Width / Val(lbX(20).Caption) / 2
       tmpY1 = Pct1.Height * (1 - curvep.point(Index, p - 1) / Val(lbY(10).Caption))
       tmpX2 = p * Pct1.Width / Val(lbX(20).Caption) / 2
       tmpY2 = Pct1.Height * (1 - curvep.point(Index, p) / Val(lbY(10).Caption))
       Pct1.Line (tmpX1, tmpY1)-(tmpX2, tmpY2), ckCurve(Index).ForeColor
    End If
End Sub