frmsalarycardnew.frm

金算盘软件代码

            blnIsOK = SalarySameName(strItemName, strErr)
            If blnIsOK Then
                Me.MousePointer = vbDefault
                ShowMsg Me.hWnd, strErr, vbInformation, Me.Caption
                Exit Sub
            End If
        End If
        Call AddSalaryItem
        cboEditItem(0).Text = ""
        cboEditItem(0).Visible = True
        cboEditItem(1).Enabled = True
        Select Case Trim(cboEditItem(1).Text)
        Case "数字"
            txtCard(0).Enabled = True
            updCard(0).Enabled = True
            txtCard(1).Enabled = True
            updCard(1).Enabled = True
        Case "文本"
            txtCard(0).Enabled = True
            updCard(0).Enabled = True
            txtCard(1).Enabled = False
            updCard(1).Enabled = False
            txtCard(1).Text = 0
           '日期
        Case Else
            txtCard(0).Enabled = False
            updCard(0).Enabled = False
            txtCard(1).Enabled = False
            updCard(1).Enabled = False
            txtCard(0).Text = 10
            txtCard(1).Text = 0
        End Select
        On Error Resume Next
        cboEditItem(0).SetFocus
        On Error GoTo 0
        Me.MousePointer = vbDefault
    End Select
End Sub

'''''
'工资新增数据项目与报表文本项目是否重名(工资发放调用)
Private Function SalarySameName(ByVal strName As String, strReturnInfo As String) As Boolean
    Dim strSql As String, strTable As String
    Dim lngViewId As Long
    Dim rstName As rdoResultset
    Dim ColName As New Collection
    
    strSql = "SELECT Distinct ReportField.strReportFieldDesc From ReportField Where lngViewFieldID In (SELECT lngViewFieldID From ViewField Where lngViewID in (593,595,637) And upper(strFieldType)<>upper('Double'))"
    'strSql = "SELECT Distinct ViewField.strViewFieldDesc From ViewField Where lngViewID in (593,595,637) And Ucase(strFieldType)<>Ucase('Double')"
    Set rstName = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With rstName
        
        Do Until .EOF
            ColName.Add 1, .rdoColumns("strReportFieldDesc")
            .MoveNext
        Loop
        
        On Error Resume Next
        lngViewId = -1
        lngViewId = ColName.Item(strName)
        If lngViewId > 0 Then
            strReturnInfo = "报表已有[" & strName & "]了,请重新命名!"
            SalarySameName = True
        Else
            strReturnInfo = ""
            SalarySameName = False
        End If
        On Error GoTo 0
    End With
    rstName.Close
    Set rstName = Nothing
End Function

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_Load()
    Dim strSql As String
    Dim recViewField As rdoResultset
    Dim recZ As rdoResultset
    Dim recY As rdoResultset
    
    mintEditItem = frmSalaryList.EditItem
    mblnEditUsed = False
    mintSalaryViewID = frmSalaryList.SalaryViewID
    'Strsql = "SELECT strViewFieldDesc,strFieldType,blnIsChoose,bytFieldSize,bytFieldDec,blnIsNotList,lngViewFieldID " _
    & ",lngViewId,strTableName,blnIsPrep,lngViewFieldNO,strFieldName FROM ViewField WHERE lngViewID=" & mintSalaryViewID & " AND blnIsFixed=False"
    strSql = "SELECT strViewFieldDesc,strFieldType,blnIsChoose,bytFieldSize,bytFieldDec, " & _
             " blnIsNotList,lngViewFieldID,lngViewId,strTableName,blnIsPrep,lngViewFieldNO,strFieldName " & _
             " FROM ViewField WHERE lngViewID=" & mintSalaryViewID & " AND blnIsFixed=0"
    Set recViewField = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurRowVer, 64)
    updCard(0).Min = 1
    updCard(0).Max = 250
    updCard(1).Min = 0
    updCard(1).Max = 9
    If recViewField.EOF And mintEditItem = 0 Then
        Unload Me '无项目可以修改
    Else
        If mintEditItem = 0 Then '修改
            cboEditItem(1).Enabled = False
            '对固定项目认为是已经使用
            With frmSalaryListNewWizard.msgWizard(1) '发放列表
            If Val(.TextMatrix(.Row, 4)) = 3520 Or Val(.TextMatrix(.Row, 4)) = 3521 Or Val(.TextMatrix(.Row, 4)) = 7699 _
                 Or Val(.TextMatrix(.Row, 4)) = 18324 Or Val(.TextMatrix(.Row, 4)) = 18660 Then
                mblnEditUsed = True
            End If
            End With
            recViewField.MoveFirst
            '初始化卡片
            With frmSalaryListNewWizard.msgWizard(1)
                cboEditItem(0).Text = .TextMatrix(.Row, 0)
                Select Case UCase(.TextMatrix(.Row, 1))
                Case "STRING"
                    cboEditItem(1).Text = "文本"
                Case "DATE"
                    cboEditItem(1).Text = "日期"
                Case "DOUBLE"
                    cboEditItem(1).Text = "数字"
                End Select
                txtCard(0).Text = .TextMatrix(.Row, 2)
                mintSize = .TextMatrix(.Row, 2)
                txtCard(0).Text = .TextMatrix(.Row, 3)
                mintDec = Val(.TextMatrix(.Row, 3))
                '判断该项目是否为已经使用项目
                strSql = "SELECT lngViewFieldID FROM SalaryField WHERE lngViewFieldID=" & Val(.TextMatrix(.Row, 4))
                Set recViewField = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                If Not recViewField.EOF Then
                    mblnEditUsed = True
                Else
                    If Not mblnEditUsed Then
                        strSql = "SELECT strTableName FROM ViewField WHERE lngViewFieldID=" & Val(.TextMatrix(.Row, 4))
                        Set recY = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                        If Not recY.EOF Then
                            If UCase(recY!strTableName) = "SALARY" Then
                                '工资表有数据不能修改数据类型
                                strSql = "Select LngSalaryListId From Salary "
                                Set recZ = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                                If recZ.EOF Then
                                    cboEditItem(1).Enabled = True
                                End If
                                recZ.Close
                                Set recZ = Nothing
                            End If
                        End If
                        recY.Close
                        Set recY = Nothing
                    End If
                End If
            End With
        End If
    End If
    Set cmdAddItem(0).Picture = Utility.GetFormResPicture(1001, 0)
    Set cmdAddItem(1).Picture = Utility.GetFormResPicture(1002, 0)
    Set cmdAddItem(2).Picture = Utility.GetFormResPicture(1009, 0)
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    recViewField.Close
    Set recViewField = Nothing
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture (1001)
    Utility.RemoveFormResPicture (1002)
    Utility.RemoveFormResPicture (1009)
    Utility.RemoveFormResPicture (139)
    Set frmSalaryCardNew = Nothing
End Sub
'修改项目
Private Function SalaryItemEdit() As Boolean
    Dim strSql As String
    Dim lngViewFieldID As Long
    Dim recRecordset As rdoResultset
    Dim recZ As rdoResultset
    Dim strFieldName As String
    '判断工资名称
    SalaryItemEdit = False
    If Trim(cboEditItem(0).Text) = "" Then
        ShowMsg Me.hWnd, "工资项目不允许为空。", vbInformation, Me.Caption
        cboEditItem(0).SetFocus
        Exit Function
    End If
    If cboEditItem(1).Text = "日期" Then
        txtCard(0).Text = 10
    End If
    With frmSalaryListNewWizard.msgWizard(1)
        lngViewFieldID = .TextMatrix(.Row, 4)
    End With
    '本次扣零、扣税，上次扣税
    If lngViewFieldID = 3520 Or lngViewFieldID = 3521 Or lngViewFieldID = 7699 Or lngViewFieldID = 18324 Or lngViewFieldID = 18660 Then
        If CheckOK() Then
            strSql = "UPDATE ViewField SET strViewFieldDesc='" & Trim(cboEditItem(0).Text) _
                & "' Where lngViewFieldID=" & lngViewFieldID
            gclsBase.BaseDB.Execute strSql
            SalaryItemEdit = True
            frmSalaryListNewWizard.msgWizard(1).TextMatrix(frmSalaryListNewWizard.msgWizard(1).Row, 0) = cboEditItem(0).Text
        End If
        Exit Function
    End If
    '判断该项目在ViewField中是否存在
    strSql = "SELECT strTableName FROM ViewField WHERE lngViewFieldID=" & lngViewFieldID
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recRecordset.EOF Then
        SalaryItemEdit = True
        recRecordset.Close
        Set recRecordset = Nothing
        Exit Function
    End If
    strFieldName = "Sa" & lngViewFieldID
    If CheckOK() Then
        With frmSalaryListNewWizard.msgWizard(1)
            '其他表的项目不能修改大小和类型
            If UCase(recRecordset!strTableName) <> "SALARY" Then
                txtCard(0).Text = .TextMatrix(.Row, 2)
                txtCard(1).Text = .TextMatrix(.Row, 3)
                cboEditItem(1).Text = .TextMatrix(.Row, 1)
            End If
            If lngViewFieldID = 18324 Then
                txtCard(0).Text = .TextMatrix(.Row, 2)
                txtCard(1).Text = .TextMatrix(.Row, 3)
                cboEditItem(1).Text = .TextMatrix(.Row, 1)
            End If
            If lngViewFieldID = 18660 Then
                txtCard(0).Text = .TextMatrix(.Row, 2)
                txtCard(1).Text = .TextMatrix(.Row, 3)
                cboEditItem(1).Text = .TextMatrix(.Row, 1)
            End If
            On Error GoTo Errorss
            gclsBase.BaseWorkSpace.BeginTrans
            '修改类型(已用项目不能类型，工资表有数据不能修改类型）
            If Trim(cboEditItem(1).Text) <> Trim(.TextMatrix(.Row, 1)) Then
                If Not mblnEditUsed Then
                    strSql = "Select LngSalaryListId From Salary "
                    Set recZ = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    If recZ.EOF Then
                        Call EditType
                        SalaryItemEdit = True
                        gclsBase.BaseWorkSpace.CommitTrans
                        Exit Function
                    Else
                        cboEditItem(1).Text = .TextMatrix(.Row, 1)
                    End If
                Else
                    cboEditItem(1).Text = .TextMatrix(.Row, 1)
                End If
                '修改数据精度,数据标度(工资表没有有数据可以修改数据精度,数据标度
                '如果工资表有数据数据精度,数据标度不能减小)
            Else
                If Not mblnEditUsed Then
                    strSql = "Select LngSalaryListId From Salary "
                    Set recZ = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    If recZ.EOF Then
                        Call EditType
                        SalaryItemEdit = True
                        gclsBase.BaseWorkSpace.CommitTrans
                        Exit Function
                    Else
                        If Trim(cboEditItem(1).Text) = "数字" Then
                            '数据长度不能减小
                            If Val(txtCard(0).Text) < Val(.TextMatrix(.Row, 2)) Then
                                txtCard(0).Text = .TextMatrix(.Row, 2)
                                txtCard(1).Text = .TextMatrix(.Row, 3)
                            '数据长度不变
                            ElseIf Val(txtCard(0).Text) = Val(.TextMatrix(.Row, 2)) Then
                                '小数位数不能改变
                                If Val(txtCard(1).Text) <> Val(.TextMatrix(.Row, 3)) Then
                                    txtCard(1).Text = .TextMatrix(.Row, 3)
                                End If
                            '数据长度增大
                            Else
                                '小数位数不能减小
                                If Val(txtCard(1).Text) < Val(.TextMatrix(.Row, 3)) Then
                                    txtCard(1).Text = .TextMatrix(.Row, 3)
                                '数据长度增大，小数位数不变
                                ElseIf Val(txtCard(1).Text) = Val(.TextMatrix(.Row, 3)) Then
                                    Call EditType
                                    SalaryItemEdit = True
                                    gclsBase.BaseWorkSpace.CommitTrans
                                    Exit Function
                                '小数位数增大
                                Else
                                    '小数位数的增加位数不超出数据长度的增加位数
                                    If Val(txtCard(1).Text) - Val(.TextMatrix(.Row, 3)) <= Val(txtCard(0).Text) - Val(.TextMatrix(.Row, 2)) Then
                                        Call EditType
                                        SalaryItemEdit = True
                                        gclsBase.BaseWorkSpace.CommitTrans
                                        Exit Function
                                    Else
                                        txtCard(0).Text = .TextMatrix(.Row, 2)
                                        txtCard(1).Text = .TextMatrix(.Row, 3)
                                    End If
                                End If
                            End If
                        End If
                    End If
                    recZ.Close
                    Set recZ = Nothing
                Else
                    If Trim(cboEditItem(1).Text) = "数字" Then
                        '数据长度不能减小
                        If Val(txtCard(0).Text) < Val(.TextMatrix(.Row, 2)) Then
                            txtCard(0).Text = .TextMatrix(.Row, 2)