📄 frmsalaryedit.frm
字号:
VERSION 5.00
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmSalaryEdit
Caption = "工资表数据录入"
ClientHeight = 4800
ClientLeft = 150
ClientTop = 435
ClientWidth = 8010
HelpContextID = 60107
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 4800
ScaleWidth = 8010
Begin VB.PictureBox picSalary
BackColor = &H8000000E&
Height = 3435
Left = 60
ScaleHeight = 3375
ScaleWidth = 7665
TabIndex = 0
Top = 750
Width = 7725
End
Begin VB.ComboBox cboInputItem
Height = 300
Left = 4770
Style = 2 'Dropdown List
TabIndex = 7
Top = 0
Width = 3015
End
Begin VB.CommandButton cmdFind
BeginProperty Font
Name = "System"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 7485
Style = 1 'Graphical
TabIndex = 12
Tag = "1017"
Top = 360
UseMaskColor = -1 'True
Width = 315
End
Begin VB.ComboBox cboEdit
Height = 300
Index = 1
ItemData = "frmSalaryEdit.frx":0000
Left = 915
List = "frmSalaryEdit.frx":0010
Style = 2 'Dropdown List
TabIndex = 9
Top = 360
Width = 2655
End
Begin VB.ComboBox cboEdit
Height = 300
Index = 0
ItemData = "frmSalaryEdit.frx":003C
Left = 915
List = "frmSalaryEdit.frx":003E
TabIndex = 5
Text = "cboEdit"
Top = 0
Width = 2655
End
Begin VB.TextBox txtEdit
Height = 300
Left = 4770
TabIndex = 11
Top = 360
Width = 2715
End
Begin ComctlLib.ProgressBar prgBar
Height = 270
Left = 4080
TabIndex = 13
Top = 4320
Visible = 0 'False
Width = 3765
_ExtentX = 6641
_ExtentY = 476
_Version = 327682
Appearance = 1
End
Begin MSForms.CheckBox chkAutoCalc
Height = 270
Left = 2640
TabIndex = 3
Top = 4380
Width = 1095
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 4
Size = "1931;476"
Value = "0"
Caption = "自动计算"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
End
Begin MSForms.CommandButton cmdEdit
Height = 345
Index = 0
Left = 45
TabIndex = 1
Tag = "1018"
Top = 4335
Width = 1215
Caption = "编辑"
PicturePosition = 196613
Size = "2143;609"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "内 容(&C)"
Height = 195
Index = 3
Left = 3660
TabIndex = 10
Top = 420
Width = 1005
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "录入项目(&X)"
Height = 195
Index = 2
Left = 3645
TabIndex = 6
Top = 60
Width = 1005
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "工资表(&S)"
Height = 255
Index = 0
Left = 90
TabIndex = 4
Top = 60
Width = 855
End
Begin MSForms.CommandButton cmdEdit
Height = 345
Index = 1
Left = 1275
TabIndex = 2
Tag = "1018"
Top = 4350
Width = 1215
Caption = "报表"
PicturePosition = 196613
Size = "2143;609"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "查 找(&F)"
Height = 195
Index = 1
Left = 90
TabIndex = 8
Top = 420
Width = 900
End
End
Attribute VB_Name = "frmSalaryEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'工资表录入
'功能: 录入、修改、计算、扣零处理、扣税处理工资表数据
'输入接口
'Grid , List, ListSet
'
'读取工资列表中的 SalaryList '工资列表Recordset
'读取工资列表中的 SalaryID '工资表ID
'读取工资列表中的 Employee '雇员表Recordset
'读取工资列表中的 SalaryViewID '工资表视图ID
'读取工资列表中的 EditItem '调用项目卡片，0 修改，1 新增
'
'作者: 唐吉禹
'1998-6-20
'关键数字说明:
' 63: 工资表视图ID
' 72: 工资表筛选ID
' 673: 工资固定项部门名称(Department.strDepartmentName)视图字段ID
' 674: 工资固定项员工姓名(Employee.strEmployeeName)视图字段ID
' 675: 工资固定项职员类别(EmployeeType.strEmployeeTypeName)视图字段ID
' 1436: 工资固定项员工编号(Employee.strEmployeeCode)视图字段ID
' 3520: 本次扣零(扣零计算,字段名(Salary.dblNowZero) ,公式标志(CalcZero))
' 3521: 代扣税额(扣税计算,字段名(Salary.dblNowTax) ,公式标志(CalcTax))
' 7699: 上次扣零(发放扣零,字段名(Salary.dblLastZero),公式标志(PutZero))
' 18324: 银行帐号(字段名(Salary.strBankCode)作为工资数据,不参与计算和录入,只作工资信息)
' 18660: 工龄 (字段名(Salary.Sa18660)作为工资数据参与计算,不参与录入和作为被计算项目)
' 17861: 本次扣零作为筛选字段的视图字段ID
' 17862: 代扣税额作为筛选字段的视图字段ID
' 17863: 上次扣零作为筛选字段的视图字段ID
' 18325: 银行帐号作为筛选字段的视图字段ID
Option Explicit
Private WithEvents mclsSalaryGrid As SalaryGrid
Attribute mclsSalaryGrid.VB_VarHelpID = -1
Private mrecSalaryLoad As rdoResultset
Private mlngSalaryID As Long '工资表ID
Private mintSalaryViewID As Integer '工资表视图ID号
Private WithEvents mMenu As MainControl
Attribute mMenu.VB_VarHelpID = -1
Private mlngID() As Long 'ID数组
Private mblnIsZero As Boolean '扣零否
Private mblnIsTax As Boolean '扣税否
Private mlngTaxID As Long '扣税ID
Private mlngZeroID As Long '扣零ID
Private mdblDeductLevel As Double '扣零级别
Private mlngDeductPutFieldID As Long '发放扣零项目
Private mblnIsMonthDuduct As Boolean '发放扣零否
Private mblnEditData As Boolean '修改工资数据，作为重新计算工资数据标志
Private mlngEditViewFieldID As Long '计算项目ID
Private mstrRefreshSql As String '刷新查询
Private mstrSelect As String '工资项目Select
Private mlngOperatorID As Long '当前操作员
Private mlngListID As Long '当前ListID(栏目设置后赋值，保存后清掉，退出时大于零删除，不保存栏目设置的结果)
Private mstrListName As String '当前List名称
Private mblnItemSet As Boolean '栏目设置否
Private mblnKeyPress As Boolean '查找标志
Private mstrFindText As String '查找文本
Private mblnIsPostDate As Boolean '工资表是否已经结帐，作为能否修改的标志
Private mstrSalaryName As String '工资表名称
Private mblnFilter As Boolean '是否筛选
Private mblnAutoCalc As Boolean '是否自动计算
Private mblnIsLockCol As Boolean '是否有锁定列
Private mlngLockCol As Long '锁定列
Private mintSortType As Integer '排序类型 0，不排序, 1，升序，2，降序
Private mintSortCol As Integer '排序列
Private mstrWhere As String '筛选条件
Private mblnRefreshGrid As Boolean '刷新列表否(判断工资表下拉参照的初始化)
Private mblnLoad As Boolean '刷新录入栏目否(判断录入栏目的初始化)
Private mblnFindSort As Boolean '刷新查找排序否(判断查找排序的初始化)
Private mblnChangeText As Boolean '执行查找文本改变过程标志
Private mblnIsListSetOK As Boolean '栏目设置确认退出
Private mblnDateIsChange As Boolean '工资数据是否发生改变(True发生改变)
Private mInputItemType() As String '录入项目类型 mInputItemType(项目名称；录入类型（"0":不允许录入,"1":只允许数字,
' 2:允许日期,3:允许所有(字符型)）；小数位数；字段说明；字段类型（"0":其它类型,"1":数字,2:日期,3:字符型）)
Private mblnIsSave As Boolean '是否保存，排序时不保存
Private Sub JionGrid() '刷新列表
Dim strSelect As String, strFrom As String, strWhere As String
Dim strSql As String
Dim recRecordset As rdoResultset
Dim i As Long
strSelect = "SELECT Employee.lngEmployeeID AS ID " & mstrSelect
With mclsSalaryGrid.ListSet
strFrom = .FromOfSql
strWhere = .WhereOfSql
End With
strSql = strSelect & strFrom & " Where " & strWhere
If mstrWhere <> "" And mblnFilter Then
strSql = strSql & " AND " & mstrWhere & " AND Salary.lngSalaryListID=" & mlngSalaryID
Else
strSql = strSql & " AND Salary.lngSalaryListID=" & mlngSalaryID
End If
mstrRefreshSql = strSql
strSql = strSql & " Order By 1 Asc "
Set mrecSalaryLoad = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If mrecSalaryLoad.EOF Then
ShowMsg Me.hwnd, "没有满足筛选条件的结果。", vbInformation, Me.Caption
mblnFilter = False
strSql = strSelect & strFrom & " Where " & strWhere
strSql = strSql & " AND Salary.lngSalaryListID=" & mlngSalaryID
mstrRefreshSql = strSql
strSql = strSql & " Order By 1 Asc "
Set mrecSalaryLoad = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
End If
''初始化数据和风格
InitGridData
End Sub
Private Sub cboEdit_Click(Index As Integer)
Dim i As Long
Dim intRow As Long
Select Case Index
Case 0 '工资表
If Not mblnRefreshGrid Then Exit Sub
If cboEdit(0).ListIndex > -1 Then
If mblnDateIsChange Then
If Not mblnIsPostDate Then
Me.MousePointer = vbHourglass
Call CalcOldData(mlngSalaryID, True)
Me.MousePointer = vbDefault
prgBar.Visible = False
End If
End If
mlngSalaryID = mlngID(cboEdit(0).ListIndex)
Call GetSalaryIsPost(mlngSalaryID)
Call InitCalc(mlngSalaryID)
End If
frmSalaryList.SalaryID = mlngSalaryID
mstrSalaryName = frmSalaryList.SalaryName
InitInputItem
mblnLoad = True
cboInputItem.ListIndex = 0
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -