frmsalaryedit.frm

金算盘软件代码

    Dim recViewField As rdoResultset
    Dim i As Long
    Dim blnAddNew As Boolean
    Dim lngTmpListID As Long
    Dim lngTmpListFieldId As Long
    
    On Error GoTo Errors1
    gclsBase.BaseWorkSpace.BeginTrans
    strSql = "UPDATE List SET lngOperatorID=0 WHERE lngViewID=" & mintSalaryViewID _
        & " AND lngOperatorID=" & mlngOperatorID
    gclsBase.BaseDB.Execute strSql
    strSql = "SELECT * FROM List WHERE lngOperatorID=-1 AND lngViewID=" & mintSalaryViewID
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurRowVer, 64)
    If recRecordset.EOF() Then
        If blnEdit Then
            lngTmpListID = BillPublic.GetNewID("LIST")
            strSql = "INSERT INTO List (lngListID,lngOperatorID,strListName,lngViewID) Values(" & lngTmpListID & "," & mlngOperatorID _
                & ",'" & "ZjTjyGasoft001_001" & mstrSalaryName & "'," & mintSalaryViewID & ")"
            gclsBase.BaseDB.Execute strSql
        Else
            lngTmpListID = BillPublic.GetNewID("LIST")
            strSql = "INSERT INTO List (lngListID,lngOperatorID,strListName,lngViewID) Values(" & lngTmpListID & ",-1" _
                & ",'" & mstrSalaryName & "'," & mintSalaryViewID & ")"
            gclsBase.BaseDB.Execute strSql
            strSql = "SELECT * FROM List WHERE lngOperatorID=-1 AND lngViewID=" & mintSalaryViewID
            Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurRowVer, 64)
        End If
    Else
        If blnEdit Then
            recRecordset.Edit
            recRecordset!lngOperatorID = mlngOperatorID
            recRecordset.Update
        End If
    End If
    If blnEdit Then
        strSql = "SELECT lngListID FROM List WHERE lngOperatorID=" & mlngOperatorID & " AND lngViewID=" & mintSalaryViewID
        Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    End If
    mlngListID = recRecordset!lngListID
    strSql = "SELECT * FROM ListField WHERE lngListID=" & mlngListID
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurRowVer, 64)
    If Not recRecordset.EOF Then
        recRecordset.MoveLast
        recRecordset.MoveFirst
    End If
    i = 1
    '写ListField固定项
    strSql = "SELECT ViewField.strViewFieldDesc,ViewField.strFieldName,ViewField.lngViewFieldID," _
        & "ViewField.bytFieldSize FROM ViewField WHERE lngViewID=" & mintSalaryViewID & " AND" _
        & " blnIsFixed=1 ORDER BY ViewField.lngViewFieldNO"
    Set recViewField = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    recViewField.MoveLast
    recViewField.MoveFirst
    Do While Not recViewField.EOF
        With recRecordset
            If .EOF Then
                .AddNew
                lngTmpListFieldId = BillPublic.GetNewID("LISTFIELD")
                !lngListFieldID = lngTmpListFieldId
            Else
                .Edit
            End If
            !lngListID = mlngListID
            !lngViewFieldID = recViewField!lngViewFieldID
            !lngListFieldNO = i
            !strListFieldDesc = recViewField!strViewFieldDesc
            !lngDisplayWidth = Utility.GetDisplayWidth(recViewField!strViewFieldDesc, _
                recViewField!bytFieldSize)
            !blnIsChoosed = 1
            .Update
            If Not .EOF() Then
                .MoveNext
            End If
        End With
        i = i + 1
        recViewField.MoveNext
    Loop
    '写ListField非固定项
    If blnEdit Then
        'strSql = "SELECT ViewField.strViewFieldDesc,ViewField.strFieldName,ViewField.lngViewFieldID," _
            & "ViewField.bytFieldSize" _
            & " FROM (SalaryField INNER JOIN SalaryList ON SalaryField.lngSalaryListID = " _
            & " SalaryList.lngSalaryListID) INNER JOIN ViewField ON SalaryField.lngViewFieldID = " _
            & " ViewField.lngViewFieldID WHERE SalaryList.lngSalaryListID=" & mlngSalaryID _
            & " ORDER BY SalaryField.lngSalaryFieldNO"
        strSql = "SELECT ViewField.strViewFieldDesc,ViewField.strFieldName,ViewField.lngViewFieldID," _
            & " ViewField.bytFieldSize" _
            & " FROM SalaryField,SalaryList,ViewField " _
            & " WHERE (SalaryField.lngSalaryListID = SalaryList.lngSalaryListID) " _
            & " AND SalaryField.lngViewFieldID = ViewField.lngViewFieldID " _
            & " AND SalaryList.lngSalaryListID=" & mlngSalaryID _
            & " ORDER BY SalaryField.lngSalaryFieldNO"
    Else
        'strSql = "SELECT ViewField.strViewFieldDesc,ViewField.strFieldName,ViewField.lngViewFieldID," _
            & "ViewField.bytFieldSize FROM ViewField WHERE blnIsFixed=False AND lngViewID=" _
            & mintSalaryViewID & " ORDER BY ViewField.lngViewFieldNO "
        strSql = "SELECT ViewField.strViewFieldDesc,ViewField.strFieldName,ViewField.lngViewFieldID," _
            & "ViewField.bytFieldSize FROM ViewField WHERE blnIsFixed=0 AND lngViewID=" _
            & mintSalaryViewID & " ORDER BY ViewField.lngViewFieldNO "
    End If
    Set recViewField = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    recViewField.MoveLast
    recViewField.MoveFirst
    blnAddNew = False
    Do While Not recViewField.EOF
        With recRecordset
            If .EOF Then
                .AddNew
                blnAddNew = True
                lngTmpListFieldId = BillPublic.GetNewID("LISTFIELD")
                !lngListFieldID = lngTmpListFieldId
            Else
                .Edit
            End If
            !lngListID = mlngListID
            !lngViewFieldID = recViewField!lngViewFieldID
            !lngListFieldNO = i
            !strListFieldDesc = recViewField!strViewFieldDesc
            !lngDisplayWidth = Utility.GetDisplayWidth(recViewField!strViewFieldDesc, _
                recViewField!bytFieldSize)
            !blnIsChoosed = 1
            .Update
            If Not .EOF() Then
                .MoveNext
            End If
        End With
        i = i + 1
        recViewField.MoveNext
    Loop
    If Not blnAddNew Then
        Do While Not recRecordset.EOF
            recRecordset.Delete
            recRecordset.MoveNext
        Loop
    End If
    recRecordset.Close
    Set recRecordset = Nothing
    recViewField.Close
    Set recViewField = Nothing
    gclsBase.BaseWorkSpace.CommitTrans
    Exit Sub
Errors1:
    gclsBase.BaseWorkSpace.RollBacktrans
    Resume Next
End Sub
'得到SELECT串
Private Function GetFieldString(ByRef Objrec As Object) As String
    Dim strSql As String
    Dim recRecordset As rdoResultset
    Dim i As Long
    Dim j As Long
    Dim lngTmp As Long
    
    GetFieldString = ""
    '固定列录入
    '判断当前操作员的固定列
    'strSql = "SELECT ViewField.strViewFieldDesc,ViewField.strFieldName,ViewField.lngViewFieldID," _
        & "ViewField.bytFieldSize FROM (List INNER JOIN ListField ON List.lngListID = ListField.lngListID" _
        & ") INNER JOIN ViewField ON ListField.lngViewFieldID = ViewField.lngViewFieldID WHERE " _
        & "List.lngOperatorID=1 AND ViewField.lngViewID=63 AND ViewField.blnIsFixed ORDER BY " _
        & "ListField.lngListFieldNO"
    strSql = "SELECT ViewField.strViewFieldDesc,ViewField.strFieldName,ViewField.lngViewFieldID," _
        & "ViewField.bytFieldSize FROM List,ListField,ViewField " _
        & " WHERE (List.lngListID = ListField.lngListID )" _
        & " AND ViewField.lngViewFieldID=ListField.lngViewFieldID " _
        & " AND List.lngOperatorID=1 AND ViewField.lngViewID=63 AND ViewField.blnIsFixed=1 " _
        & " ORDER BY ListField.lngListFieldNO"
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recRecordset.EOF Then
        'strSql = "SELECT ViewField.strViewFieldDesc,ViewField.strFieldName,ViewField.lngViewFieldID," _
            & "ViewField.bytFieldSize FROM ViewField WHERE lngViewID=" & mintSalaryViewID & " AND" _
            & " blnIsFixed=True ORDER BY ViewField.lngViewFieldNO "
        strSql = "SELECT ViewField.strViewFieldDesc,ViewField.strFieldName,ViewField.lngViewFieldID," _
            & "ViewField.bytFieldSize FROM ViewField WHERE lngViewID=" & mintSalaryViewID & " AND" _
            & " blnIsFixed=1 ORDER BY ViewField.lngViewFieldNO "
        Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    End If
    
    lngTmp = 0
    i = 0
    With recRecordset
        If Not .EOF Then
            .MoveLast
            .MoveFirst
            lngTmp = .RowCount - 1
        End If
        If Not Objrec.EOF Then
            Objrec.MoveLast
            Objrec.MoveFirst
            lngTmp = lngTmp + Objrec.RowCount
        End If
        If lngTmp > 0 Then
            ReDim mInputItemType(lngTmp, 4)
        End If
        Do While Not .EOF
            GetFieldString = GetFieldString & "," & !strFieldName & " AS " & !strViewFieldDesc
            mInputItemType(i, 0) = Trim(!strViewFieldDesc)
            mInputItemType(i, 0) = Salary.Change_Text("[", "", mInputItemType(i, 0))
            mInputItemType(i, 0) = Salary.Change_Text("]", "", mInputItemType(i, 0))
            mInputItemType(i, 1) = "0"
            mInputItemType(i, 2) = "0"
            mInputItemType(i, 3) = Trim(!strFieldName)
            mInputItemType(i, 4) = "3"
            i = i + 1
            .MoveNext
        Loop
    End With
    '非固定列
    j = 0
    With Objrec
        Do While Not .EOF
            'mlngListID=0，表示新增
            If !blnIsChoosed Or mlngListID = 0 Then
                strSql = "UPDATE ViewField SET lngViewFieldNO=" & (j + 5) _
                    & " WHERE lngViewFieldID=" & !lngViewFieldID
                gclsBase.BaseDB.Execute strSql
                strSql = "UPDATE SalaryField SET lngSalaryFieldNO=" & (j + 1) _
                    & " WHERE lngViewFieldID=" & !lngViewFieldID _
                    & " AND lngSalaryListID=" & mlngSalaryID
                gclsBase.BaseDB.Execute strSql
                mInputItemType(i, 0) = Trim(!strViewFieldDesc)
                mInputItemType(i, 0) = Salary.Change_Text("[", "", mInputItemType(i, 0))
                mInputItemType(i, 0) = Salary.Change_Text("]", "", mInputItemType(i, 0))
                mInputItemType(i, 3) = Trim(!strFieldName)
                '工资表数据，且非本次扣零，代扣税额，上次扣零
                If UCase(Trim(!strTableName)) = "SALARY" And UCase(Trim(!strFieldName)) <> "SALARY.DBLNOWTAX" _
                    And UCase(Trim(!strFieldName)) <> "SALARY.DBLNOWZERO" And UCase(Trim(!strFieldName)) _
                    <> "SALARY.DBLLASTZERO" And UCase(Trim(!strFieldName)) <> "SALARY.STRBANKCODE" _
                    And UCase(Trim(!strFieldName)) <> "SALARY.SA18660" Then
                    Select Case UCase(!strFieldType)
                    Case "DOUBLE"
                        mInputItemType(i, 1) = "1"
                        mInputItemType(i, 4) = "1"
                    Case "DATE"
                        mInputItemType(i, 1) = "2"
                        mInputItemType(i, 4) = "2"
                    Case "STRING"
                        mInputItemType(i, 1) = "3"
                        mInputItemType(i, 4) = "3"
                    Case Else
                        mInputItemType(i, 1) = "0"
                        mInputItemType(i, 4) = "0"
                    End Select
                Else
                    mInputItemType(i, 1) = "0"
                End If
                mInputItemType(i, 2) = !bytFieldDec
                '显示格式设置
                If !bytFieldDec > 0 Then
                    If UCase(!strFieldType) = "DOUBLE" Then
                        'GetFieldString = GetFieldString & "," & "IIF(" & !strFieldName & "= 0 ,'',Format(" _
                            & !strFieldName & ",'###,###,##0." & String(!bytFieldDec, "0") & "')) AS [" & !strViewFieldDesc & "]"
                        GetFieldString = GetFieldString & "," & !strFieldName & " AS " _
                            & !strViewFieldDesc
                    ElseIf UCase(!strFieldType) = "DATE" Then
                        'GetFieldString = GetFieldString & ",Format(" & !strFieldName & ",'yyyy-mm-dd')  AS [" _
                            & !strViewFieldDesc & "]"
                        GetFieldString = GetFieldString & "," & !strFieldName & " AS " _
                            & !strViewFieldDesc
                    Else
                        GetFieldString = GetFieldString & "," & !strFieldName & " AS " _
                            & !strViewFieldDesc
                    End If
                Else
                    If UCase(!strFieldType) = "DOUBLE" Then
                        'GetFieldString = GetFieldString & ",IIF(" & !strFieldName & "=0,'',Format(" _
                            & !strFieldName & ",'#')) AS [" & !strViewFieldDesc & "]"
                        GetFieldString = GetFieldString & "," & !strFieldName & " AS " _
                            & !strViewFieldDesc
                    ElseIf UCase(!strFieldType) = "DATE" Then
                        'GetFieldString = GetFieldString & ",Format(" & !strFieldName & ",'yyyy-mm-dd')  AS [" _
                            & !strViewFieldDesc & "]"
                        GetFieldString = GetFieldString & "," & !strFieldName & " AS " _
                            & !strViewFieldDesc
                    Else
                        GetFieldString = GetFieldString & "," & !strFieldName & " AS " _
                            & !strViewFieldDesc
                    End If
                End If
                i = i + 1
                j = j + 1
            End If
            .MoveNext
        Loop
    End With
End Function
'当前ListID
Public Property Get ListID() As Long
    ListID = mlngListID
End Property
'当前操作员
Public Property Get OperatorID() As Long
    OperatorID = mlngOperatorID
End Property
Public Property Let ListID(ByVal lngID As Long)
    mlngListID = lngID
End Property
'当前List名称
Public Property Let ListName(ByVal lngName As String)
    mstrListName = lngName
End Property
Public Property Get ListName() As String
    ListName = mstrListName
End Property
'栏目设置否
Public Property Let ItemSet(ByVal blnItemSet As Boolean)
    mblnItemSet = blnItemSet
End Property

Private Sub CancelOperatorRecord()
    Dim strSql As String
    Dim recRecordset As rdoResultset
    Dim lngOperatorID As Long
    Dim lngListID As Long
    lngOperatorID = gclsBase.OperatorID
    strSql = "SELECT lngListID FROM List WHERE lngOperatorID=" & lngOperatorID _
        & " AND lngViewID=" & mintSalaryViewID
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recRecordset.EOF Then
        lngListID = recRecordset!lngListID
        strSql = "UPDATE List SET lngOperatorID=0 WHERE lngListID<>" & lngLis