www.pudn.com > zytgzgl.rar > frmothersetting.frm, change:2004-06-05,size:15914b
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomct2.ocx"
Begin VB.Form frmothersetting
Caption = "其他项目设置"
ClientHeight = 7875
ClientLeft = 60
ClientTop = 450
ClientWidth = 7995
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7875
ScaleWidth = 7995
StartUpPosition = 2 '屏幕中心
Begin VB.Frame frameinfo
Caption = "项目包括"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3255
Left = 1920
TabIndex = 10
Top = 960
Width = 3975
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 = 615
Left = 2040
TabIndex = 16
Top = 2280
Width = 1575
End
Begin VB.OptionButton optionabatement
Caption = "扣发"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2160
TabIndex = 15
Top = 1320
Width = 1215
End
Begin VB.OptionButton optionallowance
Caption = "津贴"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2160
TabIndex = 14
Top = 480
Width = 1215
End
Begin VB.OptionButton optionothers
Caption = "其他项目"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 240
TabIndex = 13
Top = 2160
Width = 1695
End
Begin VB.OptionButton optionwelfare
Caption = "福利"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 240
TabIndex = 12
Top = 1320
Width = 1695
End
Begin VB.OptionButton optionbonus
Caption = "奖金"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 11
Top = 480
Width = 1455
End
End
Begin MSComCtl2.DTPicker dttime
Height = 375
Left = 5640
TabIndex = 9
Top = 240
Width = 2055
_ExtentX = 3625
_ExtentY = 661
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 71434241
CurrentDate = 38104
End
Begin VB.Frame Frame2
Caption = "备注"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 975
Left = 2520
TabIndex = 6
Top = 5640
Width = 2895
Begin VB.TextBox textremark
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 720
TabIndex = 8
Top = 240
Width = 1935
End
End
Begin VB.Frame Frame1
Caption = "金额"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Left = 2520
TabIndex = 5
Top = 4440
Width = 2775
Begin VB.TextBox textmoney
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 720
TabIndex = 7
Top = 240
Width = 1455
End
End
Begin VB.ComboBox comid
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 1920
TabIndex = 4
Top = 240
Width = 2055
End
Begin VB.CommandButton cmdcancel
Caption = "取 消"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4440
TabIndex = 3
Top = 7080
Width = 1215
End
Begin VB.CommandButton cmdok
Caption = "确 定"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1920
TabIndex = 2
Top = 7080
Width = 1215
End
Begin VB.Label Label2
Caption = "时 间"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4320
TabIndex = 1
Top = 240
Width = 975
End
Begin VB.Label Label1
Caption = "员工编号"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 480
TabIndex = 0
Top = 240
Width = 1215
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 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.optionbonus.Value = True Then
itype = 1
ElseIf Me.optionallowance.Value = True Then
itype = 2
ElseIf Me.optionwelfare.Value = True Then
itype = 3
ElseIf Me.optionabatement.Value = True Then
itype = 4
ElseIf Me.optionothers.Value = True Then
itype = 5
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 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.optionbonus.Value = True
ElseIf recordtype = 2 Then
Me.optionallowance.Value = True
ElseIf recordtype = 3 Then
Me.optionwelfare.Value = True
ElseIf recordtype = 4 Then
Me.optionabatement.Value = True
ElseIf recordtype = 5 Then
Me.optionothers.Value = True
Me.textname = strname
End If
Me.textmoney = imoney
Me.textremark = strremark
rs.Close
Me.Caption = "修改其他项目设置"
End If
End Sub
Public 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
Public Sub add()
Dim sql As String
Dim rs As New ADODB.Recordset
sql = "select * from salaryother"
Set rs = getrs(sql, "salary")
If Me.optionallowance.Value = True 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.optionbonus.Value = True 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.optionwelfare.Value = True 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.optionabatement.Value = True 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.optionothers.Value = True 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(5, Trim(Me.textname))
Call init
End If
End If
End Sub
Private Sub init()
If ichangeflag = 1 Then
Me.comid.ListIndex = 0
Me.dttime.Value = Date
Me.optionallowance.Value = False
Me.optionbonus.Value = False
Me.optionothers.Value = False
Me.optionwelfare.Value = False
Me.optionabatement.Value = False
Me.textmoney = ""
Me.textremark = ""
Else
Unload Me
End If
End Sub