module1.bas

应用串口通讯, 获取产品信息, 并与SAMPLE信息比较, 自动判断产品是否合格

Attribute VB_Name = "Module1"
Option Explicit

Const sConfigPath = "chkeprom.cfg"

' contain the macro commands
Public aTestItems As Variant, oAteResult As New clsAteResult

Sub DisplayMsg(ByVal sMsg)
    MsgBox sMsg, vbOKOnly, "Message"
End Sub

Sub LoadTestItems(ByRef oForm As Form, ByRef oGrid As MSFlexGrid)
Dim iFH As Integer, sFile As String, iLine As Integer, sMsg As String
Dim sLine As String, ch As String, iTotalItems As Integer
Dim lGridWidth As Long, i As Integer

    With oGrid
        .Rows = 2
        .Cols = 3
        
        'clear contents
        .Clear
        
        .Row = 0
        
        .Col = 0
        .Text = "#"
        .ColWidth(0) = oForm.ScaleX(4, vbCharacters, vbTwips)
        .CellFontBold = True
        
        .Col = 1
        .Text = "Test Items"
        .ColWidth(1) = oForm.ScaleX(60, vbCharacters, vbTwips)
        .CellFontBold = True
        
        .Col = 2
        .Text = "Result"
        .ColWidth(2) = oForm.ScaleX(7, vbCharacters, vbTwips)
        .CellFontBold = True
        
        .FixedCols = 0
        .FixedRows = 1
        
        ' set the grid width
'        lGridWidth = 0
'        For i = 0 To .Cols - 1
'            lGridWidth = lGridWidth + .ColWidth(i)
'        Next
'        .Width = lGridWidth + 300
    End With

    sFile = Dir(sConfigPath)
    If sFile = "" Then
        Err.Number = -1
        GoTo LoadTestItems_Error
    End If

    iFH = FreeFile
    On Error GoTo LoadTestItems_Error
    Open sConfigPath For Input As #iFH
    
    If aTestItems = Empty Then
        ReDim aTestItems(1 To 1) As Variant
    End If
    
    'DisplayMsg "Executing macro '" & sConfigPath & "'"
    Do While Not EOF(iFH)
        iLine = iLine + 1
        Input #iFH, sLine
        'sLine = UCase(Trim(sLine))
        sLine = Trim(sLine)
        
        ch = Left(sLine, 1)
        If sLine <> "" And ch <> "#" And ch <> ";" And ch <> "/" And ch <> "'" Then
            'Execute sLine
            iTotalItems = iTotalItems + 1
            ReDim Preserve aTestItems(1 To iTotalItems) As Variant
            aTestItems(iTotalItems) = sLine
        End If
    Loop
    Close #iFH
    iFH = 0
    
    ' set the display contents of the grid
    With oGrid
        .Rows = UBound(aTestItems) + 1
        
        For i = 1 To UBound(aTestItems)
            .Row = i
            .Col = 0
            .Text = i
            .Col = 1
            .Text = aTestItems(i)
        Next
    End With
    
LoadTestItems_Error:
    If Err <> 0 Then
        sMsg = "Load '" & sConfigPath & "' error"
        If iLine > 0 Then
            sMsg = sMsg & " at line " & iLine
        Else
            sMsg = sMsg & " : Cannot open file"
        End If
        DisplayMsg sMsg
    End If
    
    On Error GoTo 0
    If iFH > 0 Then Close #iFH

End Sub

' Format : <msg>[,<title>[,<bmp picture path>]]
Sub DisplayAteMsgBox(ByVal sLine As String)
    With frmAteMsgBox
        .TextMsg = Trim(ExtractSubStr(sLine, 1, ";"))
        .Title = Trim(ExtractSubStr(sLine, 2, ";"))
        .PicturePath = Trim(ExtractSubStr(sLine, 3, ";"))
        .Show vbModal, frmMain
    End With
End Sub

Sub ExecuteTests(ByRef oForm As Form, ByRef oGrid As MSFlexGrid)
Dim i As Integer, iTotalTestItems As Integer, iCol As Integer, iTrial As Integer
Dim bItemResult As Boolean, bOverallResult As Boolean
Dim sResult As String

    With oForm
        .cmdStart.Enabled = False
        .cmdQuit.Enabled = False
    End With
    
    oGrid.TopRow = 1
    
    frmPcb.Show vbModal

    oForm.txtPcbNumber.Text = oAteResult.PcbNumber
    
    iTotalTestItems = UBound(aTestItems)
    
    oAteResult.StartMeasurement
    oLog.OpenLog App.Path & "\" & Format(oAteResult.StartTime, "yyyymmdd") & ".txt"
    
    With frmMain
        .txtStartTime.Text = Format(oAteResult.StartTime, "hh:mm:ss")
        .txtEndTime.Text = ""
        .txtDuration.Text = ""
    End With
    
    ' clear the result column first
    For i = 1 To iTotalTestItems
        oGrid.TextMatrix(i, 2) = ""
    Next
    
    ' set the retry count
    oComm.MaxTrialCount = oAteResult.TrialCount

    bOverallResult = True
    For i = 1 To iTotalTestItems
        ' highlight the executing row
        With oGrid
            .Row = i
            .Col = 0
            .ColSel = 2
        End With
        oForm.Refresh
        
        ' re-attempt max 3 times
        Select Case LCase(ExtractSubStr(aTestItems(i), 1))
        Case "msgbox"
            DisplayAteMsgBox Trim(Mid(aTestItems(i), 8))
            bItemResult = True
        Case Else
            bItemResult = oComm.Execute(aTestItems(i))
        End Select
        
        If Not bItemResult Then
            sResult = "FAIL"
            bOverallResult = False
        Else
            sResult = "PASS"
        End If
        oGrid.TextMatrix(i, 2) = sResult
        
        If i > 10 Then
            ' make the grid scroll down
            oGrid.TopRow = oGrid.TopRow + 1
        End If
        
        oAteResult.AddResult aTestItems(i), sResult, oComm.CompareFailureResult
        oComm.CompareFailureResult = ""
        
        If oAteResult.BreakLoopOnError And Not bOverallResult Then Exit For
    Next
    oAteResult.EndMeasurement
    oAteResult.ProduceResultFile
    
    'oGrid.TopRow = 1
    
    With frmMain
        .txtStartTime.Text = Format(oAteResult.StartTime, "hh:mm:ss")
        .txtEndTime.Text = Format(oAteResult.EndTime, "hh:mm:ss")
        .txtDuration.Text = oAteResult.TestDurationInMmSs
    End With
    
    With frmResult
        With frmResult
            .picPass.Visible = bOverallResult
            .picFail.Visible = Not bOverallResult
            .Show vbModal
        End With
    End With
    
    With oForm
        .cmdQuit.Enabled = True
        .cmdStart.Enabled = True
        .cmdStart.SetFocus
    End With
End Sub