frmsalarydeveloptable.frm

金算盘软件代码

                        Next mlngCurPage
                    Else                    '不按顺序 1 打印，起始页必须为奇数 (1,3,5)
                        For mlngCurPage = lngStartPage + IIf(lngStartPage Mod 2 = 0, 1, 0) To lngEndPage Step 2 '1,3,5
'                            SetData
                            For i = 1 To frm.GCopiesPrint
                            'Load frmPrintMsg
                            'frmPrintMsg.Show
                            'frmPrintMsg.lblCurrPage.Caption = mlngCurPage
                            SetData
                            ABook.PrintDirect
                            'Unload frmPrintMsg
                            Next i
                        Next mlngCurPage
                    End If
                        
                    If frm.GIsPrintbyPrderTwo Then          '按顺序 2 打印，起始页必须为偶数 (6,4,2)
                        For mlngCurPage = lngEndPage + IIf(lngEndPage Mod 2 = 0, 0, -1) To lngStartPage Step -2 '6,4,2
'                            SetData
                            For i = 1 To frm.GCopiesPrint
                            'Load frmPrintMsg
                            'frmPrintMsg.Show
                            'frmPrintMsg.lblCurrPage.Caption = mlngCurPage
                            SetData
                            ABook.PrintDirect
                            'Unload frmPrintMsg
                            Next i
                        Next mlngCurPage
                    Else                                '按顺序 2 打印，起始页必须为偶数 (2,4,6)
                        For mlngCurPage = lngStartPage + IIf(lngStartPage Mod 2 = 0, 0, 1) To lngEndPage Step 2 '2,4,6
'                            SetData
                            For i = 1 To frm.GCopiesPrint
                            'Load frmPrintMsg
                            'frmPrintMsg.Show
                            'frmPrintMsg.lblCurrPage.Caption = mlngCurPage
                            SetData
                            ABook.PrintDirect
                            'Unload frmPrintMsg
                            Next i
                        Next mlngCurPage
                    End If
                    
                End If '单面打印
            End If '逐份打印
        
            ABook.EndPrint
            mlngCurPage = oldPage
            SetData
        Else                '输出到文件
            Dim clsFileSever As New FileSeverClass
            If frm.GintFileType = 4 Then
                If Not clsFileSever.Saveas(frm.GStrFileName, 4, , , msgAccount, , "工资发放表", frm.GintFileIndex) Then
                    Utility.ShowMsg Me.hwnd, "文件保存不成功!", vbOKOnly + vbInformation, App.title
                End If
            Else
                If Not clsFileSever.Saveas(frm.GStrFileName, frm.GintFileType, , , msgAccount, , "工资发放表") Then
                    Utility.ShowMsg Me.hwnd, "文件保存不成功!", vbOKOnly + vbInformation, App.title
                End If
            End If
            Set clsFileSever = Nothing
        End If
    End If
    'if 按部门编码打印机then 恢复正常打印分页
    '  dispartpage
    Set frm = Nothing
End Sub





Private Sub Form_Activate()
    If (Me.Left + Me.Width < 0 Or Me.Left > Screen.Width) And mblnLoaded Then
        Me.Left = 300
    End If
    gclsSys.CurrFormName = Me.hwnd
End Sub

Private Sub mclsMainControl_ListActivityMenu(ByVal intIndex As Integer)
    Select Case intIndex
        Case 0, 1, 2
            ABook.FCAlignment(0) = intIndex
        Case 4, 5, 6
            ABook.FCAlignment(0) = intIndex - 1
        Case 8, 9, 10
            ABook.FCAlignment(0) = intIndex - 2
    End Select
End Sub

Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
    Select Case intIndex
    Case 0
        cmdAccSet_Click
    Case 1
        cmdFormatSet_Click
    Case 2
    Case 3
         
    Case 4
         
    Case 5
    Case 6
        CmdPrint_Click
    End Select
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'                      *             辅助支持                  *
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'刷新纪录
Private Sub RefreshData()
    Dim blnPage As Boolean
    SetRecBook                                     '得到记录集
    blnPage = DispartPage                          '分页
    If blnPage Then SetData                        '填充数据
End Sub
'生成新记录集
Private Sub SetRecBook()
    Dim strSql As String
    'Dim recZ As Recordset
    Dim recZ As rdoResultset
    Dim intCol As Integer
    Dim i As Integer
    Dim j As Integer
    Dim dblTmp As Double
    
    strSql = mclsSalarySet.SalaryDevelopSQL
    mstrDevelopGridSql = strSql
    If Trim(strSql) <> "" Then
        'Set recZ = gclsBase.BaseDB.OpenRecordset(STRSQL, dbOpenSnapshot)
        Set recZ = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Else
       Set recZ = Nothing
       'Set DATA1.Recordset = recZ
       Set DATA1.Resultset = recZ
       Exit Sub
    End If
    'Set DATA1.Recordset = recZ
    Set DATA1.Resultset = recZ
    intCol = -1
    mintLabelCol = -1
    '写序号列
    With msgAccount
        For i = 0 To .Cols - 1
            Select Case Trim(.TextMatrix(0, i))
            Case "序号"
                intCol = i
            Case "签名"
                mintLabelCol = i
            End Select
        Next
        If intCol > -1 Then
            For i = 1 To .Rows - 1
                .TextMatrix(i, intCol) = i
            Next
        End If
    End With
    
     '设置显示格式
    With msgAccount
        For i = 0 To .Rows - 1
            For j = 0 To .Cols - 1
                '文本,字符,日期 不作转换.数字字段要作显示转换.
                If recZ.Fields(j).Type <> dbText And recZ.Fields(j).Type <> dbDate And recZ.Fields(j).Type <> dbChar Then
                    If Not IsNull(.TextMatrix(i, j)) Then
                        If IsNumeric(.TextMatrix(i, j)) Then
                              dblTmp = CDbl(.TextMatrix(i, j))
                              .TextMatrix(i, j) = IIf(dblTmp >= 1, Format(dblTmp, "##############0.00"), IIf(dblTmp > 0, Format(dblTmp, "0.00"), _
                              IIf(dblTmp = 0, "", Format(dblTmp, "#################0.00"))))
                        End If
                    End If
                End If
            Next
        Next
    End With
    recZ.Close
    Set recZ = Nothing
    '签名特殊处理
    If mintLabelCol <> -1 Then
        With msgAccount
            .TextMatrix(0, mintLabelCol - 1) = "签名"
            For intCol = 1 To .Rows - 1
                If ((intCol - 1) Mod 2) > 0 Then
                    .TextMatrix(intCol, mintLabelCol - 1) = .TextMatrix(intCol - 1, mintLabelCol - 1)
                    .TextMatrix(intCol, mintLabelCol) = .TextMatrix(intCol - 1, mintLabelCol)
                Else
                    .TextMatrix(intCol, mintLabelCol - 1) = intCol
                    .TextMatrix(intCol, mintLabelCol) = intCol + 1
                End If
            Next intCol
        End With
    End If
    '取得按部门打印的部门级别
    mIntDepartMentLevel = 0
    strSql = "SELECT Setting.lngModuleID, Setting.strSection, Setting.strSetting " & _
             " FROM Setting  Where Setting.lngModuleID=13 And Setting.strSection='工资发放表按部门打印' "
    'Set recZ = gclsBase.BaseDB.OpenRecordset(STRSQL, dbOpenSnapshot)
    Set recZ = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recZ.EOF Then
        mIntDepartMentLevel = Val(recZ!strSetting)
    End If
    If msgAccount.Rows = 1 Then
        cmdPrint.Enabled = False
    Else
        cmdPrint.Enabled = True
    End If
End Sub
'按部门打印重新分页
Private Sub DispartPagesByDepartment(ByVal intDepartmentLevel As Integer)
Dim intCol As Integer, intRow As Integer, intStartRow As Integer
Dim intDepartmentCol As Integer, intLevel As Integer
Dim lngWidth As Long, lngFixedWidth As Long
Dim strCode As String
Dim intColStart() As Integer, intColEnd() As Integer, lngColExpands As Long     '临时保存模块变量
    If msgAccount.Rows = 1 Then Exit Sub
    '找部门编码列
    intDepartmentCol = -1
    For intCol = 0 To msgAccount.Cols - 1
        If msgAccount.TextMatrix(0, intCol) = "部门编号" Then
            intDepartmentCol = intCol
            Exit For
        End If
    Next intCol
    If intDepartmentCol = -1 Then Exit Sub
    '页横向扩展
    mlngPageWidth = ABook.ColCount              '得到最大页宽度
    lngColExpands = 0
    ReDim intColStart(lngColExpands)
    ReDim intColEnd(lngColExpands)
    intColStart(0) = 0
    '取固定列宽度(第一列不计算：隐藏列)
    lngFixedWidth = 0
    For intCol = 1 To msgAccount.FixedCols - 1
        lngFixedWidth = lngFixedWidth + msgAccount.ColWidth(intCol) / Screen.TwipsPerPixelX
    Next intCol
    '算列宽
    lngWidth = lngFixedWidth
    For intCol = msgAccount.FixedCols To msgAccount.Cols - 1
        lngWidth = lngWidth + msgAccount.ColWidth(intCol) / Screen.TwipsPerPixelX
        If lngWidth > mlngPageWidth Then
            lngColExpands = lngColExpands + 1
            ReDim Preserve intColStart(lngColExpands)
            ReDim Preserve intColEnd(lngColExpands)
            lngWidth = lngFixedWidth + msgAccount.ColWidth(intCol) / Screen.TwipsPerPixelX
            intColEnd(lngColExpands - 1) = intCol - 1 - msgAccount.FixedCols
            intColStart(lngColExpands) = intCol - msgAccount.FixedCols
        End If
    Next intCol
    intColEnd(lngColExpands) = intCol - 1 - msgAccount.FixedCols
    mlngColExpands = lngColExpands + 1
    
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '页纵向扩展
    mintPageRows = GetGridheight                                    '得到最大页行数
    '强制按部门编码排序
    msgAccount.col = intDepartmentCol
    msgAccount.Sort = 6
    intLevel = intDepartmentLevel
    mlngRowExpands = 0
    intStartRow = 1
    strCode = StandardReport.GetPreXStr(msgAccount.TextMatrix(intStartRow, intDepartmentCol), intLevel, "-")
    For intRow = 2 To msgAccount.Rows - 1
        If strCode <> StandardReport.GetPreXStr(msgAccount.TextMatrix(intRow, intDepartmentCol), intLevel, "-") Then
            mlngRowExpands = mlngRowExpands + mlngColExpands
            ReDim Preserve mlngColStart(mlngRowExpands - 1)
            ReDim Preserve mlngColEnd(mlngRowExpands - 1)
            ReDim Preserve mlngRowStart(mlngRowExpands - 1)
            ReDim Preserve mlngRowEnd(mlngRowExpands - 1)
            For intCol = 0 To mlngColExpands - 1
                mlngColStart(mlngRowExpands - mlngColExpands + intCol) = intColStart(intCol)
                mlngColEnd(mlngRowExpands - mlngColExpands + intCol) = intColEnd(intCol)
                mlngRowStart(mlngRowExpands - mlngColExpands + intCol) = intStartRow
                mlngRowEnd(mlngRowExpands - mlngColExpands + intCol) = intRow - 1
            Next intCol
            intStartRow = intRow
            strCode = StandardReport.GetPreXStr(msgAccount.TextMatrix(intStartRow, intDepartmentCol), intLevel, "-")
        ElseIf intRow - intStartRow = mintPageRows Then
            mlngRowExpands = mlngRowExpands + mlngColExpands
            ReDim Preserve mlngColStart(mlngRowExpands - 1)
            ReDim Preserve mlngColEnd(mlngRowExpands - 1)
            ReDim Preserve mlngRowStart(mlngRowExpands - 1)
            ReDim Preserve mlngRowEnd(mlngRowExpands - 1)
            For intCol = 0 To mlngColExpands - 1
                mlngColStart(mlngRowExpands - mlngColExpands + intCol) = intColStart(intCol)
                mlngColEnd(mlngRowExpands - mlngColExpands + intCol) = intColEnd(intCol)
                mlngRowStart(mlngRowExpands - mlngColExpands + intCol) = intStartRow
                mlngRowEnd(mlngRowExpands - mlngColExpands + intCol) = intRow
            Next intCol
            intStartRow = intRow + 1
            strCode = StandardReport.GetPreXStr(msgAccount.TextMatrix(intStartRow, intDepartmentCol), intLevel, "-")
        End If
        If intStartRow >= msgAccount.Rows - 1 Then
            mlngRowExpands = mlngRowExpands + mlngColExpands
            ReDim Preserve mlngColStart(mlngRowExpands - 1)
            ReDim Preserve mlngColEnd(mlngRowExpands - 1)
            ReDim Preserve mlngRowStart(mlngRowExpands - 1)
            ReDim Preserve mlngRowEnd(mlngRowExpands - 1)
            For intCol = 0 To mlngColExpands - 1
                mlngColStart(mlngRowExpands - mlngColExpands + intCol) = intColStart(intCol)
                mlngColEnd(mlngRowExpands - mlngColExpands + intCol) = intColEnd(intCol)
                mlngRowStart(mlngRowExpands - mlngColExpands + intCol) = intStartRow
                mlngRowEnd(mlngRowExpands - mlngColExpands + intCol) = intRow
            Next intCol
        End If
    Next intRow
    mlngPages = mlngRowExpands
End Sub

'分页
Private Function DispartPage() As Boolean
Dim intCol As Integer, intRow As Integer
Dim intRecCount As Integer
Dim lngWidth As Long, lngFixedWidth As Long
Dim intColStart() As Integer, intColEnd() As Integer, lngColExpands As Long     '临时保存模块变量
    '页横向扩展
    mlngPageWidth = ABook.ColCount              '得到最大页宽度
    lngColExpands = 0
    ReDim intColStart(lngColExpands)
    ReDim intColEnd(lngColExpands)
    intColStart(0) = 0
    '取固定列宽度
    lngFixedWidth = 0
    For intCol = 0 To msgAccount.FixedCols - 1
        lngFixedWidth = lngFixedWidth + msgAccount.ColWidth(intCol)
        If lngFixedWidth > mlngPageWidth Then
            Utility.ShowMsg Me.hwnd, "固定列太宽!请减小列宽!", vbOKOnly + vbInformation, App.title
            DispartPage = False
            Exit Function
        End If
    Next intCol
    '算列宽
    lngWidth = lngFixedWidth
    For intCol = msgAccount.FixedCols To msgAccount.Cols - 1
        lngWidth = lngWidth + msgAccount.ColWidth(intCol) / Screen.TwipsPerPixelX
        If lngWidth > mlngPageWidth Then
            lngColExpands = lngColExpands + 1
            ReDim Preserve intColStart(lngColExpands)
            ReDim Preserve intColEnd(lngColExpands)
            lngWidth = lngFixedWidth + msgAccount.ColWidth(intCol) / Screen.TwipsPerPixelX
            intColEnd(lngColExpands - 1) = intCol - 1
            intColStart(lngColExpands) = intCol