ccmdcalculatevalue.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CCmdCalculateValue"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' DataMonkey Data Conversion Application. Written by Theodore L. Ward
' Copyright (C) 2002 AstroComma Incorporated.
'
' This program is free software; you can redistribute it and/or
' modify it under the terms of the GNU General Public License
' as published by the Free Software Foundation; either version 2
' of the License, or (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
' The author may be contacted at:
' [e-mail] or [e-mail]

Option Explicit

Private mRHS As Variant
Private mRHSType As eCmdValueTypes
Private mRHSCheckPointName As String
Private mRHSDataItemName As String
Private mRHSGetValue As CCmdGetValue

Private mOperator As String
Private mIndex As Integer
Private mvarType As Integer 'local copy
Private mUniqueID As String
Private mCaseSensitive As Boolean

Public Function GetID() As String
    GetID = mUniqueID
End Function

Public Function Copy() As CCmdCalculateValue
    On Error GoTo eHandler
    Set Copy = Nothing

    Dim newObj As CCmdCalculateValue
    Set newObj = New CCmdCalculateValue
    
    newObj.RHS = Me.RHS
    newObj.RHSType = Me.RHSType
    newObj.RHSDelimited = Me.RHSDelimited
    newObj.RHSDelimiter = Me.RHSDelimiter
    newObj.RHSInputLinePosition = Me.RHSInputLinePosition
    
    newObj.Operator = Me.Operator
    newObj.CaseSensitive = Me.CaseSensitive

    Set Copy = newObj
    Set newObj = Nothing
    Exit Function

eHandler:
    LogError "CCmdCalculateValue", "Copy", Error(Err), False

End Function

Public Property Let RHSInputLinePosition(ByVal vData As Integer)
    mRHSGetValue.Position = vData
End Property
Public Property Get RHSInputLinePosition() As Integer
    RHSInputLinePosition = mRHSGetValue.Position
End Property

Public Property Let RHSLength(ByVal vData As Integer)
    mRHSGetValue.Length = vData
End Property
Public Property Get RHSLength() As Integer
    RHSLength = mRHSGetValue.Length
End Property

Public Property Let RHSDelimited(ByVal vData As Boolean)
    mRHSGetValue.Delimited = vData
End Property
Public Property Get RHSDelimited() As Boolean
    RHSDelimited = mRHSGetValue.Delimited
End Property

Public Property Let RHSDelimiter(vData As String)
    mRHSGetValue.Delimiter = vData
End Property
Public Property Get RHSDelimiter() As String
    RHSDelimiter = mRHSGetValue.Delimiter
End Property

Public Property Let CaseSensitive(ByVal vData As Boolean)
    mCaseSensitive = vData
End Property
Public Property Get CaseSensitive() As Boolean
    CaseSensitive = mCaseSensitive
End Property

Public Function EditProperties(NameForCaption As String, Optional ByRef Import As CImport = Nothing) As Integer
    Dim tImport As CImport
    Set tImport = Import
    If tImport Is Nothing Then Set tImport = GImport
    
    With frmCmdCalculateProperties
        .Initialize Me, NameForCaption, tImport
        .Show vbModal
    End With
    
    Unload frmCmdCalculateProperties
    
    EditProperties = GFormReturnValue
End Function

Public Function GetSpecificDescription() As String
    Dim x As String
    
    Select Case mOperator
        Case "+"
            x = "Add "
        Case "-"
            x = "Subtract "
        Case "/"
            x = "Divide by "
        Case "*"
            x = "Multiply by "
    End Select

    Select Case mRHSType

        Case eCmdValueTypes.cvtConstant
            If Len(mRHS) > 0 Then
                x = x & mRHS
            Else
                x = x & "Nothing"
            End If
        Case eCmdValueTypes.cvtDataItem
            x = x + mRHS
        Case eCmdValueTypes.cvtMe
            x = x + "this field to itself"
        Case eCmdValueTypes.cvtLineOfInput
            x = x & "the value "
            If mRHSGetValue.Delimited Then
                x = x & "at position " + Trim(str(mRHSGetValue.Position))
            Else
                x = x & "FROM " & Trim(str(mRHSGetValue.Position))
                x = x & " TO " & Trim(str(mRHSGetValue.Position + mRHSGetValue.Length))
            End If
    End Select
    
    GetSpecificDescription = x

End Function

Public Function GetApplications() As eCmdApplications
    GetApplications = GCmdHelper.CMDGetApplications(CmdType())
End Function

Public Property Let Operator(ByVal vData As String)
    mOperator = vData
End Property

Public Property Get Operator() As String
    Operator = mOperator
End Property

Public Property Let RHSType(ByVal vData As eCmdValueTypes)
    mRHSType = vData
    If mRHSType = cvtDataItem Or mRHSType = cvtCheckPoint Then
        ParseDataItemName CStr(mRHS), mRHSCheckPointName, mRHSDataItemName
    End If
End Property

Public Property Get RHSType() As eCmdValueTypes
    RHSType = mRHSType
End Property

Public Property Let RHS(ByVal vData As Variant)
    mRHS = vData
    If mRHSType = cvtDataItem Or mRHSType = cvtCheckPoint Then
        ParseDataItemName CStr(mRHS), mRHSCheckPointName, mRHSDataItemName
    End If
End Property

Public Property Get RHS() As Variant
    RHS = mRHS
End Property

Public Function CmdType() As Integer
    CmdType = eCmdTypes.cmdCalculateValue
End Function

Public Property Let index(ByVal vData As Integer)
    mIndex = vData
End Property

Public Property Get index() As Integer
    index = mIndex
End Property

Public Function Execute(ByRef value As Variant, Optional CnvType As Integer = -1) As Boolean

    On Error GoTo eHandler
    
    Dim rhsValue As Variant, lhsValue As Variant
    Dim cp As CInputRecord
    Dim di As CInputField
    Dim i As Integer
    
   ' Default to failure.
    Execute = False

    If Not isNumeric(value) Then Exit Function

    lhsValue = value
    
    ' Get the value for the Right Hand Side of the equation.
    Select Case mRHSType
        Case eCmdValueTypes.cvtConstant
            rhsValue = mRHS
        Case eCmdValueTypes.cvtDataItem
            Set cp = GImport.GetCheckPointByName(mRHSCheckPointName)
            If cp Is Nothing Then Exit Function
            
            Set di = cp.GetDataPointByName(mRHSDataItemName)
            If di Is Nothing Then Exit Function
            
            rhsValue = di.value
        
        Case eCmdValueTypes.cvtLineOfInput
            
            If mRHSGetValue.Execute(rhsValue) = False Then
                Exit Function
            End If

        Case eCmdValueTypes.cvtMe
            rhsValue = value
            
        Case Else
            rhsValue = ""
            LogError "CCmdCalculateValue", "Execute", "Invalid RHS value"
    End Select
    
    If Not isNumeric(rhsValue) Then Exit Function
    
    ' Make sure these are strings so we can determine the
    ' existence or absence of a decimal point.
    rhsValue = CStr(rhsValue)
    lhsValue = CStr(lhsValue)
    
    ' Convert both sides of the equation to doubles or longs.
    If InStr(1, rhsValue, ".") > 0 Or InStr(1, lhsValue, ".") > 0 Then
        rhsValue = CDbl(rhsValue)
        lhsValue = CDbl(lhsValue)
    Else
        rhsValue = CLng(rhsValue)
        lhsValue = CLng(lhsValue)
    End If
    
    ' Perform the calculation.
    Select Case mOperator
        Case "+"
            value = lhsValue + rhsValue
        Case "-"
            value = lhsValue - rhsValue
        Case "/"
            value = lhsValue / rhsValue
        Case "*"
            value = lhsValue * rhsValue
        Case Else
            LogError "CCmdCalculateValue", "Execute", "Invalid operator '" + mOperator + "'"
    End Select
    
    Execute = True
    Exit Function
    
eHandler:
    LogError "CCmdCalculateValue", "Execute", Error(Err)
    Resume
End Function
Public Function Load(arc As CArchive) As Boolean

    On Error GoTo eHandler
    
    Load = False
    Dim item As String, value As Variant, retVal As Integer
    
    '***************************************
    ' Get the next line from the input file.
    '***************************************
    
    Do
        retVal = arc.GetNextItem(item, value)
        
        ' Error, log it, then exit with error.
        If retVal = ArcRetType.cERROR Then
            arc.AddError
            GoTo done
            
        ' We are done with this object, leave.
        ElseIf retVal = ArcRetType.cENDITEM Then
            Exit Do
        End If
        
        Select Case retVal
            Case ArcRetType.cVALUE
            
                '*******************************
                ' Restore our internal settings.
                '*******************************
                
                Select Case item
                    Case "INDEX"
                        mIndex = value
                    Case "RHS"
                        mRHS = value
                    Case "RHSTYPE"
                        mRHSType = value
                    Case "RHSCPNAME"
                        mRHSCheckPointName = value
                    Case "RHSDINAME"
                        mRHSDataItemName = value
                    Case "RHSPOSITION"
                        RHSInputLinePosition = value
                    Case "RHSDELIMITED"
                        RHSDelimited = value
                    Case "RHSDELIMITER"
                        RHSDelimiter = value
                    Case "RHSLENGTH"
                        RHSLength = value

                    Case "OPERATOR"
                        mOperator = value
                    Case "CASESENSITIVE"
                        mCaseSensitive = value
                    Case Else
                    
                        '*****************************************
                        ' This line contains an unrecognized item.
                        '*****************************************
                        
                        arc.AddError
                        
                End Select
        End Select
    Loop While True
    
    Dim i As Integer
    
    '*****************************************************
    ' If one of the things we are going to compare is the
    ' value from another data item, we need to parse out
    ' the name of the DataItem and it's CheckPoint from
    ' the format given: "CheckpointName.DataitemName"
    '*****************************************************
        
    If mRHSType = cvtDataItem Then
        i = InStr(mRHS, ",")
        mRHSCheckPointName = left$(mRHS, i - 1)
        mRHSDataItemName = right$(mRHS, Len(mRHS) - i)
    End If
    
    Load = True
    
done:
    Exit Function
    
eHandler:
    LogError "CCmdCalculateValue", "Load", Error(Err)
End Function

Public Function Save(arc As CArchive) As Boolean
    
    On Error GoTo eHandler
    
    Save = False

    arc.SaveItem aiBEGINACTION, GCmdHelper.GetName(CmdType())
    arc.SaveItem aiVALUE, "INDEX", mIndex
    arc.SaveItem aiVALUE, "RHS", mRHS
    arc.SaveItem aiVALUE, "RHSTYPE", mRHSType
    arc.SaveItem aiVALUE, "RHSCPNAME", mRHSCheckPointName
    arc.SaveItem aiVALUE, "RHSDINAME", mRHSDataItemName
    arc.SaveItem aiVALUE, "RHSDELIMITED", RHSDelimited
    arc.SaveItem aiVALUE, "RHSDELIMITER", RHSDelimiter
    arc.SaveItem aiVALUE, "RHSPOSITION", RHSInputLinePosition
    arc.SaveItem aiVALUE, "RHSLENGTH", RHSLength
    
    arc.SaveItem aiVALUE, "OPERATOR", mOperator
    arc.SaveItem aiVALUE, "CASESENSITIVE", mCaseSensitive
    
    arc.SaveItem aiENDITEM, GCmdHelper.GetName(CmdType())

    Save = True
    Exit Function
    
eHandler:
    LogError "CCmdCalculateValue", "Save", Error(Err)
    Exit Function
    
End Function

Private Sub Class_Initialize()
    mRHSType = cvtNONE
    mOperator = "="
    mUniqueID = GetUniqueID
    mCaseSensitive = False
    Set mRHSGetValue = New CCmdGetValue
End Sub

Private Sub Class_Terminate()
    Set mRHSGetValue = Nothing
End Sub

Public Function ParseDataItemName(str As String, cpName As String, diName As String)
    ParseDataItemName = False
    Dim i As Integer
    i = InStr(1, str, ",")
    If i = 0 Then Exit Function
    
    cpName = left$(str, i - 1)
    diName = right$(str, Len(str) - i)
    ParseDataItemName = True
End Function