frmsalarybillwizard.frm

金算盘软件代码

                blnCan = False
            End If
        End If
        If blnCan Then
             For k = 0 To intCols - 1
                 strFieldName(k) = .TextMatrix(i, k)
             Next k
             If blnIsNext = True Then
                 j = i + 1
             Else
                 j = i - 1
             End If
             For k = 0 To intCols - 1
                .TextMatrix(i, k) = .TextMatrix(j, k)
                .TextMatrix(j, k) = strFieldName(k)
             Next k
             .Row = j
             If .Row < .TopRow Then
                .TopRow = .Row
             End If
             If .Row > .TopRow + .Height / .RowHeight(0) - 1 Then
                .TopRow = .TopRow + 1
             End If
        End If
    End With
End Sub

'设置移动按钮是否可用(上移,下移)
Private Sub InitcmdUpDowntate()
    If msgSalaryItem(1).Rows <= 0 Then
        cmdUpDown(0).Enabled = False
        cmdUpDown(1).Enabled = False
    ElseIf msgSalaryItem(1).Row < 0 Then
        cmdUpDown(0).Enabled = False
        cmdUpDown(1).Enabled = False
    ElseIf msgSalaryItem(1).Row = 0 Then
        cmdUpDown(0).Enabled = False
        cmdUpDown(1).Enabled = True
    ElseIf msgSalaryItem(1).Row = msgSalaryItem(1).Rows - 1 Then
        cmdUpDown(1).Enabled = False
        cmdUpDown(0).Enabled = True
    Else
        cmdUpDown(0).Enabled = True
        cmdUpDown(1).Enabled = True
    End If
End Sub
'初始化查询条件
Private Sub InitFilterCond()
    Dim i As Long
    Dim intSum As Integer
    
     '对应筛选条件的改变
    If mblnIsSame = True Then
        '根据工资表视图整理职员范围表视图
        Salary.InitFilterView72 mlngSalarylistID
        '初始化查询条件类
        Set mclsFilter = New FormCond
        '删除树结构
        On Error Resume Next
        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

'初始化报表项目
Private Sub InitReportItem()
    Dim strSql As String
    Dim recItem As rdoResultset
    Dim strSET As String
    Dim recSet As rdoResultset
    Dim i As Long
    Dim strName As String
    Dim blnIsBill As Boolean
    Dim strTmp As String
    Dim blnIsOK As Boolean
    
    msgSalaryItem(0).Rows = 0
    msgSalaryItem(0).Cols = 5
    msgSalaryItem(0).ColWidth(0) = msgSalaryItem(0).width
    msgSalaryItem(0).ColWidth(1) = 0
    msgSalaryItem(0).ColWidth(2) = 0
    msgSalaryItem(0).ColWidth(3) = 0
    msgSalaryItem(0).ColWidth(4) = 0
    msgSalaryItem(0).SelectionMode = flexSelectionByRow
    
    msgSalaryItem(1).Rows = 0
    msgSalaryItem(1).Cols = 5
    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).ColWidth(3) = 0
    msgSalaryItem(0).ColWidth(4) = 0
    msgSalaryItem(0).SelectionMode = flexSelectionByRow
    
    'strSql = "SELECT ViewField.lngViewFieldID, ViewField.strViewFieldDesc, ViewField.strTableName," & _
             " ViewField.strFieldName,ViewField.strFieldType,ViewField.bytFieldDec FROM ViewField Where ViewField.lngViewId =  " & mlngSalaryViewID & _
             " AND ViewField.strTableName<> 'Salary' AND ViewField.blnIsFixed=True  order by ViewField.lngViewFieldID DESC "
    strSql = "SELECT ViewField.lngViewFieldID, ViewField.strViewFieldDesc, ViewField.strTableName," & _
             " ViewField.strFieldName,ViewField.strFieldType,ViewField.bytFieldDec FROM ViewField WHERE ViewField.lngViewId = " & mlngSalaryViewID & _
             " AND UPPER(ViewField.strTableName)<> 'SALARY' AND ViewField.blnIsFixed=1 " & _
             " ORDER BY  ViewField.lngViewFieldID DESC "
    Set recItem = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recItem
        If Not .EOF Then
            .MoveLast
            .MoveFirst
            For i = 0 To .RowCount - 1
                strName = !strViewFieldDesc
                strSET = "SELECT Setting.lngModuleID, Setting.strSection, Setting.strKey, " & _
                         " Setting.strSetting  FROM Setting " & _
                         " WHERE Setting.lngModuleID=11 AND Setting.strSection='工资条固定项目' " & _
                         " AND Setting.strKey= '" & strName & "'"
                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
                        msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 3) = !strFieldType
                        msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 4) = !bytFieldDec
                    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
                        msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 3) = !strFieldType
                        msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 4) = !bytFieldDec
                    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=11 AND Setting.strSection='工资条固定项目' " & _
             " AND Setting.strKey= '部门编号'"
    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"
            msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 3) = "String"
            msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 4) = 0
        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"
            msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 3) = "String"
            msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 4) = 0
        End If
    End If
    recSet.Close
    Set recSet = Nothing
    blnIsOK = False
    'strSql = "SELECT ViewField.lngViewFieldID, ViewField.strViewFieldDesc, ViewField.strTableName, " & _
             " ViewField.strFieldName,SalaryField.lngSalaryListID,SalaryField.blnIsBillPrint," & _
             " SalaryField.blnIsDevelopPrint, ViewField.strFieldType,ViewField.bytFieldDec FROM ViewField INNER JOIN SalaryField ON " & _
             " ViewField.lngViewFieldID = SalaryField.lngViewFieldID " & _
             " Where ViewField.lngViewId =  " & mlngSalaryViewID & _
             " And SalaryField.lngSalaryListID = " & mlngSalarylistID & _
             " ORDER BY SalaryField.lngSalaryFieldNO "
    strSql = "SELECT ViewField.lngViewFieldID, ViewField.strViewFieldDesc, ViewField.strTableName, " & _
             " ViewField.strFieldName,SalaryField.lngSalaryListID,SalaryField.blnIsBillPrint," & _
             " SalaryField.blnIsDevelopPrint,ViewField.strFieldType,ViewField.bytFieldDec " & _
             " FROM ViewField,SalaryField " & _
             " WHERE ViewField.lngViewFieldID = SalaryField.lngViewFieldID " & _
             " AND ViewField.lngViewId =  " & mlngSalaryViewID & _
             " And SalaryField.lngSalaryListID = " & mlngSalarylistID & _
             " ORDER BY SalaryField.lngSalaryFieldNO "
    Set recItem = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recItem
        If Not .EOF Then
            .MoveLast
            .MoveFirst
            For i = 0 To .RowCount - 1
                blnIsBill = UCase(!blnIsBillPrint)
                If Trim(!strViewFieldDesc) = "发放日期" Then
                    blnIsOK = True
                End If
                If blnIsBill = 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
                    msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 3) = !strFieldType
                    msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 4) = !bytFieldDec
                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
                    msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 3) = !strFieldType
                    msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 4) = !bytFieldDec
                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=11 AND Setting.strSection='工资条固定项目' " & _
             " AND Setting.strKey= '发放日期'"
    Set recSet = gclsBase.BaseDB.OpenResultset(strSET, rdOpenStatic)
    If Not recSet.EOF Then
        strTmp = Trim(recSet!strSetting)
        If blnIsOK = 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) = "SalaryList.strDate"
                msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 3) = "String"
                msgSalaryItem(1).TextMatrix(msgSalaryItem(1).Rows - 1, 4) = 0
            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) = "SalaryList.strDate"
                msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 3) = "String"
                msgSalaryItem(0).TextMatrix(msgSalaryItem(0).Rows - 1, 4) = 0
            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 Long
    Dim strName As String
    Dim lngViewFieldID As Long
    Dim blnIsBill As Boolean
    
    strSql = "UPDATE Setting SET  Setting.strSetting ='False'  " & _
             " WHERE Setting.lngModuleID=11 AND Setting.strSection='工资条固定项目' "
    gclsBase.ExecSQL (strSql)
    strSql = "UPDATE SalaryField SET SalaryField.blnIsBillPrint = 0 " & _
             " 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= 11 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.blnIsBillPrint = 1 " & _
                     " WHERE SalaryField.lngSalaryListID= " & lngSalaryID & _
                     " And  SalaryField.lngViewFieldID =" & lngViewFieldID
            gclsBase.ExecSQL (strSql)
        Next
    End With
End Sub

'****************************************************
'以下对应为条件控件过程(数据范围)
Private Sub mclsHook_OnMessage(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, bCancel As Long)
  If Msg = WM_KEYUP Then
      If wParam = vbKeyUp Or wParam = vbKeyDown Then
          MsgFilter_click
      End If
  End If
End Sub
Private Sub CmdReset_Click()
    If Not (mclsFilter Is Nothing) Then
      mclsFilter.CmdReset_Click Me
    End If
End Sub
Private Sub dateone_lostfocus()
    If Not (mclsFilter Is Nothing) Then
        mclsFilter.dateone_lostfocus Me
    End If
End Sub

Private Sub ReferText1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
     If Not (mclsFilter Is Nothing) Then
        mclsFilter.ReferText1_MouseDown Me, Button, Shift, x, y
    End If
End Sub
Private Sub ReferText2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not (mclsFilter Is Nothing) Then
        mclsFilter.ReferText2_MouseDown Me, Button, Shift, x, y
    End If
End Sub
Private Sub ReferText2_ItemNotExist()
    If Not (mclsFilter Is Nothing) Then
        mclsFilter.blnNotExist = True
    End If
End Sub
Private Sub tvwFilter_Expand(ByVal Node As msComctlLib.Node)
    If Not (mclsFilter Is Nothing) Then
        mclsFilter.tvwFilter_Expand Me, Node
    End If
End Sub
Private Sub tvwFilter_Collapse(ByVal Node As msComctlLib.Node)
    If Not (mclsFilter Is Nothing) Then
        mclsFilter.tvwFilter_Collapse Me, Node
    End If
End Sub
'单击树或者,MsgFilter.Row 改变或者单击
Private Sub tvwFilter_nodeClick(ByVal Node As msComctlLib.Node)
    If Not (mclsFilter Is Nothing) Then
        mclsFilter.tvwFilter_nodeClick Me, Node
    End If
End Sub
Private Sub MsgFilter_click()
    If Not (mclsFilter Is Nothing) Then
        mclsFilter.MsgFilter_click Me
    End If
End Sub
Private Sub refertext1_Choose()
    If Not (mclsFilter Is Nothing) Then
        mclsFilter.refertext1_Choose Me
    End If
End Sub
Private Sub txtfrom_LostFocus()
    If Not (mclsFilter Is Nothing) Then
        mclsFilter.txtfrom_LostFocus Me
    End If
End Sub
Private Sub refertext2_Choose()
    If Not (mclsFilter Is Nothing) Then
        mclsFilter.refertext2_Choose Me
    End If
End Sub
Private Sub dateto_lostfocus()
    If Not (mclsFilter Is Nothing) Then
        mclsFilter.dateto_lostfocus Me
    End If
End Sub
Private Sub datefrom_lostfocus()
    If Not (mclsFilter Is Nothing) Then
        mclsFilter.datefrom_lostfocus Me
    End If
End Sub
Private Sub TxtTo_KeyDown(KeyCode As Integer, Shift As Integer)
    If Not (mclsFilter Is Nothing) Then
        mclsFilter.TxtTo_KeyDown Me, KeyCode, Shift
    End If
End Sub
Private Sub TxtTo_lostfocus()
    If Not (mclsFilter Is Nothing) Then
        mclsFilter.TxtTo_lostfocus Me
    End If
End Sub