frmsalarydevelopwizard.frm

金算盘软件代码

        Right_One
    Else
        Left_One
    End If
End Sub

Private Sub msgSalaryItem_RowColChange(Index As Integer)
    If Index = 1 Then
        InitcmdUpDowntate
    End If
End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
    '设置命令按钮是否可用
    InitCmdarrState
    If SSTab1.Tab = 1 Then
        InitReportItem
    End If
    If PreviousTab = 0 Then
        If Trim(litSalarySource.Text) = "" Then
            SSTab1.Tab = 0
            ShowMsg Me.hwnd, "来源工资表不能为空。", vbInformation, Me.Caption
            Exit Sub
        End If
    End If
    If SSTab1.Tab = 2 Then
        '初始化查询条件
        InitFilterCond
    End If
End Sub

'设置选择按钮是否可用(左移,右移)
Private Sub InitCmdCheckState()
    If msgSalaryItem(0).Rows = 0 Then
        cmdCheck(0).Enabled = False
        cmdCheck(1).Enabled = False
    Else
        cmdCheck(0).Enabled = True
        cmdCheck(1).Enabled = True
    End If
    If msgSalaryItem(1).Rows = 0 Then
        cmdCheck(2).Enabled = False
        cmdCheck(3).Enabled = False
    Else
        cmdCheck(2).Enabled = True
        cmdCheck(3).Enabled = True
    End If
    If msgSalaryItem(0).Rows = 1 And msgSalaryItem(1).Rows = 1 Then
        cmdCheck(1).Enabled = False
        cmdCheck(3).Enabled = False
    End If
End Sub

Private Sub cmdCheck_Click(Index As Integer)
    Select Case Index
        Case 0
            Call Right_One
        Case 1
            Call Right_All
        Case 2
            Call Left_One
        Case 3
            Call Left_All
    End Select
End Sub
'右移全部
Private Sub Right_All()
    Dim i As Integer
    With msgSalaryItem(0)
        For i = 0 To .Rows - 1
            Call SetTwoGridMoveLine(msgSalaryItem(0), msgSalaryItem(1), 3)
        Next
        InitCmdCheckState
        InitcmdUpDowntate
    End With
End Sub
'右移一个
Private Sub Right_One()
    If msgSalaryItem(0).Rows > 0 Then
        Call SetTwoGridMoveLine(msgSalaryItem(0), msgSalaryItem(1), 3)
        InitCmdCheckState
        InitcmdUpDowntate
    End If

End Sub
'左移全部
Private Sub Left_All()
    Dim i As Integer
    With msgSalaryItem(1)
        For i = 0 To .Rows - 1
            Call SetTwoGridMoveLine(msgSalaryItem(1), msgSalaryItem(0), 3)
        Next
    End With
    With msgSalaryItem(0)
        For i = 0 To .Rows - 1
            If .TextMatrix(i, 0) = "员工编号" Then
                .Row = i
                Call SetTwoGridMoveLine(msgSalaryItem(0), msgSalaryItem(1), 3)
                Exit For
            End If
        Next
        For i = 0 To .Rows - 1
            If .TextMatrix(i, 0) = "员工姓名" Then
                .Row = i
                Call SetTwoGridMoveLine(msgSalaryItem(0), msgSalaryItem(1), 3)
                Exit For
            End If
        Next
    End With
    InitCmdCheckState
    InitcmdUpDowntate
End Sub
'左移一个
Private Sub Left_One()
 With msgSalaryItem(1)
    If .TextMatrix(.Row, 0) = "员工编号" Or .TextMatrix(.Row, 0) = "员工姓名" Then
        SSTab1.Tab = 1
        ShowMsg Me.hwnd, "固定报表项目必选。", vbInformation, Me.Caption
        Exit Sub
    Else
        Call SetTwoGridMoveLine(msgSalaryItem(1), msgSalaryItem(0), 3)
        InitCmdCheckState
        InitcmdUpDowntate
    End If
End With
End Sub

'处理两个grid之间移动行 (左移,右移)
Private Sub SetTwoGridMoveLine(objFromGrid As MSFlexGrid, objToGrid As MSFlexGrid, intCols As Integer)
    '来源Grid，目的Grid,列数
    Dim i As Integer
    Dim j As Integer
    Dim strItemText() As String

    ReDim strItemText(intCols)
    With objFromGrid '抽出可选项目列表中的数据行
        i = .Row
        For j = 0 To intCols - 1
            strItemText(j) = .TextMatrix(i, j)
        Next j
        Do While .Rows > i
            If i + 1 < .Rows Then
                For j = 0 To intCols - 1
                    .TextMatrix(i, j) = .TextMatrix(i + 1, j)
                Next j
            Else
                For j = 0 To intCols - 1
                    .TextMatrix(i, j) = ""
                Next j
                Exit Do
            End If
            i = i + 1
        Loop
        .Rows = .Rows - 1
        .ColSel = .Cols - 1
    End With
    With objToGrid
        If .Rows = 0 Then
            .AddItem ("")
        Else
            If .TextMatrix(.Rows - 1, 0) <> "" Then '新增一行
                .AddItem ("")
            End If
        End If
        i = .Rows - 1
        For j = 0 To intCols - 1
            .TextMatrix(i, j) = strItemText(j)
        Next j
        .Row = .Rows - 1
        .ColSel = .Cols - 1
    End With
End Sub
Private Sub cmdUpDown_Click(Index As Integer)
    If msgSalaryItem(1).Row >= 0 Then
        If Index = 0 Then
            setGridUpDownLine False, msgSalaryItem(1), 3
        Else
            setGridUpDownLine True, msgSalaryItem(1), 3
        End If
        InitcmdUpDowntate
    End If
End Sub
'处理grid内行移动 (上移,下移)
Private Sub setGridUpDownLine(blnIsNext As Boolean, objGrid As Object, intCols As Integer)
    '是否向下移动，目标Grid，总列数
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim lngItemID As Long
    ReDim strFieldName(intCols + 1) As String
    Dim blnCan As Boolean  '能否移动标志
    lngItemID = 0
    blnCan = False
    With objGrid
        i = .Row
        If blnIsNext Then
            If i < .Rows - 1 Then
                If Trim(.TextMatrix(i + 1, 0)) <> "" Then
                    blnCan = True
                End If
            Else
                blnCan = False
            End If
        End If
        If Not blnIsNext Then
            If i >= 0 Then
                If Trim(.TextMatrix(i - 1, 0)) <> "" Then
                    blnCan = True
                End If
            Else
                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 STRSQL As String
    Dim i As Integer
    Dim intSum As Integer
    Dim rec1 As Recordset
    Dim rec2 As Recordset
    
    '**********************************
     '对应筛选条件的改变
    If mblnIsSame = True Then
        '根据工资表视图整理职员范围表视图
        STRSQL = "SELECT * FROM ViewField WHERE lngViewID=63"
        Set rec1 = gclsBase.BaseDB.OpenRecordset(STRSQL, dbOpenDynaset)
        rec1.MoveLast
        rec1.MoveFirst
        STRSQL = "SELECT * FROM ViewField WHERE lngViewID=72"
        Set rec2 = gclsBase.BaseDB.OpenRecordset(STRSQL, dbOpenDynaset)
        rec2.MoveLast
        rec2.MoveFirst
        gclsBase.BaseWorkSpace.BeginTrans
        '根据工资表视图(63)生成发放范围视图(72)
        With rec1
            Do While Not .EOF
                If !strTableName = "Salary" Then
                   ' STRSQL = "SELECT * FROM ViewField WHERE lngViewID=72 and strFieldName = 'SalarySql." & Right(!strFieldName, Len(!strFieldName) - 7) & "'"
                    
                    rec2.FindFirst "strFieldName='SalarySql." & Right(!strFieldName, Len(!strFieldName) - 7) & "'"
                    If rec2.NoMatch Then
                        rec2.AddNew
                        rec2!strFieldName = "SalarySql." & Right(!strFieldName, Len(!strFieldName) - 7)
                        rec2!lngViewFieldNO = rec2.RecordCount + 1
                        rec2!strViewFieldDesc = !strViewFieldDesc
                        rec2!lngViewId = 72
                        rec2!bytFieldSize = !bytFieldSize
                        rec2!strTableName = "SalarySql"
                        rec2!strFieldType = !strFieldType
                        rec2!bytFieldDec = !bytFieldDec
                        rec2!blnIsFilter = True
                        rec2!bytVersion = 29
                        rec2.Update
                    End If
                End If
                .MoveNext
            Loop
        End With
        rec2.MoveLast
        rec2.MoveFirst
        '删除发放范围视图(72)中在工资表视图(63)中无法找到的记录
        With rec2
            Do While Not .EOF
                If !strTableName = "Salary" Then
                    rec1.FindFirst "Right('" & !strFieldName & "',len('" & !strFieldName & "')-10)= Right(strFieldName, Len(strFieldName) - 7) "
                    If rec1.NoMatch Then
                        .Delete
                    End If
                End If
                .MoveNext
            Loop
        End With
        '清除筛选标志
        STRSQL = "UPDATE  ViewField  Set  ViewField.blnIsFilter = False  WHERE " & _
                 " ViewField.lngViewID= 72  AND ViewField.strTableName= 'SalarySql'"
        gclsBase.ExecSQL (STRSQL)
        '工资项目
        STRSQL = "UPDATE ViewField, SalaryField SET ViewField.blnIsFilter=True " & _
                 " Where ViewField.lngViewID=72 AND SalaryField.lngSalaryListID= " & mlngSalarylistID & _
                 " AND ViewField.strTableName= 'SalarySql' AND  " & _
                 " ViewField.strFieldName = 'SalarySql.Sa' & SalaryField.lngViewFieldID "
        gclsBase.ExecSQL (STRSQL)
        '上次扣零
        STRSQL = "UPDATE ViewField, SalaryField SET ViewField.blnIsFilter=True " & _