frmifproperties.frm

Data monkey是一个强大的是数据传输和转换应用程序。使用DataMonkey用户可以把复杂的文本文件格式

    ' Hide everything.
    Me.txtLHSConstant.Visible = False
    Me.cboLHSCheckPoint.Visible = False
    Me.cboLHSDataItem.Visible = False
    Me.lblLHSCheckPoint.Visible = False
    Me.lblLHSDataItem.Visible = False
    Me.fraLHSInputLine.Visible = False
    
    Select Case left$(cboLHSType.Text, 5)
        Case "Const"
            Me.txtLHSConstant.Visible = True
            
        Case "DataI"
            Me.cboLHSCheckPoint.Visible = True
            Me.cboLHSDataItem.Visible = True
            Me.lblLHSCheckPoint.Visible = True
            Me.lblLHSDataItem.Visible = True
            
        Case "Check"
            Me.cboLHSCheckPoint.Visible = True
            Me.lblLHSCheckPoint.Visible = True
        
        Case "Value"
            Me.fraLHSInputLine.Visible = True

    End Select
End Sub

Private Sub cboLHSType_Click()
    
    ' Make the correct items visible.
    SetLHSVisibility
        
    DisplayExpression
End Sub

Private Sub cboOperator_Click()
    DisplayExpression
End Sub

Private Sub cboRHSCheckPoint_Click()
    FillDataItemCombo cboRHSDataItem, cboRHSCheckPoint.Text
    DisplayExpression
End Sub

Private Sub cboRHSDataItem_Click()
    DisplayExpression
End Sub

Private Sub FillCheckPointCombo(Cbo As ComboBox)
    Dim cp As CInputRecord
    
    Cbo.Clear
    
    For Each cp In mImport.GetCheckPoints
        Cbo.AddItem cp.name
    Next cp
    
    If Cbo.ListCount > 0 Then
        Cbo.ListIndex = 0
    End If

End Sub

Private Sub FillDataItemCombo(Cbo As ComboBox, cpName As String)
    Dim cp As CInputRecord
    Dim di As CInputField
    
    Cbo.Clear
    
    If Trim(cpName) = "" Then Exit Sub
    
    Set cp = mImport.GetCheckPointByName(cpName)
    For Each di In cp.GetDataPoints()
        Cbo.AddItem di.name
    Next di
    
    If Cbo.ListCount > 0 Then
        Cbo.ListIndex = 0
    End If
    
End Sub

Private Sub cboRHSType_Click()
            
    ' Hide everything.
    Me.txtRHSConstant.Visible = False
    Me.cboRHSCheckPoint.Visible = False
    Me.cboRHSDataItem.Visible = False
    Me.lblRHSCheckPoint.Visible = False
    Me.lblRHSDataItem.Visible = False
    Me.fraRHSInputLine.Visible = False
    Me.fraRHSNumber.Visible = False
    
    Select Case left$(cboRHSType.Text, 5)
    
        Case "Const"
            Me.txtRHSConstant.Visible = True
            
        Case "DataI"
            Me.cboRHSCheckPoint.Visible = True
            Me.cboRHSDataItem.Visible = True
            Me.lblRHSCheckPoint.Visible = True
            Me.lblRHSDataItem.Visible = True
            
        Case "Check"
            Me.cboRHSCheckPoint.Visible = True
            Me.lblRHSCheckPoint.Visible = True
        
        Case "Value"
            Me.fraRHSInputLine.Visible = True
            
        Case "Numbe"
            Me.fraRHSNumber.Visible = True

    End Select
    
    DisplayExpression

End Sub

Private Sub chkLHSDelimited_Click()
    Me.lblLHSDelimiter.Visible = IIf(chkLHSDelimited.value = 1, True, False)
    Me.txtLHSDelimiter.Visible = IIf(chkLHSDelimited.value = 1, True, False)
    
    Me.lblLHSLength.Visible = Not IIf(chkLHSDelimited.value = 1, True, False)
    Me.txtLHSLength.Visible = Not IIf(chkLHSDelimited.value = 1, True, False)
    DisplayExpression
End Sub

Private Sub chkRHSDelimited_Click()
    Me.lblRHSDelimiter.Visible = IIf(chkRHSDelimited.value = 1, True, False)
    Me.txtRHSDelimiter.Visible = IIf(chkRHSDelimited.value = 1, True, False)
    
    Me.lblRHSLength.Visible = Not IIf(chkRHSDelimited.value = 1, True, False)
    Me.txtRHSLength.Visible = Not IIf(chkRHSDelimited.value = 1, True, False)
    DisplayExpression
End Sub

Private Sub Command1_Click()

    ' Get a string representing the LHS of the equation.
    
    If Me.cboLHSDataItem.Visible = True Then
        mIf.LHSType = eCmdValueTypes.cvtDataItem
        mIf.LHS = Me.cboLHSCheckPoint.Text + "," _
                    + Me.cboLHSDataItem.Text
    ElseIf Me.cboLHSCheckPoint.Visible = True Then
        mIf.LHSType = eCmdValueTypes.cvtCheckPoint
        mIf.LHS = Me.cboLHSCheckPoint.Text
    ElseIf Me.txtLHSConstant.Visible = True Then
        mIf.LHSType = eCmdValueTypes.cvtConstant
        mIf.LHS = Me.txtLHSConstant.Text
    ElseIf Me.fraLHSInputLine.Visible = True Then
        mIf.LHSType = eCmdValueTypes.cvtLineOfInput
        mIf.LHSDelimited = IIf(chkLHSDelimited = 1, True, False)
        mIf.LHSDelimiter = txtLHSDelimiter
        mIf.LHSLength = IIf(txtLHSLength = "", 0, txtLHSLength)
        mIf.LHSInputLinePosition = txtLHSPosition
    Else
        mIf.LHSType = eCmdValueTypes.cvtNONE
        mIf.LHS = ""
    End If
    
    ' Get a string representing the RHS of the equation.
    
    If Me.cboRHSDataItem.Visible = True Then
        mIf.RHSType = eCmdValueTypes.cvtDataItem
        mIf.RHS = cboRHSCheckPoint.Text + "," _
                    + cboRHSDataItem.Text
    ElseIf Me.cboRHSCheckPoint.Visible = True Then
        mIf.RHSType = eCmdValueTypes.cvtCheckPoint
        mIf.RHS = Me.cboRHSCheckPoint.Text
    ElseIf Me.txtRHSConstant.Visible = True Then
        mIf.RHSType = eCmdValueTypes.cvtConstant
        mIf.RHS = Me.txtRHSConstant.Text
    ElseIf Me.fraRHSInputLine.Visible = True Then
        mIf.RHSType = eCmdValueTypes.cvtLineOfInput
        mIf.RHSDelimited = IIf(chkRHSDelimited = 1, True, False)
        mIf.RHSDelimiter = txtRHSDelimiter
        mIf.RHSLength = IIf(txtRHSLength = "", 0, txtRHSLength)
        mIf.RHSInputLinePosition = txtRHSPosition
    ElseIf Me.fraRHSNumber.Visible = True Then
        mIf.RHSType = eCmdValueTypes.cvtNumeric
    Else
        mIf.RHSType = eCmdValueTypes.cvtNONE
        mIf.RHS = ""
    End If
    
    ' Get the operator.
    
    mIf.Operator = cboOperator.Text
    mIf.CaseSensitive = IIf(chkCaseSensitive.value = 1, True, False)

    GFormReturnValue = vbOK
    Unload Me
End Sub

Private Sub Command2_Click()
    GFormReturnValue = vbCancel
    Unload Me
End Sub

Public Sub Initialize(theParent As CCmdIf, NameForCaption As String, Import As CImport)
    
    Dim fld As String, rec As String
        
    ' If no import object was passed in, use the global default.
    If Import Is Nothing Then
        Set mImport = GImport
    Else
        Set mImport = Import
    End If
    
    ' Fill the 'record' combos.
    FillCheckPointCombo cboLHSCheckPoint
    FillCheckPointCombo cboRHSCheckPoint
    
    Select Case theParent.LHSType
        Case eCmdValueTypes.cvtConstant
            Me.cboLHSType.ListIndex = 0 'Constant
            Me.txtLHSConstant.Text = theParent.LHS
        Case eCmdValueTypes.cvtLineOfInput
            Me.cboLHSType.ListIndex = 1 'Line of input
            Me.cboLHSCheckPoint.Text = theParent.LHS
        Case eCmdValueTypes.cvtDataItem
            theParent.ParseDataItemName theParent.LHS, rec, fld
            FillDataItemCombo cboLHSDataItem, rec
            Me.cboLHSType.ListIndex = 2 'DataItem
            Me.cboLHSCheckPoint = rec
            Me.cboLHSDataItem = fld
        Case Else
            Me.cboLHSType.ListIndex = 1
    End Select
    
    Select Case theParent.RHSType
        Case eCmdValueTypes.cvtConstant
            Me.cboRHSType.ListIndex = 0 'Constant
            Me.txtRHSConstant.Text = theParent.RHS
        Case eCmdValueTypes.cvtLineOfInput
            Me.cboRHSType.ListIndex = 1 ' Line of input
            Me.cboRHSCheckPoint.Text = theParent.RHS
        Case eCmdValueTypes.cvtDataItem
            theParent.ParseDataItemName theParent.RHS, rec, fld
            FillDataItemCombo cboRHSDataItem, rec
            Me.cboRHSType.ListIndex = 2 'DataItem
            Me.cboRHSCheckPoint = rec
            Me.cboRHSDataItem = fld
        Case eCmdValueTypes.cvtNumeric
            Me.cboRHSType.ListIndex = 3  'Number
        Case Default
            Me.cboRHSType.ListIndex = 0
    End Select
    
    cboOperator.Text = theParent.Operator
    chkCaseSensitive.value = IIf(theParent.CaseSensitive, 1, 0)

    Set mIf = theParent
    Me.Caption = "If Command Properties for " & NameForCaption
    
    Me.txtLHSDelimiter = theParent.LHSDelimiter
    Me.chkLHSDelimited = IIf(theParent.LHSDelimited, 1, 0)
    Me.txtLHSLength = theParent.LHSLength
    Me.txtLHSPosition = theParent.LHSInputLinePosition

    Me.txtRHSDelimiter = theParent.RHSDelimiter
    Me.chkRHSDelimited = IIf(theParent.RHSDelimited, 1, 0)
    Me.txtRHSLength = theParent.RHSLength
    Me.txtRHSPosition = theParent.RHSInputLinePosition
    
    'Call cboLHSType_Click
    'Call cboRHSType_Click
    'Call chkLHSDelimited_Click
    'Call chkRHSDelimited_Click
End Sub

Private Sub Form_Load()

    ' Set the default return value type.
    GFormReturnValue = vbCancel

    Me.left = (Screen.Width - Me.Width) / 2
    Me.top = (Screen.Height - Me.Height) / 2

End Sub
Private Sub DisplayExpression()
    Dim LHS As String, RHS As String, Operator As String
    Dim pos As Integer

    ' Get a string representing the LHS of the equation.
    
    Select Case left$(cboLHSType.Text, 5)
        Case "Const"
            LHS = Me.txtLHSConstant.Text
        
        Case "DataI"
            LHS = cboLHSCheckPoint.Text + "->" + Me.cboLHSDataItem.Text
        
        Case "Check"
            LHS = Me.cboLHSCheckPoint.Text
        
        Case "Value"
            pos = IIf(Me.txtLHSPosition = "", 0, Me.txtLHSPosition)
            If Me.chkLHSDelimited = 1 Then
                LHS = "Value at position " + Trim(str(pos))
            Else
                LHS = "Value FROM " & Trim(pos)
                LHS = LHS & " TO " & Trim(str(pos + Me.txtLHSLength))
            End If

        Case Default
            LHS = "<NOTHING>"
            
    End Select
    If Trim(LHS) = "" Then LHS = "<NOTHING>"
    
    ' Get a string representing the RHS of the equation.
    
    Select Case left$(cboRHSType.Text, 5)
        Case "DataI"
            RHS = cboRHSCheckPoint.Text + "->" + cboRHSDataItem.Text
        Case "Check"
            RHS = Me.cboRHSCheckPoint.Text
        Case "Const"
            RHS = Me.txtRHSConstant.Text
        Case "Value"
            pos = IIf(Me.txtRHSPosition = "", 0, Me.txtRHSPosition)
            If Me.chkRHSDelimited = 1 Then
                RHS = "Value at position " + Trim(str(pos))
            Else
                RHS = "Value FROM " & pos
                RHS = RHS & " TO " & Trim(str(pos + CInt(txtRHSLength)))
            End If
        Case "Numbe"
            RHS = "any number"
        Case Default
            RHS = "<NOTHING>"
    End Select
    If Trim(RHS) = "" Then RHS = "<NOTHING>"
    
    ' Get the operator.
    
    Operator = cboOperator.Text
    
    ' Display the expression.
    
    With txtExpression
        Dim LHSPos As Integer, LHSLen As Integer
        Dim RHSPos As Integer, RHSLen As Integer
        
        .Text = "IF "
        LHSPos = Len(.Text)
        LHSLen = Len(LHS)
        
        .Text = .Text + LHS + " " + Operator + " "
        
        RHSPos = Len(.Text)
        RHSLen = Len(RHS)
        
        .Text = .Text + RHS
            
        .SelStart = LHSPos
        .SelLength = LHSLen
        .SelBold = True
        '.SelColor = vbBlue
        
        .SelStart = RHSPos
        .SelLength = RHSLen
        .SelBold = True
        '.SelColor = vbBlue
        
        .SelLength = 0
    End With
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set mImport = Nothing
End Sub

Private Sub txtLHSConstant_Change()
    DisplayExpression
End Sub

Private Sub txtLHSLength_Change()
    DisplayExpression
End Sub

Private Sub txtLHSLength_KeyPress(KeyAscii As Integer)
    ' Only allow numbers and backspace.
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then
        KeyAscii = 0
    End If
End Sub

Private Sub txtLHSPosition_Change()
    DisplayExpression
End Sub

Private Sub txtLHSPosition_KeyPress(KeyAscii As Integer)
    ' Only allow numbers and backspace.
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then
        KeyAscii = 0
    End If
End Sub

Private Sub txtRHSConstant_Change()
    DisplayExpression
End Sub

Private Sub txtRHSLength_Change()
    DisplayExpression
End Sub

Private Sub txtRHSLength_KeyPress(KeyAscii As Integer)
    ' Only allow numbers and backspace.
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then
        KeyAscii = 0
    End If
End Sub

Private Sub txtRHSPosition_Change()
    DisplayExpression
End Sub

Private Sub txtRHSPosition_KeyPress(KeyAscii As Integer)
    ' Only allow numbers and backspace.
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then
        KeyAscii = 0
    End If
End Sub