formt497.frm

vb20061013（VB编程运用软件）

            TimerT497(0).Interval = TIMER0INTERVAL
'-------------------------------------------------------
        Case 3  '停止测试
            LabelT497(7).Caption = "就绪"
            TimerT497(0).Interval = 0
            TimerT497(1).Interval = 0
            PowerOff
            LedOff
            BeepOff
            blBegin = False
'-------------------------------------------------------
        Case 4  '数据转存
        With AdodcT497.Recordset
            If TimerT497(0).Interval <> 0 Then
                MsgBox "测试进行中,不能转存数据,请先关闭测试!", vbOKOnly, "497 马达间歇测试"
                Exit Sub
            End If
            
            If .RecordCount = 0 Then
                MsgBox "没有可转存的记录,功能停止!", vbOKOnly, "497 马达间歇测试"
            Else
                .MoveFirst
                For i = 1 To .RecordCount
                    rsT497.AddNew
                    For j = 1 To MAXFIELDS
                        rsT497.Fields(j) = .Fields(j)
                    Next j
                    .MoveNext
                Next i
                .UpdateBatch
                MsgBox "497 马达间歇测试记录转存完毕!", vbOKOnly, "497 马达间歇测试"
            End If
        End With
'-------------------------------------------------------
        Case 5  '关闭窗口
            Unload Me
'-------------------------------------------------------
        Case 6  '重新设置
            For i = 0 To 5
                TextT497(i).Text = ""
            Next i
'-------------------------------------------------------
        Case 7  '报表打印
            RecordPrint
'-------------------------------------------------------
    End Select
End Sub

Private Sub Form_Load()
    Dim varTemp As Variant
    Dim i, j As Integer
    Dim sTemp As String
    Dim dTime As Date
    
   
    LabelT497(7).Caption = "等待..."
    
    
    initParallel                    '进行并口设置
    LedOn
    vbBeep 5
    TimerT497(0).Interval = 0       '原始数据设置
    TimerT497(1).Interval = 0
    CommandT497_Click (0)
    CommandT497_Click (6)
    TextT497(0).Text = Str(Now())
    Set rsT497 = New ADODB.Recordset    '打开全表数据库
    rsT497.Open "select * from 全表_497马达时间测试 order by 测试时间", cnT497, adOpenKeyset, adLockOptimistic
    LabelT497(7).Caption = "就绪"
End Sub

'字节置位,清零函数 bByte(Byte),bBit(0-7),bValue(0,1)
Private Function bit(ByVal bByte As Byte, ByVal bBit As Integer, ByVal bValue As Integer) As Byte

    Dim sTemp As String
    Dim i, j, k, iTemp As Integer
    Select Case bBit
        Case 0
            If bValue = 0 Then
                bit = bByte And &HFE
            Else
                bit = bByte Or &H1
            End If
        Case 1
            If bValue = 0 Then
                bit = bByte And &HFD
            Else
                bit = bByte Or &H2
            End If
        Case 2
            If bValue = 0 Then
                bit = bByte And &HFB
            Else
                bit = bByte Or &H4
            End If
        Case 3
            If bValue = 0 Then
                bit = bByte And &HF7
            Else
                bit = bByte Or &H8
            End If
        Case 4
            If bValue = 0 Then
                bit = bByte And &HEF
            Else
                bit = bByte Or &H10
            End If
        Case 5
            If bValue = 0 Then
                bit = bByte And &HDF
            Else
                bit = bByte Or &H20
            End If
        Case 6
            If bValue = 0 Then
                bit = bByte And &HBF
            Else
                bit = bByte Or &H40
            End If
        Case 7
            If bValue = 0 Then
                bit = bByte And &H7F
            Else
                bit = bByte Or &H80
            End If
    End Select
End Function
Private Sub vbBeep(ByVal BeepInterval As Integer)
    Dim i As Integer
    BeepOn
    iBeepCounter = BeepInterval
    TimerT497(1).Interval = TIMER1INTERVAL
End Sub

Private Sub initParallel()
    Out &H37A, INIT37A
    Out &H378, INIT378
    Out &H379, INIT379
End Sub

Private Sub PowerOn()
    Dim bTemp As Byte
    bTemp = bit(Inp(&H37A), CNTPOW, 0)
    Out &H37A, bTemp
End Sub

Private Sub PowerOff()
    Dim bTemp As Byte
    bTemp = bit(Inp(&H37A), CNTPOW, 1)
    Out &H37A, bTemp
End Sub

Private Sub LedOn()
    Dim bTemp As Byte
    bTemp = bit(Inp(&H37A), CNTLED, 0)
    Out &H37A, bTemp
End Sub

Private Sub LedOff()
    Dim bTemp As Byte
    bTemp = bit(Inp(&H37A), CNTLED, 1)
    Out &H37A, bTemp
End Sub

Private Sub BeepOn()
    Dim bTemp As Byte
    bTemp = bit(Inp(&H37A), CNTBEP, 0)
    Out &H37A, bTemp
End Sub

Private Sub BeepOff()
    Dim bTemp As Byte
    bTemp = bit(Inp(&H37A), CNTBEP, 1)
    Out &H37A, bTemp
End Sub

Private Sub TimerT497_Timer(Index As Integer)
    Dim Ti, Tj, Tk, Ttemp, Tsecond, TMinute As Integer
    Dim B378, B379 As Byte
    Dim Ttime As Date
    Dim sTemp As String
    Dim blTemp As Boolean
    Select Case Index
        Case 0  '测试计秒
            Tsecond = DateDiff("s", Tstart(10), Now())  '秒表显示
            LabelT497(0).Caption = Str(TimeSerial(0, Tsecond \ 60, Tsecond Mod 60))
            If blLed = True Then    'LED 闪动
                If iLedCounter > LEDCOUNTER Then
                    LedOn
                    blLed = False
                    iLedCounter = 0
                End If
                iLedCounter = iLedCounter + 1
            Else
                If iLedCounter > LEDCOUNTER Then
                    LedOff
                    blLed = True
                    iLedCounter = 0
                End If
                iLedCounter = iLedCounter + 1
            End If
            B378 = Inp(&H378)       '取端口数据
            Out &H379, &HFF
            B379 = Inp(&H379)
            For Ti = MOTO0 To MOTO7  '0-7号测试位
                If CheckT497(Ti) = 1 Then
                    blTemp = vBit(B378, Ti)
                    '第一个时间必须为运行
                    If iRecordNo(Ti) = STARTNO - 1 Then
                        If blTemp = False Then
                            Tstart(Ti) = Now()
                            GoTo TLoop1
                        Else
                            iRecordNo(Ti) = STARTNO
                        End If
                    End If
                    If blTemp <> blState(Ti) Then  '有跳变
                        Tsecond = DateDiff("s", Tstart(i), Now())   '与近次起始时间比较
                        Tsecond = AdjustTime(Tsecond, Ti)
                        If Tsecond < MinSecond Then                 '小于3妙,默认为抖动,不作为
                            Exit For
                        End If
                        FindRecord (Ti)
                        AdodcT497.Recordset.Fields(iRecordNo(Ti)) = TimeSerial(0, Tsecond \ 60, Tsecond Mod 60)
                        AdodcT497.Recordset.Update
                        iRecordNo(Ti) = iRecordNo(Ti) + 1     '记录位置更新
                        blState(Ti) = blTemp                 '状态更新
                        Tstart(Ti) = Now()                   '起始时间更新
                    End If
                End If
TLoop1:
            Next Ti
            For Ti = MOTO8 To MOTO9  '8-9号测试位
                If CheckT497(Ti + 4) = 1 Then
                    blTemp = vBit(B379, Ti)
                    '第一个时间必须为运行
                    If iRecordNo(Ti + 4) = STARTNO - 1 Then
                        If blTemp = False Then
                            Tstart(Ti + 4) = Now()
                            GoTo TLoop2
                        Else
                            iRecordNo(Ti + 4) = STARTNO
                        End If
                    End If
                    If blTemp <> (blState(Ti + 4)) Then  '有跳变
                        Tsecond = DateDiff("s", Tstart(Ti + 4), Now())
                        Tsecond = AdjustTime(Tsecond, Ti + 4)
                        If Tsecond < MinSecond Then                 '小于3妙,默认为抖动,不作为
                            GoTo TLoop2
                        End If
                        FindRecord (Ti + 4)
                        AdodcT497.Recordset(iRecordNo(Ti + 4)) = TimeSerial(0, Tsecond \ 60, Tsecond Mod 60)
                        AdodcT497.Recordset.Update
                        iRecordNo(Ti + 4) = iRecordNo(Ti + 4) + 1
                        blState(Ti + 4) = blTemp
                        Tstart(Ti + 4) = Now()
                    End If
                End If
TLoop2:
            Next Ti
            '如果有1个测试位已经测试到最后一个记录,则停止测试
            For Ti = 0 To 9
                If iRecordNo(Ti) = 21 Then
                    TimerT497(0).Interval = 0
                    MsgBox "  497马达间隔测试完毕!  ", vbOKOnly, "497马达间隔测试"
                    LabelT497(7).Caption = "就绪"
                    vbBeep 30
                    LedOff
                    TimerT497(0).Interval = 0
                    Exit Sub
                End If
            Next Ti
            TimerT497(0).Interval = TIMER0INTERVAL
        Case 1  '蜂鸣计秒
            TimerT497(1).Interval = TIMER1INTERVAL
            iBeepCounter = iBeepCounter - 1
            If iBeepCounter < 0 Then
                TimerT497(1).Interval = 0
                BeepOff
                LedOff
            End If
    End Select
End Sub

'检查对应位是否为1,为1返回TRUE 否则返回FALSE
Private Function vBit(ByVal bPort As Byte, ByVal bPosition As Integer) As Boolean
    Dim bTemp(8), bL As Byte
    bTemp(0) = &H1
    bTemp(1) = &H2
    bTemp(2) = &H4
    bTemp(3) = &H8
    bTemp(4) = &H10
    bTemp(5) = &H20
    bTemp(6) = &H40
    bTemp(7) = &H80
    bL = bPort And bTemp(bPosition)
    If bL = 0 Then
        vBit = False
    Else
        vBit = True
    End If
End Function

Private Sub FindRecord(ByVal iRecord)
    With AdodcT497.Recordset
        .MoveFirst
        Do While Not .EOF
            If .Fields("机位编号") = iRecord Then
                Exit Do
            End If
            .MoveNext
        Loop
    End With
End Sub

Private Sub RecordPrint()

    Const TOP_MARGIN = 1440     ' Use 1 inch margins.
    Const LEFT_MARGIN = 1440
    Const LINEINTERVAL = 400    'Line interval
    Dim Bottom_Margin, sgCurrentY As Single
    Dim i, iInterval As Integer
    
    MousePointer = vbHourglass
    DoEvents

    Bottom_Margin = Printer.ScaleTop + Printer.ScaleHeight - 1440   'Read the data and print it.
    With AdodcT497.Recordset
        .MoveFirst

        Printer.FontSize = 12           '打印信息
        iInterval = 0
        Printer.CurrentY = TOP_MARGIN
        Printer.CurrentX = LEFT_MARGIN
        Printer.Print "报表名称:  497 马达间歇测试时间报表"
        Printer.CurrentX = LEFT_MARGIN
        Printer.Print "生产时间:  " & .Fields("生产时间")
        Printer.CurrentX = LEFT_MARGIN
        Printer.Print "生产线号:  " & .Fields("生产线")
        Printer.CurrentX = LEFT_MARGIN
        Printer.Print "生产单号:  " & .Fields("生产单号")
        Printer.CurrentX = LEFT_MARGIN
        Printer.Print "生产数量:  " & .Fields("生产数量")
        Printer.CurrentX = LEFT_MARGIN
        Printer.Print "测试时间:  " & .Fields("测试时间")
        Printer.CurrentX = LEFT_MARGIN
        Printer.Print "测试人员:  " & .Fields("测试人员")
        Printer.CurrentX = LEFT_MARGIN
        Printer.Print "测试档位:  " & .Fields("档位")
        Printer.CurrentX = LEFT_MARGIN
        Printer.Print "机位编号:  " & .Fields("机位编号")
        Printer.CurrentX = LEFT_MARGIN
        Printer.Print ""
        Printer.CurrentX = LEFT_MARGIN
        Printer.Print "--------------------------------------------------------------------------------"
        
        sgCurrentY = Printer.CurrentY   '打印栏目
        Printer.FontSize = 9
        For i = 1 To 6
            Printer.CurrentX = LEFT_MARGIN + 1400 * (i - 1)
            Printer.CurrentY = sgCurrentY
            Printer.Print "运行" & Str(i)
            Printer.CurrentX = LEFT_MARGIN + 1400 * (i - 1) + 700
            Printer.CurrentY = sgCurrentY
            Printer.Print "停止" & Str(i)
        Next i
        Printer.CurrentX = LEFT_MARGIN
        Printer.Print ""
        
        
        Do While Not .EOF               '打印内容
            Printer.CurrentX = LEFT_MARGIN
            sgCurrentY = Printer.CurrentY
            For i = STARTNO To ENDNO
                Printer.CurrentX = LEFT_MARGIN + 700 * (i - STARTNO)
                If IsNull(.Fields(i)) = False Then
                    Printer.CurrentY = sgCurrentY
                    Printer.Print Str(.Fields(i))
                End If
            Next i
            If Printer.CurrentY >= Bottom_Margin Then   'See if we have filled the page.
                Printer.NewPage                         'Start a new page.
                Printer.CurrentY = TOP_MARGIN
            End If
            .MoveNext
            iInterval = iInterval + 1
        Loop
    End With
    Printer.EndDoc  'Finish printing.
    MousePointer = vbDefault
End Sub

Private Function AdjustTime(ByVal iTime As Integer, ByVal iIndex As Integer) As Integer
    If blState(iIndex) = True Then
        AdjustTime = iTime * TDON
    Else
        AdjustTime = iTime * TDOFF
    End If
End Function