frmsalarydeveloptable.frm

金算盘软件代码

      _ExtentX        =   2990
      _ExtentY        =   1058
      _Version        =   65541
      Rows            =   20
      Cols            =   10
      FixedCols       =   0
   End
   Begin MSForms.CommandButton CmdZoom 
      Height          =   345
      Left            =   2670
      TabIndex        =   19
      Top             =   5850
      Width           =   1215
      Caption         =   "缩放"
      PicturePosition =   196613
      Size            =   "2143;609"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin MSForms.CommandButton CmdPaper 
      Height          =   345
      Left            =   3900
      TabIndex        =   18
      Top             =   5850
      Width           =   1215
      Caption         =   "纸张"
      PicturePosition =   196613
      Size            =   "2143;609"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
End
Attribute VB_Name = "frmSalaryDevelopTable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'工资发放表
'作者：邹俊
'1998-11-12

'列表查询(真实报表：综合)
' 作者：邓强
' 功能：根据用户选择列表项目组织数据显示（真实纸页效果）
' 时间：98.7.17
'
' 公共过程:
' ResponseMessage   响应消息,刷新纪录
' ShowAcntBook      显示报表
'
' 相关报表对象子过程 :
'？？？ SetGridTitle           设置标题                   /////已作废
' ？？？SetBookField       设置栏目                   /////已作废
' SetCell            设置单元数据
' SetFreeCell        设置自由单元数据'
'SetColumnInfo       设置列信息
'SetRowInfo           设置行信息
'setDataFont        设置数据区字体
'GetGridTop         获得数据区Top位置
'SetGridTop         设置数据区Top位置
'GetGridheight      获得数据区高度
'GetGridWidth       获得数据区宽度
'setMaxRow          设置最大显示行
'setMaxCol          设置最大显示列
'GetDefRowheight    获得缺省行高
'SetDefRowheight    设置缺省行高
'GetDefColWidth     获得缺省列宽
'SetDefColWidth     设置缺省列宽
'GetRowHeight       获得指定行高
'GetColumnWidth     获得指定列宽
'SetFixRow          设置标题行数
'SetTableLeftMargin 设置左边距

'''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Const lngFormWidth As Long = 8500                               '窗体最小宽度
Const lngFormHeight As Long = 5000                              '窗体最小高度

Private mintPageRows As Integer                                 '一页的最大行数
Private mlngPageWidth As Long                                   '一页的最大宽度

Private mlngPages As Integer                                    '总页数=mlngColExpands * mlngRowExpands
Private mlngColExpands As Long                                  '原始一页横向扩展出来的总页数(可能<>总列宽\mlngPageWidth+1)
Private mlngRowExpands As Long                                  '原始一页纵向扩展出来的总页数=记录数\mlngPageRows+1
Private mlngColStart() As Long                                  '每页的开始列
Private mlngColEnd() As Long                                    '每页的结束列
Private mlngRowStart() As Long                                  '每页记录的开始位置
Private mlngRowEnd() As Long                                    '每页记录的结束位置
Private mlngEndRowTop() As Long                                 '每页最后一行记录单元的顶端位置

Private mstrHF(6) As String
Private mlngCurPage As Integer                                     '当前页
Private mintCurContents As Integer  '当前目录
Private mbResizeing As Boolean      '移动标志
Private ZoomIndex As Integer
Private PaperWidth As Long
Private PaperHeight As Long
Private mblnOrient  As Boolean      '纵向打印

Private clsFset As ClsFormatset
Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private mclsFormCond As FormCond                                '列表条件对象
Private WithEvents ABook As ReportBook                          '列表报表对象
Attribute ABook.VB_VarHelpID = -1
Private mclsSalarySet As clsSalaryRptSet                        '工资报表设置类
Private mblnLoaded As Boolean

Private mstrDevelopGridSql As String    '工资发放表Sql
Private mblnMonneyItemOK As Boolean
Private mIntDepartMentLevel As Integer '按部门打印的部门级别
Private mintLabelCol As Integer        '签名列

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                             *         公共过程              *
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 响应消息,刷新纪录
Public Sub ResponseMessage()
    Dim vntMessage As Variant
    For Each vntMessage In mclsMainControl.Messages
        Select Case vntMessage
            '    单位                 部门                   科目                摘要
            Case Message.msgCustomer, Message.msgDepartment, Message.msgAccount, Message.msgRemark
                 RefreshData                                         '刷新纪录
            Case Else
        End Select
    Next
    mclsMainControl.Messages.Clear
End Sub
'显示报表
Public Sub ShowAcntBook(ByVal lngReportID As Long, ByVal ViewId As Long, ByVal lngSalaryID As Long)
    Dim blnIsOK As Boolean
    Dim frmSalaryset As New frmSalaryDevelopWizard
    Set mclsSalarySet = New clsSalaryRptSet
    If lngSalaryID = 0 Then
        blnIsOK = frmSalaryset.InitSalaryDevelopTable(mclsSalarySet, lngSalaryID)
    Else
        mclsSalarySet.SalaryDevelopName = "工资发放表"
        mclsSalarySet.SalaryDevelopSQL = mclsSalarySet.InitSalaryDevelopSql(lngSalaryID)
        mclsSalarySet.SalaryDevelopID = lngSalaryID
        mclsSalarySet.SalaryDevelopWhere = ""
        blnIsOK = True
    End If
'    blnIsOK = frmSalaryset.InitSalaryDevelopTable(mclsSalarySet, lngSalaryID)
    Set frmSalaryset = Nothing
    If blnIsOK = True Then
         Set ABook = New ReportBook
         ABook.SetWin PicPaper.hwnd
         If ABook.IsInitSuccessed = 0 Then
             Unload Me
             Unload MsgForm
             Exit Sub
         End If
         Set clsFset = New ClsFormatset
         clsFset.GetDefaultDateFromDB 1429
         GetDefaultSet clsFset
         RefreshData                                 '涮新数据
        
         Unload MsgForm
         Set mclsMainControl = gclsSys.MainControls.Add(Me) '加入主控
         Utility.LoadFormSetting Me
         'SetHelpID Me.hwnd, 70018
         Me.Show
    End If
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                          *          控件事件处理              *
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ABook_ColumnResize(col As Integer)
Dim intStart As Integer
    If col <> -1 Then
        intStart = mlngColStart(mlngCurPage - 1)
        msgAccount.ColWidth(intStart + col) = IIf(GetColumnWidth(col) > 0, GetColumnWidth(col) * Screen.TwipsPerPixelX, 0)
    End If
    DispartPage                                    '分页
    SetData                                        '填充数据
End Sub

Private Sub ABook_FCMouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        StandardReport.CallFreeCellMenu                 '装载自由单元弹出菜单资源
        PopupMenu frmMain.mnuListActivity
    End If
End Sub

Private Sub ABook_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
         CallMePopMenu   '装载窗体弹出菜单资源
         PopupMenu frmMain.mnuListReport
    End If
End Sub

Private Sub ABook_TableTopChanged(top As Integer)
    DispartPage                                                      '分页
    SetData                                                          '填充数据
End Sub

Private Sub cmdAccSet_Click()
    '调用向导
    Dim blnIsOK As Boolean
    Dim frmSalaryset As New frmSalaryDevelopWizard
    blnIsOK = frmSalaryset.InitSalaryDevelopTable(mclsSalarySet, 0)
    Set frmSalaryset = Nothing
    If blnIsOK = True Then
        RefreshData               '刷新纪录
    End If
End Sub

Private Sub CmdPrint_Click()
    Dim frm As New frmPrint
    Dim i As Long
    Dim oldPage As Long
    Dim lngStartPage, lngEndPage As Long
    
    ' #if intDepartmentLevel>0 then
    ' # 按部门编码打印分页
    '      DispartPagesByDepartment intDepartmentLevel
    ' #Else
    ' # 正常打印分页
    '
    ' # end if
    If mIntDepartMentLevel > 0 Then
        DispartPagesByDepartment mIntDepartMentLevel
    Else
        DispartPage
    End If
    If frm.ShowFrmPrint(1, CInt(mlngPages)) Then
        oldPage = mlngCurPage
        If frm.GIsPrintOnPrinter Then       '打印
            Dim x As Printer
            Dim strDevName As String
            For Each x In Printers
                If x.DeviceName = frm.GDeviceName Then
                    If mblnOrient Then
                        ABook.SelecrPrinter x.DeviceName, x.DriverName, x.Port, PaperHeight, PaperWidth, 1
                    Else
                        ABook.SelecrPrinter x.DeviceName, x.DriverName, x.Port, PaperHeight, PaperWidth, 2
                    End If
                    GoTo PrintStart
                End If
            Next
            Set frm = Nothing
            Utility.ShowMsg Me.hwnd, "未发现选定打印机(" & frm.GDeviceName & ")!", vbOKOnly + vbInformation, App.title
            Exit Sub
PrintStart:
            ABook.StartPrint "工资配款表"
            If frm.GIsColorPrint Then           '彩色打印
                ABook.Negative = 2              '将负数设为红字
            End If
            
            If frm.GPrintRange = 0 Then         '全部打印
                lngStartPage = 1
                lngEndPage = mlngPages
            Else                                '从 X 页到 Y 页
                lngStartPage = frm.GBeginPagePrint
                lngEndPage = frm.GEndPagePrint
            End If
            
            If frm.GIsPagebyPage Then         '逐份打印
                For i = 1 To frm.GCopiesPrint       '打印份数
                    If Not frm.GIsDoublePrint Then          '单面打印
                        For mlngCurPage = lngStartPage To lngEndPage
                            SetData
                            ABook.PrintDirect
                        Next mlngCurPage
                    Else                                    '双面打印
                        
'********************************     奇数页        ************************************************

                        If frm.GIsPrintByOrderOne Then          '按顺序 1 打印，起始页必须为奇数 (5,3,1)
                            For mlngCurPage = (lngEndPage \ 2) * 2 + IIf(lngEndPage Mod 2 = 0, -1, 1) To lngStartPage Step -2 '5,3,1
                            SetData
                            ABook.PrintDirect
                            Next mlngCurPage
                        Else                                    '不按顺序 1 打印，起始页必须为奇数 (1,3,5)
                            For mlngCurPage = lngStartPage + IIf(lngStartPage Mod 2 = 0, 1, 0) To lngEndPage Step 2  '1,3,5
                            'frmPrintMsg.lblCurrPage.Caption = mlngCurPage
                            SetData
                            ABook.PrintDirect
                            'Unload frmPrintMsg
                            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
                            'Load frmPrintMsg
                            'frmPrintMsg.Show
                            'frmPrintMsg.lblCurrPage.Caption = mlngCurPage
                            SetData
                            ABook.PrintDirect
                            'Unload frmPrintMsg
                            Next mlngCurPage
                        Else                                    '当前页必须为偶数 (2,4,6)
                            For mlngCurPage = lngStartPage + IIf(lngStartPage Mod 2 = 0, 0, 1) To lngEndPage Step 2 '2,4,6
'                                SetData
                            'Load frmPrintMsg
                            'frmPrintMsg.Show
                            'frmPrintMsg.lblCurrPage.Caption = mlngCurPage
                            SetData
                            ABook.PrintDirect
                            'Unload frmPrintMsg
                            Next mlngCurPage
                        End If
                        
                    End If '单面打印
                Next i '打印份数
                
            Else '逐页打印
            
                If Not frm.GIsDoublePrint Then          '单面打印
                    For mlngCurPage = lngStartPage To lngEndPage
'                        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                                    '双面打印
                    If frm.GIsPrintByOrderOne Then          '按顺序 1 打印，起始页必须为奇数 (5,3,1)
                        For mlngCurPage = lngEndPage + IIf(lngEndPage Mod 2 = 0, -1, 0) To lngStartPage Step -2  '5,3,1
'                            SetData
                            For i = 1 To frm.GCopiesPrint
                            'Load frmPrintMsg
                            'frmPrintMsg.Show
                            'frmPrintMsg.lblCurrPage.Caption = mlngCurPage
                            SetData
                            ABook.PrintDirect
                            'Unload frmPrintMsg
                            Next i