frmothersetting.frm

企业工资管理

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomct2.ocx"
Begin VB.Form frmOtherSetting 
   Caption         =   "其他项目设置"
   ClientHeight    =   7635
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6810
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7635
   ScaleWidth      =   6810
   StartUpPosition =   2  '屏幕中心
   Begin VB.CheckBox checkAbatement 
      Caption         =   "扣    发"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   3360
      TabIndex        =   6
      Top             =   1920
      Width           =   1695
   End
   Begin VB.Frame Frame1 
      Caption         =   "金额"
      Height          =   1095
      Left            =   1200
      TabIndex        =   15
      Top             =   3600
      Width           =   4335
      Begin VB.TextBox textMoney 
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   840
         TabIndex        =   9
         Top             =   360
         Width           =   2415
      End
   End
   Begin VB.TextBox textName 
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   3360
      TabIndex        =   8
      Top             =   2880
      Width           =   1695
   End
   Begin VB.CheckBox checkOthers 
      Caption         =   "其他名称"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   1680
      TabIndex        =   7
      Top             =   2760
      Width           =   1455
   End
   Begin VB.CheckBox checkWelfare 
      Caption         =   "福    利"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1680
      TabIndex        =   5
      Top             =   1920
      Width           =   1455
   End
   Begin VB.CheckBox checkAllowance 
      Caption         =   "津    贴"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   3360
      TabIndex        =   4
      Top             =   1200
      Width           =   1575
   End
   Begin VB.CheckBox checkBonus 
      Caption         =   "奖    金"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1680
      TabIndex        =   3
      Top             =   1200
      Width           =   1455
   End
   Begin MSComCtl2.DTPicker dtTime 
      Height          =   375
      Left            =   4680
      TabIndex        =   2
      Top             =   480
      Width           =   1815
      _ExtentX        =   3201
      _ExtentY        =   661
      _Version        =   393216
      Format          =   26869761
      CurrentDate     =   37672
   End
   Begin VB.Frame Frame2 
      Caption         =   "备注"
      Height          =   1215
      Left            =   1200
      TabIndex        =   13
      Top             =   4920
      Width           =   4335
      Begin VB.TextBox textRemark 
         Height          =   855
         Left            =   120
         MultiLine       =   -1  'True
         TabIndex        =   10
         Top             =   240
         Width           =   4095
      End
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取  消"
      Height          =   615
      Left            =   4080
      TabIndex        =   12
      Top             =   6360
      Width           =   1335
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确  定"
      Height          =   615
      Left            =   1440
      TabIndex        =   11
      Top             =   6360
      Width           =   1335
   End
   Begin VB.ComboBox comID 
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   1440
      TabIndex        =   1
      Top             =   480
      Width           =   1815
   End
   Begin VB.Label Label7 
      Alignment       =   1  'Right Justify
      Caption         =   "时    间"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   3480
      TabIndex        =   14
      Top             =   480
      Width           =   1095
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "员工编号"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   1095
   End
End
Attribute VB_Name = "frmOtherSetting"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private RecordTime As Date
Private Sub cmdCancel_Click()
    Unload Me
    Exit Sub
End Sub

Private Sub addRecord(iType As Integer, strName As String)             '添加记录
    Dim sql As String
    Dim rs As New ADODB.Recordset
    sql = "select * from SalaryOther"
    Set rs = getRS(sql, "Salary")
    rs.AddNew
    rs.Fields(1) = Me.comID.Text
    rs.Fields(2) = Me.dtTime.Value
    rs.Fields(3) = iType
    rs.Fields(4) = strName
    rs.Fields(5) = Trim(Me.textMoney)
    rs.Fields(6) = Me.textRemark
    rs.Update
    rs.Close
End Sub

Private Sub init()                                   '初始化
    If ichangeFlag = 1 Then
        Me.comID.ListIndex = 0
        Me.dtTime.Value = Date
        Me.checkAllowance.Value = False
        Me.checkBonus.Value = False
        Me.checkOthers.Value = False
        Me.checkWelfare.Value = False
        Me.checkAbatement.Value = False
        Me.textMoney = ""
        Me.textRemark = ""
    Else
        Unload Me
    End If
End Sub

Public Sub add()
    Dim sql As String
    Dim rs As New ADODB.Recordset
    sql = "select * from SalaryOther"
    Set rs = getRS(sql, "Salary")
    If Me.checkAllowance.Value = vbChecked Then      '添加津贴
        If Me.textMoney = "" Then
            MsgBox "请输入津贴！", vbOKOnly + vbExclamation, "提示！"
            Me.textMoney.SetFocus
        ElseIf IsNumeric(Me.textMoney) = False Then
            MsgBox "请输入金额！", vbOKOnly + vbExclamation, "提示！"
            Me.textMoney = ""
            Me.textMoney.SetFocus
        Else
            Call addRecord(2, "津贴")
            Call init
        End If
    End If
    If Me.checkBonus.Value = vbChecked Then         '添加奖金
        If Me.textMoney = "" Then
            MsgBox "请输入奖金！", vbOKOnly + vbExclamation, "提示！"
            Me.textMoney.SetFocus
        ElseIf IsNumeric(Me.textMoney) = False Then
            MsgBox "请输入数字！", vbOKOnly + vbExclamation, "提示!"
            Me.textMoney = ""
            Me.textMoney.SetFocus
        Else
            Call addRecord(1, "奖金")
            Call init
        End If
    End If
    If Me.checkWelfare.Value = vbChecked Then        '添加福利
        If Me.textMoney = "" Then
            MsgBox "请输入福利！", vbOKOnly + vbExclamation, "提示！"
            Me.textMoney.SetFocus
        ElseIf IsNumeric(Me.textMoney) = False Then
            MsgBox "请输入数字！", vbOKOnly + vbExclamation, "提示！"
            Me.textMoney = ""
            Me.textMoney.SetFocus
        Else
            Call addRecord(3, "福利")
            Call init
        End If
    End If
    If Me.checkAbatement.Value = vbChecked Then        '添加福利
        If Me.textMoney = "" Then
            MsgBox "请输入扣发！", vbOKOnly + vbExclamation, "提示！"
            Me.textMoney.SetFocus
        ElseIf IsNumeric(Me.textMoney) = False Then
            MsgBox "请输入数字！", vbOKOnly + vbExclamation, "提示！"
            Me.textMoney = ""
            Me.textMoney.SetFocus
        Else
            Call addRecord(4, "扣发")
            Call init
        End If
    End If
    If Me.checkOthers.Value = vbChecked Then          '添加其他项目及金额
        If Me.textName = "" Then
            MsgBox "请输入其他项目的名称！", vbOKOnly + vbExclamation, "提示！"
            Me.textName.SetFocus
        ElseIf Me.textMoney = "" And IsNumeric(Me.textMoney) = False Then
            MsgBox "请输入正确的金额！", vbOKOnly + vbExclamation, "提示！"
            Me.textMoney = ""
            Me.textMoney.SetFocus
        Else
            Call addRecord(5, Trim(Me.textName))
            Call init
        End If
    End If
End Sub

Private Sub cmdOK_Click()
    Dim iType As Integer
    Dim sql As String
    Dim resumdate As Date
    sql = "select * from SalaryOther"
    If ichangeFlag = 1 Then
        Call add
        MsgBox "已经添加记录！", vbOKOnly + vbExclamation, "提示！"
        Call frmResult.OtherTopic
        Call frmResult.showOther(sql)
        frmResult.Show
        Unload Me
    Else
        If Me.checkBonus.Value = vbChecked Then
            iType = 1
        ElseIf Me.checkAllowance.Value = vbChecked Then
            iType = 2
        ElseIf Me.checkWelfare.Value = vbChecked Then
            iType = 3
        ElseIf Me.checkAbatement.Value = vbChecked Then
            iType = 4
        ElseIf Me.checkOthers.Value = vbChecked Then
            iType = 5
        End If
        resumdate = RecordTime
        sql = "delete from SalaryOther where StuffID='" & Me.comID.Text
        sql = sql & "' and YearMonth=#" & RecordTime & "# and "
        sql = sql & "Type=" & iType
        Call TransactSQL(sql, "Salary")
        Call add
        Call frmSumSalary.reSumSalary(resumdate)
        sql = "select * from SalaryOther"
        Call frmResult.OtherTopic
        Call frmResult.showOther(sql)
        frmResult.Show
        Unload Me
    End If
End Sub

Private Sub Form_Load()                                '初始化
    Dim sql As String
    Dim rs As New ADODB.Recordset
    Dim recordType As Integer
    Dim iMoney As Integer
    Dim strName As String
    Dim strRemark As String
    If ichangeFlag = 1 Then
    sql = "select SID from StuffInfo"
    Set rs = getRS(sql, "Salary")
    If rs.EOF = False Then
        While Not rs.EOF
            Me.comID.AddItem rs(0)
            rs.MoveNext
        Wend
        rs.Close
        Me.comID.ListIndex = 0
    End If
    Me.dtTime.Value = Date
    Else
        Set rs = getRS(strPublicSQL, "Salary")
        Me.comID.Text = rs(1)
        RecordTime = rs(2)
        recordType = rs(3)
        strName = rs(4)
        iMoney = rs(5)
        strRemark = rs(6)
        Me.dtTime = Date
        If recordType = 1 Then
            Me.checkBonus.Value = vbChecked
        ElseIf recordType = 2 Then
            Me.checkAllowance.Value = vbChecked
        ElseIf recordType = 3 Then
            Me.checkWelfare.Value = vbChecked
        ElseIf recordType = 4 Then
            Me.checkAbatement.Value = vbChecked
        ElseIf recordType = 5 Then
            Me.checkOthers.Value = vbChecked
            Me.textName = strName
        End If
        Me.textMoney = iMoney
        Me.textRemark = strRemark
        rs.Close
        Me.Caption = "修改其他项目设置"
    End If
End Sub