📄 frmsalaryitem.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmSalaryItem
BorderStyle = 3 'Fixed Dialog
Caption = "工资发放项目"
ClientHeight = 4200
ClientLeft = 750
ClientTop = 855
ClientWidth = 8265
HelpContextID = 10230
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4200
ScaleWidth = 8265
ShowInTaskbar = 0 'False
Begin VB.CommandButton cmdChangList
Height = 405
Index = 5
Left = 6990
Style = 1 'Graphical
TabIndex = 11
Top = 3720
UseMaskColor = -1 'True
Width = 315
End
Begin VB.CommandButton cmdChangList
Height = 405
Index = 4
Left = 6990
Style = 1 'Graphical
TabIndex = 10
Top = 3300
UseMaskColor = -1 'True
Width = 315
End
Begin VB.CommandButton cmdAddItem
Height = 350
Index = 0
Left = 7000
Style = 1 'Graphical
TabIndex = 8
Top = 240
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdAddItem
Cancel = -1 'True
Height = 350
Index = 1
Left = 7000
Style = 1 'Graphical
TabIndex = 9
Top = 600
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdChangList
Caption = ">"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 336
Index = 0
Left = 3290
MaskColor = &H00000000&
TabIndex = 4
Top = 1530
UseMaskColor = -1 'True
Width = 420
End
Begin VB.CommandButton cmdChangList
Caption = ">>"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 336
Index = 1
Left = 3290
MaskColor = &H00000000&
TabIndex = 5
Top = 1905
UseMaskColor = -1 'True
Width = 420
End
Begin VB.CommandButton cmdChangList
Caption = "<"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 336
Index = 2
Left = 3290
MaskColor = &H00000000&
TabIndex = 6
Top = 2280
UseMaskColor = -1 'True
Width = 420
End
Begin VB.CommandButton cmdChangList
Caption = "<<"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 336
Index = 3
Left = 3290
MaskColor = &H00000000&
TabIndex = 7
Top = 2655
UseMaskColor = -1 'True
Width = 420
End
Begin MSFlexGridLib.MSFlexGrid msgSalaryItem
Height = 3885
Index = 1
Left = 3750
TabIndex = 3
Top = 240
Width = 3195
_ExtentX = 5636
_ExtentY = 6853
_Version = 393216
Cols = 5
FixedCols = 0
BackColorBkg = -2147483643
GridColor = 16777215
GridColorFixed = 16777215
FocusRect = 0
GridLines = 0
GridLinesFixed = 0
ScrollBars = 2
SelectionMode = 1
FormatString = "项目名称 |类型|长度|小数 | "
End
Begin MSFlexGridLib.MSFlexGrid msgSalaryItem
Height = 3885
Index = 0
Left = 45
TabIndex = 1
Top = 240
Width = 3195
_ExtentX = 5636
_ExtentY = 6853
_Version = 393216
Cols = 5
FixedCols = 0
BackColorFixed = -2147483644
BackColorBkg = -2147483643
GridColor = 16777215
GridColorFixed = 16777215
FocusRect = 0
GridLines = 0
GridLinesFixed = 0
ScrollBars = 2
SelectionMode = 1
FormatString = "项目名称 |类型|长度|小数 "
End
Begin VB.Label lblWizrd
BackStyle = 0 'Transparent
Caption = "本次发放的工资项目(&S)"
Height = 195
Index = 4
Left = 3810
TabIndex = 2
Top = 30
Width = 2055
End
Begin VB.Label lblWizrd
BackStyle = 0 'Transparent
Caption = "可选择的工资项目(&K)"
Height = 225
Index = 3
Left = 180
TabIndex = 0
Top = 30
Width = 1785
End
End
Attribute VB_Name = "frmSalaryItem"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'工资发放项目
'
'功能：选择本次发放的项目
'
'作者：唐吉禹
'
'1998-7-12
'
Option Explicit
Private mintEditItem As Integer
Private mblnItemIsChange As Boolean '发放项目是否发生改变
Private mblnIsFlag As Boolean '是否给取消项目的提示
Private mblnFormcloseIsOk As Boolean '窗体的关闭是通过确定按钮关闭的。
Private Sub cmdAddItem_Click(Index As Integer)
Dim recSalaryField As rdoResultset
Dim strTmp As String
Dim recTmp As rdoResultset
Dim lngSalaryID As Long
Dim strSql As String
Dim strSalarySql As String
Dim strInWhere As String
Dim intMsg As Integer
Dim i As Integer
If Not mblnItemIsChange Then
mblnFormcloseIsOk = False
Unload Me
Exit Sub
End If
Select Case Index
Case 0 '确定
mblnFormcloseIsOk = True
'已结帐期间的数据不允许修改
If frmSalaryEdit.IsPostDate Then
Unload Me
Exit Sub
End If
If Trim(msgSalaryItem(1).TextMatrix(1, 1)) = "" Then
ShowMsg Me.hwnd, "发放项目不能少于一个。", vbInformation, Me.Caption
Exit Sub
End If
lngSalaryID = frmSalaryList.SalaryID
'查找本次发放要删除的项目
i = 1
With msgSalaryItem(0)
strInWhere = ""
Do While i < .Rows
strTmp = "SELECT SalaryField.*,ViewField.strTableName,ViewField.strFieldName," & _
" ViewField.strFieldType FROM SalaryField,ViewField " & _
" WHERE SalaryField.lngViewFieldID = ViewField.lngViewFieldID " & _
" AND lngSalaryListID=" & lngSalaryID & _
" AND LTRIM(RTRIM(SalaryField.lngViewFieldID))=" & Val(.TextMatrix(i, 4))
Set recTmp = gclsBase.BaseDB.OpenResultset(strTmp, rdOpenStatic)
If Not recTmp.EOF Then
If mblnIsFlag Then
intMsg = ShowMsg(Me.hwnd, "取消项目:" & Trim(.TextMatrix(i, 0)) & "？", vbOKCancel + vbDefaultButton1 + vbQuestion, Me.Caption)
Else
intMsg = 1
End If
If intMsg = 1 Then
'清除工资表数据
If UCase(Trim(recTmp!strTableName)) = "SALARY" Then
If UCase(Trim(recTmp!strFieldType)) = "DOUBLE" Then
Select Case Val(.TextMatrix(i, 4))
'不能清除上次扣零
Case 7699
strSalarySql = ""
Case 3521
'清除本次扣税
'strSalarySql = "UPDATE SalaryList SET blnIsTax=False,lngTaxFieldID=0" _
& " WHERE lngSalaryListID=" & lngSalaryID
strSalarySql = "UPDATE SalaryList SET blnIsTax=0,lngTaxFieldID=0" _
& " WHERE lngSalaryListID=" & lngSalaryID
gclsBase.BaseDB.Execute strSalarySql
'清除扣税计算公式
'strSalarySql = "DELETE SalaryFormula.* FROM SalaryFormula WHERE TRIM(strSalaryFormula)='CalcTax'" _
& " AND lngSalaryListID=" & lngSalaryID
strSalarySql = "DELETE FROM SalaryFormula WHERE LTRIM(RTRIM(strSalaryFormula))='CalcTax'" _
& " AND lngSalaryListID=" & lngSalaryID
gclsBase.BaseDB.Execute strSalarySql
strSalarySql = "UPDATE Salary SET dblNowTax=0"
Case 3520
'清除本次扣零
strSalarySql = "UPDATE SalaryList SET dblDeductLevel=0,lngDeductFieldID=0" _
& " WHERE lngSalaryListID=" & lngSalaryID
gclsBase.BaseDB.Execute strSalarySql
'清除扣零计算公式
'strSalarySql = "DELETE SalaryFormula.* FROM SalaryFormula WHERE TRIM(strSalaryFormula)='CalcZero'" _
& " AND lngSalaryListID=" & lngSalaryID
strSalarySql = "DELETE FROM SalaryFormula WHERE LTRIM(RTRIM(strSalaryFormula))='CalcZero'" _
& " AND lngSalaryListID=" & lngSalaryID
gclsBase.BaseDB.Execute strSalarySql
strSalarySql = "UPDATE Salary SET dblNowZero=0"
Case 18324
'银行帐号
strSalarySql = ""
Case 18660
'工龄
strSalarySql = ""
Case Else
strSalarySql = "UPDATE Salary SET Sa" & .TextMatrix(i, 4) & "=0"
End Select
Else
If Val(.TextMatrix(i, 4)) = 18324 Then '银行帐号
strSalarySql = ""
Else
strSalarySql = "UPDATE Salary SET Sa" & .TextMatrix(i, 4) & "=' '"
End If
End If
If strSalarySql <> "" Then
strSalarySql = strSalarySql & " WHERE lngSalaryListID=" & lngSalaryID
gclsBase.BaseDB.Execute strSalarySql
End If
End If
If Trim(strInWhere) = "" Then
strInWhere = "(" & .TextMatrix(i, 4)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -