VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmTestScript 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Test Script"
   ClientHeight    =   4185
   ClientLeft      =   2580
   ClientTop       =   2775
   ClientWidth     =   7935
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   HelpContextID   =   450
   Icon            =   "frmTestScript.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4185
   ScaleWidth      =   7935
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton cmdMove 
      Enabled         =   0   'False
      Height          =   420
      HelpContextID   =   450
      Index           =   1
      Left            =   1470
      Picture         =   "frmTestScript.frx":014A
      Style           =   1  'Graphical
      TabIndex        =   8
      ToolTipText     =   "Move script line down"
      Top             =   3765
      Width           =   450
   End
   Begin VB.CommandButton cmdMove 
      Enabled         =   0   'False
      Height          =   420
      HelpContextID   =   450
      Index           =   0
      Left            =   990
      Picture         =   "frmTestScript.frx":058C
      Style           =   1  'Graphical
      TabIndex        =   7
      ToolTipText     =   "Move script line up"
      Top             =   3765
      Width           =   450
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "&Delete Line"
      Enabled         =   0   'False
      Height          =   330
      HelpContextID   =   450
      Left            =   2100
      TabIndex        =   9
      Top             =   3825
      Width           =   1155
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "&OK"
      Height          =   330
      HelpContextID   =   461
      Left            =   6690
      TabIndex        =   11
      Top             =   3825
      Width           =   1155
   End
   Begin VB.CommandButton cmdBack 
      Caption         =   "<- Back"
      Height          =   330
      HelpContextID   =   450
      Left            =   5400
      TabIndex        =   10
      Top             =   3825
      Width           =   1155
   End
   Begin VB.Frame Frame1 
      Caption         =   "IC Tester Command:"
      Height          =   660
      Left            =   45
      TabIndex        =   12
      Top             =   30
      Width           =   7815
      Begin VB.CommandButton cmdAddInstruction 
         Caption         =   "&Add Instruction"
         Height          =   330
         HelpContextID   =   450
         Left            =   4770
         TabIndex        =   5
         ToolTipText     =   "Add a new instruction to the current test script"
         Top             =   225
         Width           =   1410
      End
      Begin VB.OptionButton optCommand 
         Caption         =   "Read"
         Height          =   195
         HelpContextID   =   450
         Index           =   4
         Left            =   3915
         TabIndex        =   4
         ToolTipText     =   "Read back the logic settings from the IC"
         Top             =   285
         Width           =   735
      End
      Begin VB.OptionButton optCommand 
         Caption         =   "Send"
         Height          =   195
         HelpContextID   =   450
         Index           =   3
         Left            =   3081
         TabIndex        =   3
         ToolTipText     =   "Send a bit pattern to the IC"
         Top             =   285
         Width           =   705
      End
      Begin VB.OptionButton optCommand 
         Caption         =   "Configure"
         Height          =   195
         HelpContextID   =   450
         Index           =   2
         Left            =   1949
         TabIndex        =   2
         ToolTipText     =   "Specify which IC pins are inputs or outputs"
         Top             =   285
         Width           =   1005
      End
      Begin VB.OptionButton optCommand 
         Caption         =   "+V On"
         Height          =   195
         HelpContextID   =   450
         Index           =   1
         Left            =   1027
         TabIndex        =   1
         ToolTipText     =   "Switch on the +V to the IC under test"
         Top             =   285
         Width           =   795
      End
      Begin VB.OptionButton optCommand 
         Caption         =   "Reset"
         Height          =   195
         HelpContextID   =   450
         Index           =   0
         Left            =   135
         TabIndex        =   0
         ToolTipText     =   "Reset the IC Tester Device"
         Top             =   285
         Width           =   765
      End
   End
   Begin MSFlexGridLib.MSFlexGrid grdScript 
      Height          =   3015
      HelpContextID   =   450
      Left            =   15
      TabIndex        =   6
      Top             =   765
      Width           =   7890
      _ExtentX        =   13917
      _ExtentY        =   5318
      _Version        =   393216
      FixedCols       =   0
      ScrollBars      =   2
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "Step 2 of 2"
      Height          =   270
      Left            =   60
      TabIndex        =   13
      Top             =   3885
      Width           =   855
   End
End
Attribute VB_Name = "frmTestScript"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private mnInsSelected                           As Integer

Private Const Module_Name                       As String = "frmTestScript"
Private Sub AddScript(nInsType As Integer, sOperand As String)

    Dim sLine                   As String
    Dim sKey                    As String
    

    Const PROC_NAME                     As String = "AddScript"
    
    On Error GoTo ErrorHandler
    
    With gtypNewModel
        sLine = Format$(nInsType) & sOperand
        sKey = "L" & Format$(gtypNewModel.TestScript.Count + 1)
        .TestScript.Add sLine, sKey
        
    End With
    
    Call RefreshGrid
    grdScript.TopRow = grdScript.Rows - 1
     
    Exit Sub
    
ErrorHandler:
    ErrorRoutine Module_Name, PROC_NAME, Err
End Sub


Private Sub InsertScript(nInsType As Integer, sOperand As String, nRow As Integer)

    Dim F                               As Integer
    Dim sLine                           As String
    Dim sKey                            As String
    
    Const PROC_NAME                     As String = "InsertScript"
    
    On Error GoTo ErrorHandler
    
    ' No we have to renumber the contents of the collection
     For F = gtypNewModel.TestScript.Count - 1 To nRow Step -1
         sKey = "L" & Format$(F)
         sLine = gtypNewModel.TestScript(sKey)
         gtypNewModel.TestScript.Remove sKey
         ' Create new one
         sKey = "L" & Format$(F + 1)
         gtypNewModel.TestScript.Add sLine, sKey
     Next F
    
    '
    ' Store the new line details
    sLine = Format$(nInsType) & sOperand
    sKey = "L" & Format$(nRow)
    gtypNewModel.TestScript.Add sLine, sKey

    Call RefreshGrid
    Exit Sub
    
ErrorHandler:
    ErrorRoutine Module_Name, PROC_NAME, Err
End Sub



Private Sub RefreshGrid()

    Dim F                               As Integer
    Dim G                               As Integer
    Dim H                               As Integer
    Dim nIns                            As Integer
    Dim nPinUsage                       As Integer
    Dim nTopRow                         As Integer
    Dim nCurrentUsage(MAX_PINS)         As Integer
    Dim sKey                            As String
    Dim sLine                           As String
    Dim sTemp                           As String
    Dim sOperand                        As String
    Dim sOpp                            As String
    
    Const INSTYPES = "Reset +V On ConfigSend  Read  "
    Const PROC_NAME                     As String = "RefreshGrid"
    
    On Error GoTo ErrorHandler

    With grdScript
    
        nTopRow = .TopRow
        .Visible = False
        .Rows = 1
        
        '
        ' Load in the defaul pin usage details
        For H = 1 To MAX_PINS
            nCurrentUsage(H) = gtypNewModel.Pin(H).Usage
        Next H
        
        For F = 1 To gtypNewModel.TestScript.Count
            sKey = "L" & Format$(F)
            .Rows = .Rows + 1
            .Row = .Rows - 1
            
            .Col = 0
            .Text = Format$(F)
            
            .Col = 1
            sTemp = gtypNewModel.TestScript(sKey)
            
            nIns = Val(Left$(sTemp, 1)) ' Instruction type
            If nIns = 2 Then
                ' Change I/O configuration
                For H = 2 To Len(sTemp)
                    nCurrentUsage(H - 1) = Val(Mid$(sTemp, H, 1))
                Next H
            End If
            sOperand = Mid$(sTemp, 2)
            
            ' Expand Instruction
            .Text = Trim$(Mid$(INSTYPES, (nIns * 6) + 1, 6))
       
            '
            ' Update colours
            For G = 1 To gtypNewModel.NumPins
                .Col = G + 1
                If nIns > 1 Then
                    
                    nPinUsage = gtypNewModel.Pin(G).Usage
                    If nPinUsage < 2 Then
                        nPinUsage = nCurrentUsage(G)
                    End If
                    
                    .CellBackColor = glColors(nPinUsage)
                    
                    '
                    ' Display the operand details
                    If nPinUsage < 2 Then
                        ' Ins has operands
                        sOpp = Mid$(sOperand, G, 1)
                        Select Case nIns
                        Case 2 ' Config
                            If sOpp = "0" Then
                                .Text = "I"
                            Else
                                .Text = "O"
                            End If
                            
                        Case 3 ' Send
                            If nPinUsage = 1 Then
                                .Text = " "
                            Else
                                Select Case sOpp
                                Case "0"
                                    .Text = "L"
                                Case "1"
                                    .Text = "H"
                                Case "2"
                                    .Text = " "
                                End Select
                            End If
                            
                        Case 4 ' Read
                            Select Case sOpp
                            Case "0"
                                .Text = "L"
                            Case "1"
                                .Text = "H"
                            Case "2"
                                .Text = "X"
                            End Select
                            
                        End Select
                    Else
                        ' Cannot change the direction of logic level of this pin
                        .Text = ""
                    End If
                        
                Else
                    ' This instruction has no operands
                    .CellBackColor = QBColor(7)
                End If
            Next G
                
        Next F
        
        .TopRow = nTopRow '+ 1
        .Visible = True
    End With
    
    Exit Sub

ErrorHandler:
    ErrorRoutine Module_Name, PROC_NAME, Err
End Sub



Private Sub cmdAddInstruction_Click()
    ' Add a new instruction to the grid
    ' Identify which instruction we are going to add
    Dim F                               As Integer
    Dim sOperand                        As String
    
    Const PROC_NAME                     As String = "cmdAddInstruction_Click"
    
    On Error GoTo ErrorHandler
    
    cmdMove(0).Enabled = False
    cmdMove(1).Enabled = False
    
    sOperand = String$(MAX_PINS, "0")
    
    With gtypNewModel
        'If .PinVDD > 0 Then
        '    Mid$(sOperand, .PinVDD, 1) = "X"
        'End If
        'If .PinVSS > 0 Then
        '    Mid$(sOperand, .PinVSS, 1) = "X"
        'End If
        
        For F = 1 To .NumPins
            Select Case .Pin(F).Usage
            Case 3, 4, 5
                Mid$(sOperand, F, 1) = "X"
            End Select
        Next F
        
        Select Case mnInsSelected
        Case 0 ' Reset
            AddScript 0, ""
            
        Case 1 ' +V On
            AddScript 1, ""
            
        Case 2 ' Configure
            AddScript 2, sOperand
                    
        Case 3 ' Send
            AddScript 3, sOperand
            
        Case 4 ' Read
            AddScript 4, sOperand
        
        Case Else
            MsgBox "No IC Tester instruction selected!", vbOKOnly + vbExclamation, "No Instruction Selected"
            
        End Select
    End With
    
    Exit Sub
    
ErrorHandler:
    ErrorRoutine Module_Name, PROC_NAME, Err

End Sub


Private Sub cmdBack_Click()

    Me.Hide
    frmModelCreate.Visible = True
    
End Sub


Private Sub cmdDelete_Click()

    Dim F                               As Integer
    Dim sKey                            As String
    Dim sLine                           As String
    
    Const PROC_NAME                     As String = "cmdDelete_Click"
    
    On Error GoTo ErrorHandler
    
    With grdScript
        .Col = 0 ' Select the Line No.
        If MsgBox("Delete line:" & .Text & " ?", vbYesNo + vbExclamation + vbDefaultButton2, "Delete Line From Script") = vbYes Then
            ' Fine, delete the selected line - Lock out the form
            cmdDelete.Enabled = False
            cmdMove(0).Enabled = False
            cmdMove(1).Enabled = False

            ' Remove the line from the list
            sKey = "L" & Format$(.Text)
            gtypNewModel.TestScript.Remove sKey
                        
            '
            ' No we have to renumber the contents of the collection
            For F = Val(.Text) + 1 To gtypNewModel.TestScript.Count + 1
                sKey = "L" & Format$(F)
                sLine = gtypNewModel.TestScript(sKey)
                gtypNewModel.TestScript.Remove sKey
                ' Create new one
                sKey = "L" & Format$(F - 1)
                gtypNewModel.TestScript.Add sLine, sKey
            Next F
            
            '
            ' Redraw the display
            Call RefreshGrid
         
        End If
    End With
    
    Exit Sub
        
ErrorHandler:
    ErrorRoutine Module_Name, PROC_NAME, Err
End Sub


Private Sub cmdMove_Click(Index As Integer)
    
    Dim F                               As Integer
    Dim nRow(1)                         As Integer
    Dim sKey(1)                         As String
    Dim sLine(1)                        As String
    
    Const PROC_NAME                     As String = "cmdMove_Click"
    
    On Error GoTo ErrorHandler

  
    nRow(0) = grdScript.Row
    
    Select Case Index
    Case 0 ' Move Up
        If nRow(0) <= 1 Then
            MsgBox "Cannot move row any further up", vbOKOnly + vbExclamation, "Move Row"
            Exit Sub
        End If
        nRow(1) = nRow(0) - 1
        
    
    Case 1 ' Move Down
        If nRow(0) + 1 >= grdScript.Rows Then
            MsgBox "Cannot move row any further down", vbOKOnly + vbExclamation, "Move Row"
            Exit Sub
        End If
        nRow(1) = nRow(0) + 1
    
    End Select

    '
    ' Copy and delete the original rows
    For F = 0 To 1
        sKey(F) = "L" & Format$(nRow(F))
        sLine(F) = gtypNewModel.TestScript(sKey(F))
        gtypNewModel.TestScript.Remove sKey(F)
    Next F
    
    '
    ' Now recreate the rows, but in reverse sequence
    gtypNewModel.TestScript.Add sLine(0), sKey(1)
    gtypNewModel.TestScript.Add sLine(1), sKey(0)
    
    Call RefreshGrid
    
    'grdScript.SelectionMode = flexSelectionByRow
    grdScript.Row = nRow(1) ' Reselect the row
    grdScript.Col = 0
    grdScript.ColSel = grdScript.Cols - 1
    
    Call grdScript_Click ' Update the status of the Up/Down buttons
    Exit Sub
        
ErrorHandler:
    ErrorRoutine Module_Name, PROC_NAME, Err
End Sub

Private Sub cmdOK_Click()
    Dim F                               As Integer
    Dim nFileNumber                     As Integer
        
    Const PROC_NAME                     As String = "cmdOK_Click"
    
    On Error GoTo ErrorHandler
    
    If MsgBox("Save current test script ?", vbYesNo + vbExclamation + vbDefaultButton1, "Model Definition") = vbNo Then
        Exit Sub
    End If
    
    '
    ' Save the script
    gsModelFileName = gsPaths(0) & "\" & gtypNewModel.Model & ".mod"
    
    nFileNumber = FreeFile
    
    Open gsModelFileName For Output As nFileNumber
    
    With gtypNewModel
        Print #nFileNumber, .Model
        Print #nFileNumber, .Description
        Print #nFileNumber, .NumPins
        Print #nFileNumber, .PinVDD
        Print #nFileNumber, .PinVSS
        For F = 1 To .NumPins
            Print #nFileNumber, Format$(F) & "," & .Pin(F).Tag & "," & .Pin(F).Usage
        Next F
            
        For F = 1 To .TestScript.Count
            Print #nFileNumber, Format$(F) & "," & .TestScript("L" & Format$(F))
        Next F
                
        Close #nFileNumber
        
        MsgBox "Model (" & .Description & ") Saved !", vbOKOnly + vbInformation, "Model Definition"
    End With
    
    LoadModel gsModelFileName
    frmMDIMain.NewModelLoaded
    frmMDIMain.UpdateLastUsedList
    
    Unload frmTestScript
    Unload frmModelCreate
    
    Exit Sub
    
ErrorHandler:
    ErrorRoutine Module_Name, PROC_NAME, Err

End Sub


Private Sub Form_Load()

    Dim F                               As Integer
        
    Const PROC_NAME                     As String = "Form_Load"
    
    On Error GoTo ErrorHandler

    ' We can configure the grid now
    
    With grdScript
        .Rows = 1
        .Row = 0 ' Heading row
        .Cols = gtypNewModel.NumPins + 2
        .Col = 0
        .Text = "Seq"
        .ColWidth(.Col) = 600
        
        .Col = 1
        .Text = "Ins"
        .ColWidth(.Col) = 800
        .ColAlignment(.Col) = flexAlignCenterCenter
        
        For F = 1 To gtypNewModel.NumPins
            .Col = F + 1
            .Text = Format$(F)
            .ColWidth(.Col) = 250
        Next F
        'Call SetColours(.Row)
    End With
        
    mnInsSelected = -1
    
    RecoverFormLoadPosition Me, False
    
    Call SetWindowPos(Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
    
    If frmModelCreate.Amend = True Then
        Call RefreshGrid
    End If
    
    Exit Sub
    
ErrorHandler:
    ErrorRoutine Module_Name, PROC_NAME, Err
End Sub

Private Sub grdScript_Click()

    Dim bFlag                           As Boolean
    Dim bUpdateMade                     As Boolean
    Dim nCol                            As Integer
    Dim nRow                            As Integer
    Dim nSeq                            As Integer
    Dim X                               As Integer
    Dim nMultiple                       As Integer
    Dim nPinUsage                       As Integer
    Dim sScript                         As String
    Dim sKey                            As String
    
    Const PROC_NAME                     As String = "grdScript_Click"
    
    On Error GoTo ErrorHandler
    
    bFlag = False
    
    With grdScript
               
        cmdMove(0).Enabled = False
        cmdMove(1).Enabled = False
        cmdDelete.Enabled = False
        
        nRow = .Row
        If nRow > 1 Then
            ' Were not on the first row so it's OK to move up
            cmdMove(0).Enabled = True
            cmdDelete.Enabled = True
        End If
        
        If nRow + 1 < .Rows Then
            ' Were not on the last row so it's OK to move down
            cmdMove(1).Enabled = True
            cmdDelete.Enabled = True
        End If
        
        If .Col <> 1 Then
            If .Text = "0" Or Val(.Text) > 0 Then
                ' Can't do this - not a script row
                Exit Sub
            Else
                For nMultiple = .Col To .ColSel
                    .Row = nRow
                    .Col = nMultiple
                    '
                    ' Also, check to see if were flipping the contents of a cell
                    nCol = .Col
                    If nCol > 1 Then
                        ' We can only flip Pin cols
                        .Col = 0
                        sKey = "L" & Val(.Text)
                                                    
                        sScript = gtypNewModel.TestScript(sKey)
                        X = Val(Mid$(sScript, nCol, 1))
                        X = X + 1
                        nPinUsage = gtypNewModel.Pin(nCol - 1).Usage
                        
                        bUpdateMade = False
                        If nPinUsage <= 2 Then
                            ' Also, We can only flip I/O pins
                            
                            .Col = 1
                            Select Case UCase$(.Text)
                            Case "RESET", "+V ON" ' Reset, +V on
                                ' Nothing to do with these - no operands
                            
                            Case "CONFIG" 'Configure
                                If X > 1 Then X = 0
                                bUpdateMade = True
                                
                            Case "SEND" ' Send
                                If X > 1 Then X = 0
                                bUpdateMade = True
                                
                            Case "READ" ' Read
                                If X > 2 Then X = 0
                                bUpdateMade = True
                                
                            End Select
                            
                            If bUpdateMade = True Then
                                Mid$(sScript, nCol, 1) = Format$(X)
                                
                                gtypNewModel.TestScript.Remove sKey
                                gtypNewModel.TestScript.Add sScript, sKey
                                bUpdateMade = False
                            End If
                            bFlag = True
                            
                        End If ' Test on pin usage
                    End If ' Test on .Col number
                Next nMultiple
            End If ' value of the .Text field
        End If ' .col=1
    End With

    If bFlag = True Then
        Call RefreshGrid
    End If
    
    Exit Sub
    
ErrorHandler:
    ErrorRoutine Module_Name, PROC_NAME, Err
End Sub

Private Sub optCommand_Click(Index As Integer)

    mnInsSelected = Index
    
End Sub


