6 22 1 VB Example

LANSA Open Guide

6.22.1 VB Example

Function LceSetValue(iSession As Integer, sFldName As String, _

                           sStrValue As String) As Integer 

 

    ' this function is a replacement for LceSetFieldValue to be 

    ' used when you have to strip edit codes from date and value fields 

    ' it also replaces empty fields "" with null terminated strings 

 

    Dim sFlag As String

    Dim sEdit As String

    Dim sBuff As String

    Dim sValue As String

    Dim i As Integer

    Dim iRet As Integer

 

    If sStrValue = "" Then

        ' null nothing to do

        iRet = LceSetFieldValue(iSession, sFldName, Chr(0))

    Else

        ' Get Field edit type to remove formatting characters if required

        sEdit = String(FIELD_EDIT_LENGTH, 0)

        sFlag = String(FIELD_EDIT_FLAG_LENGTH, 0)

        iRet = LceGetFieldEdit(iSession, sFldName, sEdit, sFlag)

        If iRet = LceTrue Then

            Select Case sFlag

                Case "E"

                    sValue = sStrValue ' copy value

                    sEdit = sTrim(sEdit)

                    Select Case sEdit

                        Case "Y" ' 

                            ' date so Remove date Separator

                            i = InStr(sValue, sDtSep)

                            While i > 0

                                sValue = Left(sValue, i - 1) +  _

                                         Mid(sValue, i + 1, 99)

                                i = InStr(sValue, sDtSep)

                            Wend

                        Case "1" ' 

                            ' currency remove Thousand separator

                            i = InStr(sValue, sTwSep)

                            While i > 0

                                sValue = Left(sValue, i - 1) +  _ 

                                        Mid(sValue, i + 1, 99)

                                i = InStr(sValue, sTwSep)

                            Wend

                    End Select

                    ' Save field

                    iRet = LceSetFieldValue(iSession, sFldName, sValue)

                Case "W"

                Case "N"

                    ' nothing to do

                    iRet = LceSetFieldValue(iSession, sFldName, _

                                                   sStrValue)

            End Select

        End If

    End If

    ' set return code

    LceSetValue = iRet

End Function