formdatarb.frm

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

Private Sub Form_Unload(Cancel As Integer)
closebb_Click
End Sub

Private Sub Optionql_Click(Index As Integer)
 glsel = Index
 '-----蒸汽系统----报表量顺序temp(20)=l1,l2,l3,l4,l5,l6,0,0,0,0,a1,a2,a3,........
 llnum% = 10 '流量累计数量
 xunxnum(0) = 0 + 2 * glsel '-----------蒸汽流量累计
 xunxnum(1) = 2 + llnum% + glsel * Ainumgl '蒸汽流量
 xunxnum(2) = 0 + llnum% + glsel * Ainumgl '蒸汽压力
 xunxnum(3) = 16 + llnum% + glsel * Ainumgl '蒸汽温度
 '-----给水系统----
 xunxnum(4) = 1 + 2 * glsel '-----------给水流量累计
 xunxnum(5) = 3 + llnum% + glsel * Ainumgl '给水流量
 xunxnum(6) = 17 + llnum% + glsel * Ainumgl '给水压力
 xunxnum(7) = 8 + llnum% + glsel * Ainumgl '汽包水位
 xunxnum(8) = 7 + llnum% + glsel * Ainumgl '给水变频
 '-----空气系统----
 xunxnum(9) = 10 + llnum% + glsel * Ainumgl '鼓风机出口风压
 xunxnum(10) = 5 + llnum% + glsel * Ainumgl '鼓风转速
 xunxnum(11) = 6 + llnum% + glsel * Ainumgl '炉排转速
 '-----烟气系统----
 xunxnum(12) = 1 + llnum% + glsel * Ainumgl '炉膛负压
 xunxnum(13) = 14 + llnum% + glsel * Ainumgl '炉膛温度
 
 xunxnum(14) = 12 + llnum% + glsel * Ainumgl '省煤器出口烟压
 xunxnum(15) = 15 + llnum% + glsel * Ainumgl '省煤器出口烟温
 xunxnum(16) = 9 + llnum% + glsel * Ainumgl '引风机出口烟压
 xunxnum(17) = 11 + llnum% + glsel * Ainumgl '除尘器出口烟压"
 xunxnum(18) = 13 + llnum% + glsel * Ainumgl '除尘器出口烟温"
 xunxnum(19) = 4 + llnum% + glsel * Ainumgl '引风转速"
 xunxnum(20) = 17 + llnum% + glsel * Ainumgl '引风机转速
 disp
End Sub

Private Sub print1_Click()
  Dim rel
  rel = MsgBox("是否打印？", 36, SysTitle)
  If rel = 7 Then Exit Sub
  
  pcol% = MSGrid1.Cols '列
  pwos% = MSGrid1.Rows '行
  Printer.FontSize = 7
  Printer.Orientation = 2 '1-纵向打印,2-横向打印
  Printer.PaperSize = vbPRPSA3 'A4打印纸
 
    X1 = 0: X2 = pcol% * 10   'colnum
    y1 = 0: y2 = pwos% * 10 'rownum
    Printer.Scale (-17 + X1, y1 - 40)-(X2 + 10, y2 + 40)
    For i% = 0 To pcol%   '画竖坐标线12
      If i% = 0 Or i% = 1 Or i% = 5 Or i% = 10 Or i% = 13 Or i% = 23 Then
         Printer.Line (gridwid(i%), y1)-(gridwid(i%), y2 - 40) '长竖线
      Else
         Printer.Line (gridwid(i%), y1 + 10)-(gridwid(i%), y2 - 50) '长竖线
      End If
    Next i%
'-------------------------------------------------------------------------------
    For i% = y1 To y2 - 40 Step 10
     If i% = 10 Then
       Printer.Line (X1 + 10, i%)-(X2, i%)
     Else '水平线
       If i% <> 20 Then
         Printer.Line (X1, i%)-(X2, i%)
       End If
     End If
    Next
 '-------------------------------
    Printer.DrawWidth = 2
    Printer.Line (X2, y1)-(X2, y2) '画外框线
    Printer.Line (X1, y1)-(X1, y2)
    Printer.Line (X1, y1)-(X2, y1)
    Printer.Line (X1, y2)-(X2, y2)
    Printer.DrawWidth = 1
'-----------------------------大部分程序的第一行----------
  '  For i% = 0 To pcol% - 1
  '    Printer.PSet (gridwid(i%) + 2, 1), &HFFFFFF
  '    Printer.Print MSGrid1.TextMatrix(0, i%) '第一行
  '  Next
'-------------------本例的第一行----------
Printer.FontSize = 12
    Printer.PSet (gridwid(2) + 1, 2), &HFFFFFF
    Printer.Print "蒸 汽 系 统"
    Printer.PSet (gridwid(7) + 1, 2), &HFFFFFF
    Printer.Print "给 水 系 统"
    Printer.PSet (gridwid(11) - 2, 2), &HFFFFFF
    Printer.Print "空 气 系 统"
    Printer.PSet (gridwid(16) + 2, 2), &HFFFFFF
    Printer.Print "烟   气   系   统"
Printer.FontSize = 10
    For jj% = y1 To y2 - 20 Step 10 '行
      row11 = 1 + (jj% / 10)
      If row11 >= MSGrid1.Rows Then Exit For
      For i% = 0 To pcol% - 1
         If row11 < 3 Then
           Printer.PSet (gridwid(i%) + btdif(i%), jj% + 12), &HFFFFFF
         Else
           Printer.PSet (gridwid(i%) + numdif(i%), jj% + 12), &HFFFFFF
         End If
         Printer.Print MSGrid1.TextMatrix(row11, i%)
      Next
    Next
    Printer.FontSize = 22
    Printer.PSet (X1 + 88, y1 - 27), &HFFFFFF: Printer.Print biaoti(glsel)
    Printer.FontSize = 10
    Printer.Line (X1 + 75, y1 - 14)-(X1 + 135, y1 - 14)
   ' Printer.PSet (X2 - 40, y1 - 14), &HFFFFFF: Printer.Print "数据日期：" & datetime
    Printer.PSet (X1 + 10, y1 - 10), &HFFFFFF: Printer.Print datetime & "  " & Label3.Caption
    Printer.PSet (X2 - 60, y2 + 10), &HFFFFFF: Printer.Print "打印日期：" & Date$ & "  " & Time$
    Printer.EndDoc
End Sub

Private Sub printview_Click()
If printview.Caption = "打印预览(&V)" Then
    printview.Caption = "关闭预览(&V)"
    Picture1.Width = 15075
    Picture1.Height = 10335
 Else
   printview.Caption = "打印预览(&V)"
   Picture1.Visible = False
   Exit Sub
 End If
  Picture1.Visible = True
  Picture1.Cls
  pcol% = MSGrid1.Cols '列
  pwos% = MSGrid1.Rows '行
  Picture1.FontSize = 7
    X1 = 0: X2 = pcol% * 10   'colnum
    y1 = 0: y2 = pwos% * 10 'rownum
    Picture1.Scale (-10 + X1, y1 - 40)-(X2 + 10, y2 + 40)
    For i% = 0 To pcol%   '画竖坐标线12
      If i% = 0 Or i% = 1 Or i% = 5 Or i% = 10 Or i% = 13 Or i% = 23 Then
         Picture1.Line (gridwid(i%), y1)-(gridwid(i%), y2 - 40) '长竖线，表下面空4行
      Else
         Picture1.Line (gridwid(i%), y1 + 10)-(gridwid(i%), y2 - 50) '短竖线
      End If
    Next i%
'-------------------------------------------------------------------------------
    For i% = y1 To y2 - 40 Step 10 '水平线，表下面空4行
     If i% = 10 Then
       Picture1.Line (X1 + 10, i%)-(X2, i%)
     Else '水平线
       If i% <> 20 Then
         Picture1.Line (X1, i%)-(X2, i%)
       End If
     End If
    Next
 '-------------------------------
    Picture1.DrawWidth = 2
    Picture1.Line (X2, y1)-(X2, y2) '画外框线
    Picture1.Line (X1, y1)-(X1, y2)
    Picture1.Line (X1, y1)-(X2, y1)
    Picture1.Line (X1, y2)-(X2, y2)
    Picture1.DrawWidth = 1
'-----------------------------大部分程序的第一行----------
  '  For i% = 0 To pcol% - 1
  '    Picture1.PSet (gridwid(i%) + 2, 1), &HFFFFFF
  '    Picture1.Print MSGrid1.TextMatrix(0, i%) '第一行
  '  Next
'-------------------本例的第一行----------
  Picture1.FontSize = 9
    Picture1.PSet (gridwid(2) + 1, 2), &HFFFFFF
    Picture1.Print "蒸 汽 系 统"
    Picture1.PSet (gridwid(7) + 1, 2), &HFFFFFF
    Picture1.Print "给 水 系 统"
    Picture1.PSet (gridwid(11) - 2, 2), &HFFFFFF
    Picture1.Print "空 气 系 统"
    Picture1.PSet (gridwid(16) + 2, 2), &HFFFFFF
    Picture1.Print "烟   气   系   统"
  Picture1.FontSize = 7
    For jj% = y1 To y2 - 20 Step 10 '行
      row11 = 1 + (jj% / 10) '从2行开始打印
      If row11 >= MSGrid1.Rows Then Exit For
      For i% = 0 To pcol% - 1
         If row11 < 3 Then
           Picture1.PSet (gridwid(i%) + btdif(i%), jj% + 12), &HFFFFFF
         Else
           Picture1.PSet (gridwid(i%) + numdif(i%), jj% + 12), &HFFFFFF
         End If
         Picture1.Print MSGrid1.TextMatrix(row11, i%)
      Next
    Next
    Picture1.FontSize = 22
    Picture1.PSet (X1 + 80, y1 - 27), &HFFFFFF: Picture1.Print biaoti(glsel)
    Picture1.FontSize = 9
    Picture1.Line (X1 + 75, y1 - 10)-(X1 + 135, y1 - 10)
   ' Picture1.PSet (X2 - 40, y1 - 14), &HFFFFFF: Picture1.Print "数据日期：" & datetime
    Picture1.PSet (X1 + 10, y1 - 10), &HFFFFFF: Picture1.Print datetime & "  " & Label3.Caption
    Picture1.PSet (X2 - 60, y2 + 10), &HFFFFFF: Picture1.Print "打印日期：" & Date$ & "  " & Time$
End Sub

Private Sub setp_Click()
 CommonDialog1.Action = 5
End Sub
Private Sub Textnyr_Click(Index As Integer)
nyrflg = Index
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 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")
 
 filena3 = datadir + "\" + "y" + Mid$(date1$, 3, 2) + Mid$(date1$, 6, 2) + "\" '今天文件名
 filena3 = filena3 + sydwjc + Mid$(date1$, 3, 2) + Mid$(date1$, 6, 2) + Mid$(date1$, 9, 2) + ".dat"

 FileName1$ = datadir + "\" + "y" + nian$ + yue$ + "\" + sydwjc + nian$ + yue$
 filena1 = FileName1$ + ri$ + ".dat"
 RD_Data
 disp
End Sub
Private Sub disp()
''On Error Resume Next
MSGrid1.Clear
MSGrid1.TextMatrix(1, 0) = " 时 间"
MSGrid1.TextMatrix(0, 2) = "蒸  汽"
MSGrid1.TextMatrix(0, 3) = "系  统"
MSGrid1.TextMatrix(0, 6) = "供  水"
MSGrid1.TextMatrix(0, 7) = "系  统"
MSGrid1.TextMatrix(0, 11) = "空  气"
MSGrid1.TextMatrix(0, 12) = "系  统"
MSGrid1.TextMatrix(0, 17) = "烟  气"
MSGrid1.TextMatrix(0, 18) = "系  统"
'-------------------------------------------
MSGrid1.TextMatrix(1, 1) = "产汽量"
MSGrid1.TextMatrix(2, 1) = " (t)"
MSGrid1.TextMatrix(1, 2) = "流 量"
MSGrid1.TextMatrix(2, 2) = "(t/h)"
MSGrid1.TextMatrix(1, 3) = "压 力"
MSGrid1.TextMatrix(2, 3) = "(Mpa)"
MSGrid1.TextMatrix(1, 4) = "温 度"
MSGrid1.TextMatrix(2, 4) = "(℃)"

MSGrid1.TextMatrix(1, 5) = "供水量"
MSGrid1.TextMatrix(2, 5) = " (t)"
MSGrid1.TextMatrix(1, 6) = "流 量"
MSGrid1.TextMatrix(2, 6) = "(t/h)"
MSGrid1.TextMatrix(1, 7) = "压 力"
MSGrid1.TextMatrix(2, 7) = "(Mpa)"
MSGrid1.TextMatrix(1, 8) = "汽包水位"
MSGrid1.TextMatrix(2, 8) = "(mm)"
MSGrid1.TextMatrix(1, 9) = "给水变频"
MSGrid1.TextMatrix(2, 9) = "速(rpm)"


MSGrid1.TextMatrix(1, 10) = "鼓风机出口"
MSGrid1.TextMatrix(2, 10) = "风压(Pa)"
MSGrid1.TextMatrix(1, 11) = "鼓风机转"
MSGrid1.TextMatrix(2, 11) = "速(rpm)"
MSGrid1.TextMatrix(1, 12) = "炉排转速"
MSGrid1.TextMatrix(2, 12) = "(rpm)"

MSGrid1.TextMatrix(1, 13) = "炉膛负压"
MSGrid1.TextMatrix(2, 13) = " (Pa)"
MSGrid1.TextMatrix(1, 14) = "炉膛温度"
MSGrid1.TextMatrix(2, 14) = " (℃)"
MSGrid1.TextMatrix(1, 15) = "省煤器出"
MSGrid1.TextMatrix(2, 15) = "烟压(Pa)"
MSGrid1.TextMatrix(1, 16) = "省煤器出"
MSGrid1.TextMatrix(2, 16) = "烟温(℃)"
MSGrid1.TextMatrix(1, 17) = "引风机出"
MSGrid1.TextMatrix(2, 17) = "烟压(Pa)"
MSGrid1.TextMatrix(1, 18) = "除尘器出"
MSGrid1.TextMatrix(2, 18) = "烟压(Pa)"
MSGrid1.TextMatrix(1, 19) = "除尘器出"
MSGrid1.TextMatrix(2, 19) = "烟温(℃)"
MSGrid1.TextMatrix(1, 20) = "引风机转"
MSGrid1.TextMatrix(2, 20) = "速(rpm)"
MSGrid1.TextMatrix(1, 21) = "备注"
MSGrid1.TextMatrix(2, 21) = " "
'--------------
MSGrid1.TextMatrix(27, 0) = "日累计"
MSGrid1.TextMatrix(28, 0) = "7:00-15:00 早班班长："
MSGrid1.TextMatrix(29, 0) = "记事："
MSGrid1.TextMatrix(28, 9) = "15:00-23:00 中班班长："
MSGrid1.TextMatrix(29, 9) = "记事："
MSGrid1.TextMatrix(28, 16) = "23:00-7:00 夜班班长："
MSGrid1.TextMatrix(29, 16) = "记事："
 aa% = Weekday(datetime)
 Label3.Caption = Week1(aa%)
 Labelbt.Caption = biaoti(glsel)
'----------------------填表----------------------------
    For i% = 0 To RecordNum
      MSGrid1.TextMatrix(i% + 3, 0) = dddtim(i%)
      For j% = 0 To 19 '去掉开度、炉排转速
        MSGrid1.TextMatrix(i% + 3, j% + 1) = temp1(xunxnum(j%), i%)
      Next
    Next
    MSGrid1.TextMatrix(27, 1) = SumLL(xunxnum(0)) & " 吨"
    MSGrid1.TextMatrix(27, 5) = SumLL(xunxnum(4)) & " 吨"
End Sub
Private Sub RD_Data()
 Dim lp2, lp3 As Integer

 Dim ddd(95)
 If Dir$(filena1) <> "" Then
   Open filena1 For Input As #1
     tim$ = "30"
     Do While Not EOF(1)
     Input #1, zfc$     '打开文件读数据
     ddd(lp3) = zfc$
     lp3 = lp3 + 1
     If InStr(zfc$, "*") Then
       lp3 = 0
       Flagtim$ = Mid$(ddd(0), 2, 2)
       If tim$ <> Flagtim$ And Val(Flagtim$) >= 7 Then '从7点开始
         tim$ = Flagtim$ '每小时取一个数据
         dddtim(lp2) = Flagtim$ & ":" & Mid$(ddd(0), 4, 2)
         For j% = 0 To BlnumZA(0) + 10 'BlnumZA(0)个模拟量+10个流量累计
            temp1(j%, lp2) = Val(ddd(2 + ztnum + j%)) ''时间,1+ztnum 个状态,10个流量累计,ai1,ai2,....
         Next
         lp2 = lp2 + 1
       End If
   End If
   Loop
   Close #1
   End If
'---------'当天个记录----
If Dir$(filena3) <> "" Then
   Open filena3 For Input As #1
     Do While Not EOF(1)
     Input #1, zfc$     '打开文件读数据
     If InStr(zfc$, "@") Then lp3 = 0
     ddd(lp3) = zfc$
     lp3 = lp3 + 1
     If zfc$ = "*" Then
       lp3 = 0
       Flagtim$ = Mid$(ddd(0), 2, 2)
       If tim$ <> Flagtim$ And Val(Flagtim$) <= 7 Then '到次日7点结束
         tim$ = Flagtim$ '每小时取一个数据
         dddtim(lp2) = Flagtim$ & ":" & Mid$(ddd(0), 4, 2)
         For j% = 0 To BlnumZA(0) + 10
            temp1(j%, lp2) = Val(ddd(2 + ztnum + j%))
         Next
         lp2 = lp2 + 1
       End If
   End If
   Loop
   Close #1
  End If
'---------------
  lp2 = lp2 - 1
  RecordNum = lp2
  If lp2 > 25 Then lp2 = 25
  If lp2 >= 0 Then
'--------------流量-----------
    For i% = 0 To 9
       lishi = temp1(i%, 0)
       SumLL(i%) = temp1(i%, lp2) - lishi
    Next
    For i% = 0 To 9
      For j% = 0 To lp2
        temp1(i%, j%) = Format(temp1(i%, j%), "#####0.0")
      Next
      SumLL(i%) = Format(SumLL(i%), "#####0.0")
    Next
  End If
  
End Sub