frmsalarymonney.frm

金算盘软件代码

      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   5715
      Left            =   1110
      MousePointer    =   9  'Size W E
      ScaleHeight     =   5715
      ScaleWidth      =   75
      TabIndex        =   4
      Top             =   450
      Width           =   75
   End
   Begin MSForms.CommandButton CmdPaper 
      Height          =   345
      Left            =   3930
      TabIndex        =   21
      Top             =   5880
      Width           =   1215
      Caption         =   "纸张"
      PicturePosition =   196613
      Size            =   "2143;609"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin MSForms.CommandButton CmdZoom 
      Height          =   345
      Left            =   2700
      TabIndex        =   20
      Top             =   5880
      Width           =   1215
      Caption         =   "缩放"
      PicturePosition =   196613
      Size            =   "2143;609"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
End
Attribute VB_Name = "frmSalaryMonney"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'工资分钱清单
'作者：唐吉禹
'1998-7-16

'列表查询(真实报表：综合)
' 作者：邓强
' 功能：根据用户选择列表项目组织数据显示（真实纸页效果）
' 时间：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 mblnLoaded As Boolean

Private mstrMonneyGridSql As String    '配款Sql
Private mblnMonneyItemOK As Boolean

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                             *         公共过程              *
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 响应消息,刷新纪录
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)
    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 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 frmSalaryset As New frmSalaryMonneySet
    frmSalaryset.Show vbModal
    RefreshData                                      '刷新纪录
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 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
                        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