frmsalarydevelopwizard.frm

金算盘软件代码

                 " Where ViewField.lngViewID=72 AND SalaryField.lngSalaryListID= " & mlngSalarylistID & _
                 " AND SalaryField.lngViewFieldID= 7699 AND ViewField.lngViewFieldID=17863 "
        gclsBase.ExecSQL (STRSQL)
        '本次扣零
        STRSQL = "UPDATE ViewField, SalaryField SET ViewField.blnIsFilter=True " & _
                 " Where ViewField.lngViewID=72 AND SalaryField.lngSalaryListID= " & mlngSalarylistID & _
                 " AND SalaryField.lngViewFieldID= 3521 AND ViewField.lngViewFieldID=17861 "
        gclsBase.ExecSQL (STRSQL)
        '代扣税额
        STRSQL = "UPDATE ViewField, SalaryField SET ViewField.blnIsFilter=True " & _
                 " Where ViewField.lngViewID=72 AND SalaryField.lngSalaryListID= " & mlngSalarylistID & _
                 " AND SalaryField.lngViewFieldID= 3520 AND ViewField.lngViewFieldID=17862 "
        gclsBase.ExecSQL (STRSQL)
        gclsBase.BaseWorkSpace.CommitTrans

        '初始化查询条件类
        Set mclsFilter = New FormCond
        '删除树结构
        If tvwFilter.Nodes.Count > 0 Then
            intSum = tvwFilter.Nodes.Count
            For i = 1 To intSum
                tvwFilter.Nodes.Remove (tvwFilter.Nodes(1))
            Next
        End If
        mclsFilter.InitCondArr mlngSalaryReportID, 72, 2
        mclsFilter.ShowFilter Me, mlngSalaryReportID, 2
        mblnIsSame = False
    End If
End Sub
'替换查询条件查询名（SalarySql）为查询名（Salary）
Private Function ChangeWhere(strNew As String) As String
    Dim strLeft As String
    Dim strRight As String
    Dim intStart As Integer
    Dim strWhere As String
    Dim strTmp As String
    
    strWhere = Trim(strNew)
    strTmp = "Salary."
    Do While InStr(strWhere, "SalarySql.") > 0
        intStart = InStr(strWhere, "SalarySql.")
        strLeft = Left(strWhere, intStart - 1)
        strRight = Right(strWhere, Len(strWhere) - intStart - Len("SalarySql.") + 1)
        strWhere = strLeft + strTmp + strRight
    Loop
    ChangeWhere = strWhere
End Function

'初始化报表项目
Private Sub InitReportItem()
    Dim STRSQL As String
    Dim recItem As rdoResultset
    'Dim recItem As Recordset
    Dim i As Integer
    Dim strSET As String
    'Dim recSET As Recordset
    Dim recSET As rdoResultset
    Dim strName As String
    Dim blnIsDevelop As Boolean
    Dim strTmp As String
    Dim blnIsOK1 As Boolean
    Dim blnIsOK2 As Boolean
    
    msgSalaryItem(0).Rows = 0
    msgSalaryItem(0).Cols = 3
    msgSalaryItem(0).ColWidth(0) = msgSalaryItem(0).Width
    msgSalaryItem(0).ColWidth(1) = 0
    msgSalaryItem(0).ColWidth(2) = 0
    msgSalaryItem(0).SelectionMode = flexSelectionByRow
    
    msgSalaryItem(1).Rows = 0
    msgSalaryItem(1).Cols = 3
    msgSalaryItem(1).Clear
    msgSalaryItem(0).Clear
    msgSalaryItem(1).ColWidth(0) = msgSalaryItem(1).Width
    msgSalaryItem(0).ColWidth(1) = 0
    msgSalaryItem(0).ColWidth(2) = 0
    msgSalaryItem(0).SelectionMode = flexSelectionByRow
    
    blnIsOK1 = False
    blnIsOK2 = False
    strSET = "SELECT Setting.lngModuleID, Setting.strSection, Setting.strKey, " & _
             " Setting.strSetting  FROM Setting " & _
             " WHERE Setting.lngModuleID=12 AND Setting.strSection='工资发放表固定项目' " & _
             " AND Setting.strKey= '序号'"
    'Set recSET = gclsBase.BaseDB.OpenRecordset(strSET, dbOpenSnapshot)
    Set recSET = gclsBase.BaseDB.OpenResultset(strSET, rdOpenStatic)
    If Not recSET.EOF Then
        strTmp = Trim(recSET!strSetting)
        If UCase(strTmp) = "TRUE" Then
            msgSalaryItem(1).Rows = msgSalaryItem(1).Rows + 1
            msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 0) = "序号"
            msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 1) = 0
            msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 2) = "'   '"
        Else
            msgSalaryItem(0).Rows = msgSalaryItem(0).Rows + 1
            msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 0) = "序号"
            msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 1) = 0
            msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 2) = "'   '"
        End If
    End If
    recSET.Close
    Set recSET = Nothing
    STRSQL = "SELECT ViewField.lngViewFieldID, ViewField.strViewFieldDesc, ViewField.strTableName," & _
             " ViewField.strFieldName FROM ViewField Where ViewField.lngViewId =  " & mlngViewID & _
             " AND ViewField.strTableName<> 'Salary' AND ViewField.blnIsFixed=True order by ViewField.lngViewFieldID DESC "
    'Set recItem = gclsBase.BaseDB.OpenRecordset(STRSQL, dbOpenSnapshot)
    Set recItem = gclsBase.BaseDB.OpenResultset(STRSQL, rdOpenStatic)
    With recItem
        If Not .EOF Then
            '.MoveLast
            '.MoveFirst
'            For i = 0 To .RecordCount - 1
            For i = 0 To .RowCount - 1
                strName = !strViewFieldDesc
                strSET = "SELECT Setting.lngModuleID, Setting.strSection, Setting.strKey, " & _
                         " Setting.strSetting  FROM Setting " & _
                         " WHERE Setting.lngModuleID=12 AND Setting.strSection='工资发放表固定项目' " & _
                         " AND Setting.strKey= '" & strName & "'"
                'Set recSET = gclsBase.BaseDB.OpenRecordset(strSET, dbOpenSnapshot)
                Set recSET = gclsBase.BaseDB.OpenResultset(strSET, rdOpenStatic)
                
                If Not recSET.EOF Then
                    strTmp = Trim(recSET!strSetting)
                    If UCase(strTmp) = "TRUE" Then
                        msgSalaryItem(1).Rows = msgSalaryItem(1).Rows + 1
                        msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 0) = strName
                        msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 1) = !lngViewFieldID
                        msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 2) = !strFieldName
                    Else
                        msgSalaryItem(0).Rows = msgSalaryItem(0).Rows + 1
                        msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 0) = strName
                        msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 1) = !lngViewFieldID
                        msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 2) = !strFieldName
                    End If
                End If
                recSET.Close
                Set recSET = Nothing
                .MoveNext
            Next
        End If
    End With
    strSET = "SELECT Setting.lngModuleID, Setting.strSection, Setting.strKey, " & _
             " Setting.strSetting  FROM Setting " & _
             " WHERE Setting.lngModuleID=12 AND Setting.strSection='工资发放表固定项目' " & _
             " AND Setting.strKey= '部门编号'"
    'Set recSET = gclsBase.BaseDB.OpenRecordset(strSET, dbOpenSnapshot)
    Set recSET = gclsBase.BaseDB.OpenResultset(strSET, rdOpenStatic)
    If Not recSET.EOF Then
        strTmp = Trim(recSET!strSetting)
        If UCase(strTmp) = "TRUE" Then
            msgSalaryItem(1).Rows = msgSalaryItem(1).Rows + 1
            msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 0) = "部门编号"
            msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 1) = 0
            msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 2) = "Department.strDepartmentCode"
        Else
            msgSalaryItem(0).Rows = msgSalaryItem(0).Rows + 1
            msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 0) = "部门编号"
            msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 1) = 0
            msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 2) = "Department.strDepartmentCode"
        End If
    End If
    recSET.Close
    Set recSET = Nothing
    
    'STRSQL = "SELECT ViewField.lngViewFieldID, ViewField.strViewFieldDesc, ViewField.strTableName, " & _
             " ViewField.strFieldName,SalaryField.lngSalaryListID ,SalaryField.blnIsDevelopPrint " & _
             " FROM ViewField INNER JOIN SalaryField ON " & _
             " ViewField.lngViewFieldID = SalaryField.lngViewFieldID " & _
             " Where ViewField.lngViewId =  " & mlngViewID & _
             " And SalaryField.lngSalaryListID = " & mlngSalarylistID & _
             " ORDER BY SalaryField.lngSalaryFieldNO "
    STRSQL = "SELECT ViewField.lngViewFieldID, ViewField.strViewFieldDesc, ViewField.strTableName, " & _
             " ViewField.strFieldName,SalaryField.lngSalaryListID ,SalaryField.blnIsDevelopPrint " & _
             " FROM ViewField , SalaryField  WHERE  " & _
             " ViewField.lngViewFieldID = SalaryField.lngViewFieldID " & _
             " AND ViewField.lngViewId =  " & mlngViewID & _
             " And SalaryField.lngSalaryListID = " & mlngSalarylistID & _
             " ORDER BY SalaryField.lngSalaryFieldNO "
    'Set recItem = gclsBase.BaseDB.OpenRecordset(STRSQL, dbOpenSnapshot)
    Set recItem = gclsBase.BaseDB.OpenResultset(STRSQL, rdOpenStatic)
    With recItem
        If Not .EOF Then
            '.MoveLast
            '.MoveFirst
            For i = 0 To .RowCount - 1
                blnIsDevelop = !blnIsDevelopPrint
                If Trim(!strViewFieldDesc) <> "序号" Then '处理序号和签名列
                    If Trim(!strViewFieldDesc) = "签名" Then
                        blnIsOK2 = True
                    End If
                    If blnIsDevelop = True Then
                        msgSalaryItem(1).Rows = msgSalaryItem(1).Rows + 1
                        msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 0) = !strViewFieldDesc
                        msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 1) = !lngViewFieldID
                        msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 2) = !strFieldName
                    Else
                        msgSalaryItem(0).Rows = msgSalaryItem(0).Rows + 1
                        msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 0) = !strViewFieldDesc
                        msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 1) = !lngViewFieldID
                        msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 2) = !strFieldName
                    End If
                End If
                .MoveNext
            Next
        End If
    End With
    recItem.Close
    Set recItem = Nothing
    strSET = "SELECT Setting.lngModuleID, Setting.strSection, Setting.strKey, " & _
             " Setting.strSetting  FROM Setting " & _
             " WHERE Setting.lngModuleID=12 AND Setting.strSection='工资发放表固定项目' " & _
             " AND Setting.strKey= '签名'"
    'Set recSET = gclsBase.BaseDB.OpenRecordset(strSET, dbOpenSnapshot)
    Set recSET = gclsBase.BaseDB.OpenResultset(strSET, rdOpenStatic)
    If Not recSET.EOF Then
        strTmp = Trim(recSET!strSetting)
        If blnIsOK2 = False Then
            If UCase(strTmp) = "TRUE" Then
                msgSalaryItem(1).Rows = msgSalaryItem(1).Rows + 1
                msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 0) = "签名"
                msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 1) = 0
                msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 2) = "'   '"
            Else
                msgSalaryItem(0).Rows = msgSalaryItem(0).Rows + 1
                msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 0) = "签名"
                msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 1) = 0
                msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 2) = "'   '"
            End If
        End If
    End If
    recSET.Close
    Set recSET = Nothing
    InitCmdCheckState
    InitcmdUpDowntate
End Sub
'保存报表项目
Private Sub SaveReportItem(ByVal lngSalaryID As Long)
    Dim STRSQL As String
    Dim i As Integer
    Dim strName As String
    Dim lngViewFieldID As Long
    Dim blnIsBill As Boolean
    
    STRSQL = "UPDATE Setting SET  Setting.strSetting ='False'  " & _
             " WHERE Setting.lngModuleID=12 AND Setting.strSection='工资发放表固定项目' "
    gclsBase.ExecSQL (STRSQL)
    STRSQL = "UPDATE SalaryField SET SalaryField.blnIsDevelopPrint = False " & _
             " WHERE SalaryField.lngSalaryListID= " & lngSalaryID
    gclsBase.ExecSQL (STRSQL)
    With msgSalaryItem(1)
        For i = 0 To .Rows - 1
            strName = Trim(.TextMatrix(i, 0))
            STRSQL = "UPDATE Setting SET  Setting.strSetting ='True'  " & _
                     " WHERE Setting.lngModuleID= 12 AND Setting.strSection='工资发放表固定项目'" & _
                     " AND Setting.strKey= '" & strName & "'"
            gclsBase.ExecSQL (STRSQL)
            lngViewFieldID = IIf(IsNull(.TextMatrix(i, 1)), 0, Val(.TextMatrix(i, 1)))
            STRSQL = "UPDATE SalaryField SET SalaryField.blnIsDevelopPrint = 1 " & _
                     " WHERE SalaryField.lngSalaryListID= " & lngSalaryID & _
                     " And  SalaryField.lngViewFieldID =" & lngViewFieldID
            gclsBase.ExecSQL (STRSQL)
        Next
    End With
End Sub

'****************************************************
'以下对应为条件控件过程
Private Sub CmdReset_Click()
      mclsFilter.CmdReset_Click Me
End Sub
Private Sub dateone_lostfocus()
    If SSTab1.Tab <> 2 Then Exit Sub
    mclsFilter.dateone_lostfocus Me
End Sub
Private Sub ReferText1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
     mclsFilter.ReferText1_MouseDown Me, Button, Shift, x, y
End Sub
Private Sub ReferText2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    mclsFilter.ReferText2_MouseDown Me, Button, Shift, x, y
End Sub
Private Sub ReferText2_ItemNotExist()
    mclsFilter.blnNotExist = True
End Sub
Private Sub tvwFilter_Expand(ByVal Node As ComctlLib.Node)
    mclsFilter.tvwFilter_Expand Me, Node
End Sub
'单击树或者,MsgFilter.Row 改变或者单击
Private Sub tvwFilter_nodeClick(ByVal Node As ComctlLib.Node)
    mclsFilter.tvwFilter_nodeClick Me, Node
End Sub
Private Sub MsgFilter_click()
    mclsFilter.MsgFilter_click Me
End Sub
Private Sub refertext1_Choose()
    mclsFilter.refertext1_Choose Me
End Sub
Private Sub txtfrom_LostFocus()
    If SSTab1.Tab <> 2 Then Exit Sub
    mclsFilter.txtfrom_LostFocus Me
End Sub
Private Sub refertext2_Choose()
    mclsFilter.refertext2_Choose Me
End Sub
Private Sub dateto_lostfocus()
    If SSTab1.Tab <> 2 Then Exit Sub
    mclsFilter.dateto_lostfocus Me
End Sub
Private Sub datefrom_lostfocus()
    If SSTab1.Tab <> 2 Then Exit Sub
   mclsFilter.datefrom_lostfocus Me
End Sub
Private Sub TxtTo_KeyDown(KeyCode As Integer, Shift As Integer)
    mclsFilter.TxtTo_KeyDown Me, KeyCode, Shift
End Sub
Private Sub TxtTo_lostfocus()
    If SSTab1.Tab <> 2 Then Exit Sub
   mclsFilter.TxtTo_lostfocus Me
End Sub