frmsalarybillwizard.frm

金算盘软件代码

                    strFormat = "'999999999999999999999999990'"
                End If
                strTmp = "DECODE(" & .TextMatrix(i, 2) & ",0,'',Ltrim(Rtrim(TO_CHAR( " & .TextMatrix(i, 2) & "," & strFormat & ")))) AS " & .TextMatrix(i, 0) & ", "
            Else
                strTmp = .TextMatrix(i, 2) & " AS " & .TextMatrix(i, 0) & ", "
            End If
            strSelect = strSelect & strTmp
        Next
    End With
    strSelect = Trim(strSelect)
    strSelect = Left(strSelect, Len(strSelect) - 1)
    'strFrom = " FROM (((((((Employee INNER JOIN Salary ON Employee.lngEmployeeID = Salary.lngEmployeeID) " & _
              " INNER JOIN EmployeeType ON Employee.lngEmployeeTypeID = EmployeeType.lngEmployeeTypeID) " & _
              " LEFT JOIN Department ON Salary.lngDepartmentID = Department.lngDepartmentID) " & _
              " LEFT JOIN Education ON Employee.lngEducationID = Education.lngEducationID) " & _
              " LEFT JOIN PersonTaxType ON Employee.lngPersonTaxTypeID = PersonTaxType.lngPersonTaxTypeID) " & _
              " LEFT JOIN Title ON Employee.lngTitleID = Title.lngTitleID)  " & _
              " INNER JOIN SalaryList ON Salary.lngSalaryListID = SalaryList.lngSalaryListID )" & _
              " LEFT JOIN Bank ON Salary.lngBankID = Bank.lngBankID"
    strFrom = " FROM Employee,Salary,EmployeeType,Department,Education,PersonTaxType," & _
              " Title,SalaryList,Bank " & _
              " WHERE ((((((( Employee.lngEmployeeID = Salary.lngEmployeeID) " & _
              " AND Employee.lngEmployeeTypeID = EmployeeType.lngEmployeeTypeID) " & _
              " AND Salary.lngDepartmentID = Department.lngDepartmentID(+)) " & _
              " AND Employee.lngEducationID = Education.lngEducationID(+)) " & _
              " AND Employee.lngPersonTaxTypeID = PersonTaxType.lngPersonTaxTypeID(+)) " & _
              " AND Employee.lngTitleID = Title.lngTitleID(+))  " & _
              " AND Salary.lngSalaryListID = SalaryList.lngSalaryListID )" & _
              " AND Salary.lngBankID = Bank.lngBankID(+)"
    strWhere = ""
    strWhere = mstrReportWhere
    SetItemSQL = strSelect & " " & strFrom
    SetItemSQL = SetItemSQL & " AND Salary.lngSalaryListID= " & mlngSalarylistID
    If Trim(strWhere) <> "" Then
        SetItemSQL = SetItemSQL & " AND " & strWhere
    End If
    SetItemSQL = SetItemSQL & " ORDER BY Employee.strEmployeeCode "
End Function

Private Sub cmdArr_Click(Index As Integer)
    Select Case Index
        Case 0   '取消
            Unload Me
            mblnIsOK = False
        Case 1   '上一步
            If SSTab1.Tab > 0 Then
                SSTab1.Tab = SSTab1.Tab - 1
            End If
        Case 2   '下一步
            If SSTab1.Tab < 2 Then
                SSTab1.Tab = SSTab1.Tab + 1
            End If
        Case 3   '完成
            mblnIsOK = True
            cmdOK_Click
    End Select
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_Load()
    Dim strSql As String
    Dim strText As String
    Dim i As Long
    Dim recSalaryList As rdoResultset
    Dim picRes As IPictureDisp
    Me.Left = (Screen.width - Me.width) \ 2
    Me.top = (Screen.Height - Me.Height) \ 2
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    '初始化报表名称
    txtReportName.Text = "工资条"
    '初始化图片资源
    Set picRes = Utility.GetFormResPicture(1019, vbResBitmap)
    cmdUpDown(0).Picture = picRes
    Set picRes = Utility.GetFormResPicture(1020, vbResBitmap)
    cmdUpDown(1).Picture = picRes
    imgSalarySet(0).Picture = Utility.GetFormResPicture(140, 0)
    imgSalarySet(1).Picture = Utility.GetFormResPicture(140, 0)
    tvwFilter.ImageList = frmMain.ImageListFilter
    Set mclsHook = New Hook
    mclsHook.SetHook MsgFilter.hwnd

    SSTab1.Tab = 0
    '设置命令按钮是否可用
    InitCmdarrState
    '初始化来源工资表
    strSql = "SELECT SalaryList.lngSalaryListID, SalaryList.strSalaryListName FROM SalaryList " & _
             " ORDER BY  SalaryList.strDate DESC"
    Set recSalaryList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recSalaryList.EOF Then
        litSalarySource.SeekCol = "1,2"
        litSalarySource.CodeSort = True
        Set litSalarySource.Recordset = recSalaryList
'        Set litSalarySource.Resultset = recSalaryList
        litSalarySource.ColWidth(1) = 0
        If litSalarySource.Referrows > 1 Then
            litSalarySource.ReferRow = 0
        End If
    End If
    recSalaryList.Close
    Set recSalaryList = Nothing
    If mlngSalarylistID > 0 Then
        litSalarySource.SeekId mlngSalarylistID
    End If
    mblnIsOK = False
    mblnIsSame = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture (140)
    Utility.RemoveFormResPicture (1019)
    Utility.RemoveFormResPicture (1020)
    Set mclsFilter = Nothing
    Set mclsHook = Nothing
    gclsSys.MainControls.Remove Me               '
    Set mclsMainControl = Nothing                '清除主控对象
    Set frmSalaryBillWizard = Nothing
End Sub

'设置命令按钮是否可用(上一步,下一步)
Private Sub InitCmdarrState()
    If SSTab1.Tab = 0 Then
        cmdArr(1).Enabled = False
        cmdArr(2).Enabled = True
        CmdReset.Visible = False
    End If
    If SSTab1.Tab = 2 Then
        cmdArr(2).Enabled = False
        cmdArr(1).Enabled = True
        CmdReset.Visible = True
    End If
    If SSTab1.Tab = 1 Then
        cmdArr(1).Enabled = True
        cmdArr(2).Enabled = True
        CmdReset.Visible = False
    End If
    If SSTab1.Tab = 0 Then
        cmdArr(3).Enabled = False
    Else
        cmdArr(3).Enabled = True
    End If
End Sub

Private Sub litSalarySource_Choose()
    If litSalarySource.ReferRow > -1 Then
        mlngSalarylistID = litSalarySource.TextMatrix(litSalarySource.ReferRow, 1)
        mblnIsSame = True
    End If
End Sub

Private Sub mclsMainControl_ChildActive()
    SetHelpID Me.HelpContextID
End Sub

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

Private Sub msgSalaryItem_DblClick(Index As Integer)
    If Index = 0 Then
        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 Long
    With msgSalaryItem(0)
        For i = 0 To .Rows - 1
            Call SetTwoGridMoveLine(msgSalaryItem(0), msgSalaryItem(1), 5)
        Next
        InitCmdCheckState
        InitcmdUpDowntate
    End With
End Sub
'右移一个
Private Sub Right_One()
    If msgSalaryItem(0).Rows > 0 Then
        Call SetTwoGridMoveLine(msgSalaryItem(0), msgSalaryItem(1), 5)
        InitCmdCheckState
        InitcmdUpDowntate
    End If

End Sub
'左移全部
Private Sub Left_All()
    Dim i As Long
    With msgSalaryItem(1)
        For i = 0 To .Rows - 1
            Call SetTwoGridMoveLine(msgSalaryItem(1), msgSalaryItem(0), 5)
        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), 5)
                Exit For
            End If
        Next
        For i = 0 To .Rows - 1
            If .TextMatrix(i, 0) = "员工姓名" Then
                .Row = i
                Call SetTwoGridMoveLine(msgSalaryItem(0), msgSalaryItem(1), 5)
                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), 5)
        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 Long
    Dim j As Long
    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), 5
        Else
            setGridUpDownLine True, msgSalaryItem(1), 5
        End If
        InitcmdUpDowntate
    End If
End Sub
'处理grid内行移动 (上移,下移)
Private Sub setGridUpDownLine(blnIsNext As Boolean, objGrid As Object, intCols As Integer)
    '是否向下移动，目标Grid，总列数
    Dim i As Long
    Dim j As Long
    Dim k As Long
    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