formztls.frm

This is a boiler test system,has been use in factory

         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   240
      Left            =   240
      TabIndex        =   24
      Top             =   150
      Width           =   1200
   End
   Begin VB.Menu exitqx 
      Caption         =   "关闭(&X)"
   End
   Begin VB.Menu xsfw1 
      Caption         =   "显示范围"
   End
End
Attribute VB_Name = "FormZtLs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim pvtt(19, 1440), colorzt(3), zhuangt(1, 3), nyrflg
Dim weizhi(19), DevNam(19)
Dim zbx1, zbx2, stx As Integer
Dim zby2, zby1, sty As Single
Dim MaxY, MinY, DevicNum As Integer

Public Sub hzbx1()
 ''''On Error Resume Next
 Picture1.Cls
 sty = 10 ' Format((zby2 - zby1) / 13, "000.0")
 If zbx2 - zbx1 = 12 Then
   stx = 12
 Else
   stx = (zbx2 - zbx1) \ 24
 End If
 
 Picture1.Scale (-stx * 3.5 + zbx1, zby1 - sty * 2)-(zbx2 + stx * 3, zby2 + sty * 2) '设定标尺
'---------------------------------------------------------------------------------
 Picture1.ForeColor = &H0&
 For p = zby1 To zby2 Step sty
    Picture1.Line (zbx1, p)-(zbx2, p), &HE0E0E0  '画横坐标线
 Next p

 For i% = 0 To DevicNum
   Picture1.PSet (zbx1 - 3.2 * stx, weizhi(i%) + 1), &HFFFFFF
   Picture1.Print DevNam(i%)
 Next
'================================
  Picture1.PSet (8 * stx + zbx1, zby2 + sty), &HFFFFFF '标题位置
  Picture1.FontSize = 14        '标题尺寸
  aa% = Weekday(datetime)
'Labelxq.Caption = Week1(aa%)
  Picture1.FontSize = 10
  Picture1.PSet (zbx1, zby1 - sty), &HFFFFFF  '副标题位置
  Picture1.Print "日  期：" & datetime & " " & Week1(aa%)
  
  Picture1.PSet (zbx2 - 0.5 * stx, zby1 - sty), &HFFFFFF '副标题位置
  Picture1.Print "自动运行时间累计"
'================================
  For q% = zbx1 To zbx2 Step stx
     Picture1.Line (q%, zby1)-(q%, zby2), &HE0E0E0 '纵坐标线
  Next q%
  
  For q% = zbx1 To zbx2 Step stx * 4
     Picture1.Line (q%, zby1)-(q%, zby2), &HC0C0C0
     a1% = q% \ (60 / DataJg) '12
     a2% = (q% - a1% * 60 / DataJg) * DataJg
     Picture1.PSet (q% - 0.5 * stx, zby2 + sty / 5), &HFFFFFF '横坐标值位置
     Picture1.Print Format$(a1%, "00") + ":" + Format$(a2%, "00")
  Next q%
  Picture1.Line (zbx1, zby2)-(zbx2, zby2), &H80000003
  Picture1.Line (zbx1, zby1)-(zbx2, zby1), &H80000003
  Picture1.Line (zbx1, zby2)-(zbx1, zby1), &H80000003
  Picture1.Line (zbx2, zby2)-(zbx2, zby1), &H80000003
 End Sub

Private Sub Command4_Click()
zbx1 = Val(Textzb(2)) * 60 / DataJg
zbx2 = Val(Textzb(3)) * 60 / DataJg
If zbx2 <= zbx1 Then
  ww% = MsgBox("输入错误!,时间起点必须小于终点。", 1, "")
  Textzb(2).SetFocus
  Exit Sub
End If
' zbx1 = 0
' zbx2 = 24 * 60 / DataJg '12 '前48小时
If zbx2 - zbx1 = 12 Then
   If zbx2 = 24 * 12 Then
     zbx1 = zbx1 - 12
   Else
     zbx2 = zbx2 + 12
   End If
End If
'--------------
zby2 = Val(Textzb(1))
zby1 = Val(Textzb(0))
If zby2 <= zby1 Then
   ww% = MsgBox("输入错误!,数值起点必须小于终点。", 1, "")
   Textzb(0).SetFocus
   Exit Sub
End If
hzbx1
disp1

Picture2.Visible = False
End Sub

Private Sub Command5_Click()
Picture2.Visible = False
End Sub
Private Sub exitqx_Click()
qiantai = 1
Unload Me
End Sub
Private Sub Form_Load()
 Me.Icon = LoadPicture(bmpdir & "GRAPH07.ico")
 DevicNum = 4 * 3 - 1 '显示设备数量
 Me.Height = 8760
 Me.Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2

 zby2 = (DevicNum + 1) * 20 - 10
 zby1 = 0
 zbx1 = 0
 zbx2 = 24 * 60 / 5 ' DataJg '12 '前48小时

For i% = 0 To DevicNum
  weizhi(i%) = i% * 20
  DevNam(i%) = DI_Nam(ZTsunx(i%)) '显示设备名称
Next
'========================
colorzt(1) = &HFF00& '开机
colorzt(0) = &HFF&   '停机
colorzt(2) = &H808080 '通讯中断

zhuangt(0, 0) = "手动"
zhuangt(0, 1) = "自动"
zhuangt(1, 0) = "停止"
zhuangt(1, 1) = "工作"

zhuangt(1, 2) = "系统停机"
'-----------------------------------------
 nian$ = Mid$(Date$, 3, 2) '今天日期
 yue$ = Mid$(Date$, 6, 2)
 ri$ = Mid$(Date$, 9, 2)
 Textnyr(0).Text = Mid$(Date$, 1, 4)
 Textnyr(1).Text = Mid$(Date$, 6, 2)
 Textnyr(2).Text = Mid$(Date$, 9, 2)
 nyrflg = 2
 datetime = Mid$(Date$, 1, 4) & "年" & Mid$(Date$, 6, 2) & "月" & Mid$(Date$, 9, 2) & "日"
 Datacl
End Sub

Private Sub readata()
''''On Error Resume Next
Dim lp3 As Integer
Dim ddd(95)
For i% = 0 To DevicNum  '初始化
  For j% = 0 To 1440
    pvtt(i%, j%) = 9899
  Next
Next
If Dir$(filena1) <> "" Then
Open filena1 For Input As #1
  Do While Not EOF(1)
   Input #1, zfc$     '打开文件读数据
   ddd(lp3) = zfc$
   lp3 = lp3 + 1
  '-------
   If InStr(zfc$, "*") Then
      lp3 = 0
      lp2 = Val(Mid$(ddd(0), 2, 2)) * 60 + Val(Mid$(ddd(0), 4, 2))
      lp2 = lp2 \ DataJg
      For ii% = 0 To DevicNum
         pvtt(ii%, lp2) = Val(ddd(ii% + 1))
         If pvtt(ii%, lp2) > 1 Then pvtt(ii%, lp2) = 2
      Next
   End If
 Loop
Close #1
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
exitqx_Click
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
''''On Error Resume Next
Dim ptd
If y < zby1 Or y > zby2 Then Exit Sub
If x < zbx1 Or x > zbx2 Then Exit Sub
'-------------------------------------
ptd = Picture1.Point(x, y)
For i% = 0 To 2
  If ptd = colorzt(i%) Then Exit For
Next
If i% >= 3 Then
   lablexy.Visible = False
   Exit Sub
End If

'----------------------
  aa% = Int(x + 0.5)
  xs% = aa% \ (60 / DataJg) '12 '小时
  fen% = DataJg * (aa% - xs% * 60 / DataJg)  '分
  aaa$ = xs% & ":" & Format$(fen%, "00") & " h"
  ik% = Int(y \ 20)
  bb1$ = DevNam(ik%)
  num1% = 0
 ' If ik% >= 8 Then num1% = 1
  ssc$ = zhuangt(num1%, i%)
  lablexy.Visible = True
  lablexy.Caption = bb1$ + vbCrLf + " " + aaa$ + vbCrLf + ssc$

  If y > zby2 - sty Then
    aay = y - 1.1 * sty
    aax = x + 0.4 * stx
  Else
   aay = y + 1.1 * sty
   aax = x
  End If
  lablexy.Move aax, aay
End Sub
Private Sub Textzb_GotFocus(Index As Integer)
  Textzb(Index).SelStart = 0
  Textzb(Index).SelLength = Len(Textzb(Index).Text)
End Sub



Private Sub xsfw1_Click()
Textzb(0).Text = zby1
Textzb(1).Text = zby2
Picture2.Visible = True
End Sub
Private Sub disp1()
'''On Error Resume Next
Dim sum1(27)
For j% = 0 To DevicNum
  sum1(j%) = 0
  For i% = zbx1 To zbx2 - 1
    If pvtt(j%, i%) <> 9899 Then
      If pvtt(j%, i%) = 1 Then
        sum1(j%) = sum1(j%) + 1
      End If
      Picture1.Line (i%, weizhi(j%) + 1)-(i% + 1, weizhi(j%) + 9), colorzt(pvtt(j%, i%)), BF
    End If '          矩形左下脚         矩形右上脚              边框颜色          实心矩形
  Next
  xiaos = sum1(j%) * DataJg \ 60
  tim1 = Format$(xiaos, "00") & "时 " & Format$(sum1(j%) * DataJg - 60 * xiaos, "00") & "分"
  Picture1.PSet (zbx2 + stx / 3, weizhi(j%) + 1), &HFFFFFF
  Picture1.Print tim1
Next

'aa% = Weekday(datetime)
'Labelxq.Caption = Week1(aa%)
 
End Sub
Private Sub UpDownQs_DownClick()
  nian1$ = Trim$(Textnyr(0).Text)
  yue1$ = Trim$(Textnyr(1).Text)
  ri1$ = Trim$(Textnyr(2).Text)
  '1999.05.03 于沈阳鹭岛
Select Case nyrflg
Case 0
  Date12$ = DateAdd("yyyy", -1, DateSerial(nian1$, yue1$, ri1$)) '以 年("yyyy")为单位
  Date12$ = Format$(Date12$, "yyyy/mm/dd")                    '计算下一天的日期
Case 1
  Date12$ = DateAdd("m", -1, DateSerial(nian1$, yue1$, ri1$)) '以年("yyyy")为单位
  Date12$ = Format$(Date12$, "yyyy/mm/dd")                    '计算下一天的日期
Case 2
  Date12$ = DateAdd("d", -1, DateSerial(nian1$, yue1$, ri1$)) '以日("d")为单位
  Date12$ = Format$(Date12$, "yyyy/mm/dd")                    '计算下一天的日期
End Select
  Textnyr(0) = Mid$(Date12$, 1, 4)
  Textnyr(1) = Mid$(Date12$, 6, 2)
  Textnyr(2) = Mid$(Date12$, 9, 2)
  Datacl

End Sub

Private Sub UpDownQs_UpClick()
  nian1$ = Trim$(Textnyr(0).Text)
  yue1$ = Trim$(Textnyr(1).Text)
  ri1$ = Trim$(Textnyr(2).Text)
  '1999.05.03 于沈阳鹭岛
Select Case nyrflg
Case 0
  Date12$ = DateAdd("yyyy", 1, DateSerial(nian1$, yue1$, ri1$)) '以 年("yyyy")为单位
  Date12$ = Format$(Date12$, "yyyy/mm/dd")                    '计算下一天的日期
Case 1
  Date12$ = DateAdd("m", 1, DateSerial(nian1$, yue1$, ri1$)) '以年("yyyy")为单位
  Date12$ = Format$(Date12$, "yyyy/mm/dd")                    '计算下一天的日期
Case 2
  Date12$ = DateAdd("d", 1, DateSerial(nian1$, yue1$, ri1$)) '以日("d")为单位
  Date12$ = Format$(Date12$, "yyyy/mm/dd")                    '计算下一天的日期
End Select
 ' Starrq$ = Txtnyrnd(0) & "-" & Txtnyrnd(1) & "-" & Txtnyrnd(2)
  If Date12$ > Date$ Then
    ' Textnyr(2).SetFocus
    ' nyrflg = 2
     Exit Sub
  End If
  Textnyr(0) = Mid$(Date12$, 1, 4)
  Textnyr(1) = Mid$(Date12$, 6, 2)
  Textnyr(2) = Mid$(Date12$, 9, 2)
  Datacl
End Sub
Private Sub Textnyr_Click(Index As Integer)
nyrflg = Index
End Sub
Private Sub Datacl()
 nian$ = Mid$(Textnyr(0).Text, 3, 2)
 yue$ = Textnyr(1).Text
 ri$ = Textnyr(2).Text

 datetime = Textnyr(0).Text & "年" & Textnyr(1).Text & "月" & Textnyr(2).Text & "日"

 date1$ = DateAdd("d", 1, DateSerial(nian$, yue$, ri$))
 date1$ = Format$(date1$, "yyyy/mm/dd")

 FileName1$ = datadir + "\" + "y" + nian$ + yue$ + "\" + sydwjc + nian$ + yue$
 filena1 = FileName1$ + ri$ + ".dat"
  If Dir$(filena1) = "" Then '当天
    ' aaa$ = "日期输入错误或 " + nia$ + "-" + yu$ + "-" + rii$ + "记录不存在,!"
    ' rel = MsgBox(aaa$, 1, SysTitle)
    ' Exit Sub
  End If
  
 readata
 hzbx1
 disp1
End Sub