frmsalarycardnew.frm

金算盘软件代码

        Case "扣税标准"
            recViewField!strTableName = "PersonTaxType"
            recViewField!strFieldName = "PersonTaxType.strPersonTaxTypeName ||' '|| PersonTaxType.dblStartAmount"
            recViewField!strFieldType = "STRING"
            recViewField!bytFieldSize = 30
            recViewField!bytFieldDec = 0
            GoTo InputExit
        Case "出生日期"
            recViewField!strTableName = "Employee"
            recViewField!strFieldName = "Employee.strBirthdate"
            recViewField!strFieldType = "DATE"
            recViewField!bytFieldSize = 10
            recViewField!bytFieldDec = 0
            GoTo InputExit
        Case "入职日期"
            recViewField!strTableName = "Employee"
            recViewField!strFieldName = "Employee.strInDate"
            recViewField!strFieldType = "DATE"
            recViewField!bytFieldSize = 10
            recViewField!bytFieldDec = 0
            GoTo InputExit
        Case "离职日期"
            recViewField!strTableName = "Employee"
            recViewField!strFieldName = "Employee.strOutDate"
            recViewField!strFieldType = "DATE"
            recViewField!bytFieldSize = 10
            recViewField!bytFieldDec = 0
            GoTo InputExit
        Case "发放日期"
            recViewField!strTableName = "SalaryList"
            recViewField!strFieldName = "SalaryList.strDate"
            recViewField!strFieldType = "DATE"
            recViewField!bytFieldSize = 10
            recViewField!bytFieldDec = 0
            GoTo InputExit
        End Select
        recViewField!strTableName = UCase("Salary")
        recViewField!strFieldName = UCase("Salary.Sa") & recViewField!lngViewFieldID
        Select Case cboEditItem(1).Text
        Case "数字"
            recViewField!strFieldType = "DOUBLE"
            '修改工资表结构
            'Set fidNew = gclsBase.BaseDB.TableDefs("Salary").CreateField("Sa" _
             & recViewField!lngViewFieldID, dbDouble, Val(txtCard(0).Text))
            On Error GoTo Errors
            'gclsBase.BaseDB.TableDefs("Salary").Fields.Append fidNew
            'gclsBase.BaseDB.TableDefs("Salary").Fields("Sa" & recViewField!lngViewFieldID).DefaultValue = 0
            'gclsBase.BaseDB.TableDefs("Salary").Fields("Sa" & recViewField!lngViewFieldID).Required = True
            strSql = "ALTER TABLE Salary ADD ( Sa" & lngViewFieldMaxID & " NUMBER( " & Val(txtCard(0).Text) & _
                     "," & Val(txtCard(1).Text) & ") DEFAULT 0 )"
            gclsBase.BaseDB.Execute strSql
            strSql = "UPDATE Salary SET Sa" & lngViewFieldMaxID & "=0"
            gclsBase.BaseDB.Execute strSql
        Case "文本"
            recViewField!strFieldType = "STRING"
            '修改工资表结构
            'Set fidNew = gclsBase.BaseDB.TableDefs("Salary").CreateField("Sa" _
                & recViewField!lngViewFieldID, dbText, Val(txtCard(0).Text))
            On Error GoTo Errors
            'gclsBase.BaseDB.TableDefs("Salary").Fields.Append fidNew
            'gclsBase.BaseDB.TableDefs("Salary").Fields("Sa" & recViewField!lngViewFieldID).DefaultValue = """"""
            'gclsBase.BaseDB.TableDefs("Salary").Fields("Sa" & recViewField!lngViewFieldID).AllowZeroLength = True
            strSql = " ALTER TABLE Salary ADD (SA" & lngViewFieldMaxID & " VARCHAR2( " & Val(txtCard(0).Text) _
                   & " )  DEFAULT ' ' ) "
            gclsBase.BaseDB.Execute strSql
            strSql = "UPDATE Salary SET Sa" & lngViewFieldMaxID & "=' '"
            gclsBase.BaseDB.Execute strSql
        Case "日期"
            recViewField!strFieldType = "DATE"
            '修改工资表结构
            'Set fidNew = gclsBase.BaseDB.TableDefs("Salary").CreateField("Sa" _
             & recViewField!lngViewFieldID, dbText, 10)
            On Error GoTo Errors
            'gclsBase.BaseDB.TableDefs("Salary").Fields.Append fidNew
            'gclsBase.BaseDB.TableDefs("Salary").Fields("Sa" & recViewField!lngViewFieldID).DefaultValue = """"""
            'gclsBase.BaseDB.TableDefs("Salary").Fields("Sa" & recViewField!lngViewFieldID).AllowZeroLength = True
            strSql = " ALTER TABLE Salary ADD (Sa" & lngViewFieldMaxID & " VARCHAR2(10)  DEFAULT ' ' ) "
            gclsBase.BaseDB.Execute strSql
            strSql = "UPDATE Salary SET Sa" & lngViewFieldMaxID & "=' '"
            gclsBase.BaseDB.Execute strSql
        End Select
        recViewField!bytFieldSize = Val(txtCard(0).Text)
        recViewField!bytFieldDec = Val(txtCard(1).Text)
        GoTo InputExit
    End If
    Me.MousePointer = vbDefault
    Exit Function
Errors:
    ShowMsg Me.hWnd, "数据库正被其他用户使用，现在不能增加。", vbInformation, "工资发放"
    recViewField.Close
    Set recViewField = Nothing
    Me.MousePointer = vbDefault
    Exit Function
InputExit:
    recViewField.Update
    recViewField.Close
    Set recViewField = Nothing
    strSql = "SELECT strViewFieldDesc,strFieldType,blnIsChoose,bytFieldSize,bytFieldDec,blnIsNotList,lngViewFieldID," _
         & " lngViewId,strTableName,blnIsPrep,lngViewFieldNO,strFieldName,blnIsFilter,bytVersion FROM ViewField " _
         & " WHERE lngViewID=" & mintSalaryViewID & " AND lngViewFieldID =" & lngViewFieldMaxID
    Set recViewField = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recViewField.EOF Then
        With frmSalaryListNewWizard.msgWizard(1) '追加到项目列表
            If Trim(.TextMatrix(1, 0)) <> "" Then
                .AddItem ("")
            End If
            .TextMatrix(.Rows - 1, 0) = recViewField!strViewFieldDesc
            Select Case UCase(recViewField!strFieldType)
            Case "DOUBLE"
                .TextMatrix(.Rows - 1, 1) = "数字"
            Case "STRING"
                .TextMatrix(.Rows - 1, 1) = "文本"
            Case "DATE"
                .TextMatrix(.Rows - 1, 1) = "日期"
            End Select
            strTmp = Trim(recViewField!bytFieldDec)
            .TextMatrix(.Rows - 1, 2) = recViewField!bytFieldSize
            .TextMatrix(.Rows - 1, 3) = String(4 - Len(strTmp), " ") & strTmp
            .TextMatrix(.Rows - 1, 4) = recViewField!lngViewFieldID
        End With
    End If
    recViewField.Close
    Set recViewField = Nothing
    AddSalaryItem = True
    Salary.ResetSalaryQuery
    Me.MousePointer = vbDefault
End Function
Private Sub cboEditItem_Change(Index As Integer)
    If Index = 1 Then
        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 "日期"
            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
    Else
        If Card.ContainErrorChar(cboEditItem(Index).Text, "`~!@#$^&'"";:,.?|") Then Card.BKKEY cboEditItem(Index).hWnd
        If mintEditItem = 1 Then
            Select Case Trim(cboEditItem(0).Text)
            Case "文化程度"
                cboEditItem(1).Text = "文本"
                txtCard(0).Text = 20
                txtCard(1).Text = 0
                cboEditItem(1).Enabled = False
                txtCard(0).Enabled = False
                updCard(0).Enabled = False
                txtCard(1).Enabled = False
                updCard(1).Enabled = False
            Case "职务"
                cboEditItem(1).Text = "文本"
                txtCard(0).Text = 20
                txtCard(1).Text = 0
                cboEditItem(1).Enabled = False
                txtCard(0).Enabled = False
                updCard(0).Enabled = False
                txtCard(1).Enabled = False
                updCard(1).Enabled = False
            Case "性别"
                cboEditItem(1).Text = "文本"
                txtCard(0).Text = 2
                txtCard(1).Text = 0
                cboEditItem(1).Enabled = False
                txtCard(0).Enabled = False
                updCard(0).Enabled = False
                txtCard(1).Enabled = False
                updCard(1).Enabled = False
             Case "代发银行"
                cboEditItem(1).Text = "文本"
                txtCard(0).Text = 30
                txtCard(1).Text = 0
                cboEditItem(1).Enabled = False
                txtCard(0).Enabled = False
                updCard(0).Enabled = False
                txtCard(1).Enabled = False
                updCard(1).Enabled = False
            Case "家庭地址"
                cboEditItem(1).Text = "文本"
                txtCard(0).Text = 40
                txtCard(1).Text = 0
                cboEditItem(1).Enabled = False
                txtCard(0).Enabled = False
                updCard(0).Enabled = False
                txtCard(1).Enabled = False
                updCard(1).Enabled = False
            Case "邮政编码"
                cboEditItem(1).Text = "文本"
                txtCard(0).Text = 6
                txtCard(1).Text = 0
                cboEditItem(1).Enabled = False
                txtCard(0).Enabled = False
                updCard(0).Enabled = False
                txtCard(1).Enabled = False
                updCard(1).Enabled = False
            Case "办公电话"
                cboEditItem(1).Text = "文本"
                txtCard(0).Text = 20
                txtCard(1).Text = 0
                cboEditItem(1).Enabled = False
                txtCard(0).Enabled = False
                updCard(0).Enabled = False
                txtCard(1).Enabled = False
                updCard(1).Enabled = False
            Case "住宅电话"
                cboEditItem(1).Text = "文本"
                txtCard(0).Text = 20
                txtCard(1).Text = 0
                cboEditItem(1).Enabled = False
                txtCard(0).Enabled = False
                updCard(0).Enabled = False
                txtCard(1).Enabled = False
                updCard(1).Enabled = False
            Case "身份证号码"
                cboEditItem(1).Text = "文本"
                txtCard(0).Text = 20
                txtCard(1).Text = 0
                cboEditItem(1).Enabled = False
                txtCard(0).Enabled = False
                updCard(0).Enabled = False
                txtCard(1).Enabled = False
                updCard(1).Enabled = False
            Case "扣税标准"
                cboEditItem(1).Text = "文本"
                txtCard(0).Text = 30
                txtCard(1).Text = 0
                cboEditItem(1).Enabled = False
                txtCard(0).Enabled = False
                updCard(0).Enabled = False
                txtCard(1).Enabled = False
                updCard(1).Enabled = False
            Case "出生日期"
                cboEditItem(1).Text = "日期"
                txtCard(0).Text = 10
                txtCard(1).Text = 0
                cboEditItem(1).Enabled = False
                txtCard(0).Enabled = False
                updCard(0).Enabled = False
                txtCard(1).Enabled = False
                updCard(1).Enabled = False
            Case "入职日期"
                cboEditItem(1).Text = "日期"
                txtCard(0).Text = 10
                txtCard(1).Text = 0
                cboEditItem(1).Enabled = False
                txtCard(0).Enabled = False
                updCard(0).Enabled = False
                txtCard(1).Enabled = False
                updCard(1).Enabled = False
            Case "离职日期"
                cboEditItem(1).Text = "日期"
                txtCard(0).Text = 10
                txtCard(1).Text = 0
                cboEditItem(1).Enabled = False
                txtCard(0).Enabled = False
                updCard(0).Enabled = False
                txtCard(1).Enabled = False
                updCard(1).Enabled = False
            Case "发放日期"
                cboEditItem(1).Text = "日期"
                txtCard(0).Text = 10
                txtCard(1).Text = 0
                cboEditItem(1).Enabled = False
                txtCard(0).Enabled = False
                updCard(0).Enabled = False
                txtCard(1).Enabled = False
                updCard(1).Enabled = False
            Case Else
                cboEditItem(1).Enabled = True
            End Select
        End If
    End If
End Sub
Private Sub cboEditItem_Click(Index As Integer)
    Select Case Index
    Case 1
        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
           '日期