frmtablebook.frm

金算盘软件代码

'
' 公共过程:
' 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 mblnHaveHead As Boolean                                 '是否需要标题
Private mclsTable As TableSet                                   '列表设置对象
Private mclsFormCond As FormCond                                '列表条件对象
Private WithEvents ABook As ReportBook                          '列表报表对象
Attribute ABook.VB_VarHelpID = -1
Private mblnIsHaveData As Boolean                               '是否已有记录数据
Private mstrDateWhere As String                                 '日期WHERE部分
Private mstrDateData As String                                  '日期数据
Private mstrDateCond As String                                  '日期条件
Private mblnLoaded As Boolean                                   '是否是装载窗体
Private mintFCIndex As Integer                                  '自由单元索引(右键响应)
Private mblnChanged As Boolean                                  '是否改变报表设置
Private mblnFatalErr 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, Optional clsReportSet As TableSet = Nothing, _
        Optional clsFormCond As FormCond)
        
    Set ABook = New ReportBook
    ABook.SetWin PicPaper.hwnd
    If ABook.IsInitSuccessed = 0 Then
        Unload Me
        Unload MsgForm
        Exit Sub
    End If
    
    mblnLoaded = False
    mblnChanged = False
    If clsReportSet Is Nothing Then
        Set mclsTable = New TableSet
        Set mclsFormCond = New FormCond
        mclsFormCond.InitCondArr lngReportID, ViewId, 2, 64, "日期"
        mclsTable.GetReportSet lngReportID
    '显示才由向导生成的帐表
    Else
        Set mclsTable = clsReportSet
        Set mclsFormCond = clsFormCond
    End If
    
    '设置类时读数据库发生错误，提示用户稍后重新打开
    If mclsTable.Busy Then
        Unload MsgForm
        Utility.ShowMsg Me.hwnd, "数据库忙，请稍后重新打开!", vbOKOnly + vbInformation, App.title
        Unload Me
        Exit Sub
    End If
    Set clsFset = New ClsFormatset
    clsFset.GetDefaultDateFromDB mclsTable.ReportID
    GetDefaultSet clsFset
    RefreshData                                                      '涮新数据

    Unload MsgForm
    Set mclsMainControl = gclsSys.MainControls.Add(Me)               '加入主控
    Utility.LoadFormSetting Me
    mblnLoaded = True
    StandardReport.AddHelpID Me.hwnd, mclsTable.GroupNo
'    SetHelpID Me.hwnd, 70018
    Set clsReportSet = Nothing
    Set clsFormCond = Nothing
    Me.Show
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                          *          控件事件处理              *
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ABook_ColumnResize(col As Integer)
Dim intStart As Integer
    If col <> -1 Then
        intStart = mlngColStart(mlngCurPage - 1)
        mclsTable.ColumnWidth(intStart + col) = IIf(GetColumnWidth(col) > 0, GetColumnWidth(col) * Screen.TwipsPerPixelX, 0)
        msgAccount.ColWidth(intStart + col) = mclsTable.ColumnWidth(intStart + col)
    End If
    DispartPage                                    '分页
    SetData                                        '填充数据
    mblnChanged = True
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
        mintFCIndex = Index
        StandardReport.CallFreeCellMenu                 '装载自由单元弹出菜单资源
        
        PopupMenu frmMain.mnuListActivity
    End If
End Sub

Private Sub ABook_FreeCellChanged(Index As Integer)
    With mclsTable
        If Index = 0 Then
        '处理报表标题
            .TitleHeight = ABook.FCHeight(Index) * Screen.TwipsPerPixelX
            .TitleWidth = ABook.FCWidth(Index) * Screen.TwipsPerPixelX
            .TitleLeft = ABook.FCLeft(Index) * Screen.TwipsPerPixelX
            .TitleTop = ABook.FCTop(Index) * Screen.TwipsPerPixelX
            .TitleAlign = 9
        ElseIf Index < .HeadColumns + 1 Then
        '表头栏目
            .HeadHeight(Index - 1) = ABook.FCHeight(Index) * Screen.TwipsPerPixelX
            .HeadWidth(Index - 1) = ABook.FCWidth(Index) * Screen.TwipsPerPixelX
            .HeadLeft(Index - 1) = ABook.FCLeft(Index) * Screen.TwipsPerPixelX
            .HeadTop(Index - 1) = ABook.FCTop(Index) * Screen.TwipsPerPixelX
            .HeadAlign(Index - 1) = 9
        Else
        '表尾栏目
            .TailHeight(Index - 1 - .HeadColumns) = ABook.FCHeight(Index) * Screen.TwipsPerPixelX
            .TailWidth(Index - 1 - .HeadColumns) = ABook.FCWidth(Index) * Screen.TwipsPerPixelX
            .TailLeft(Index - 1 - .HeadColumns) = ABook.FCLeft(Index) * Screen.TwipsPerPixelX
            .TailTop(Index - 1 - .HeadColumns) = ABook.FCTop(Index) * Screen.TwipsPerPixelX
            .TailAlign(Index - 1 - .HeadColumns) = 9
        End If
    End With
    mblnChanged = True
End Sub


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

Private Sub ABook_TableTopChanged(top As Integer)
    mclsTable.GridTop = top * Screen.TwipsPerPixelY
    DispartPage                                                      '分页
    SetData                                                          '填充数据
    mblnChanged = True
End Sub

Private Sub cmdAccSet_Click()
Dim blnIsOK As Boolean
    '调用向导
    blnIsOK = mclsTable.ShowWizard(, mclsTable.ParentId, mclsTable.Level, mclsFormCond, False)
    If blnIsOK Then
        MsgForm.PleaseWait
        RefreshData                                      '刷新纪录
        mblnChanged = True
        Unload MsgForm
    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 frm.ShowFrmPrint(1, CInt(mlngPages)) Then
'        frm.Hide
        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 mclsTable.ReportName
'            Me.Hide
            
            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
                            'Load frmPrintMsg
                            'frmPrintMsg.Show
                            'frmPrintMsg.lblCurrPage.Caption = mlngCurPage
                            SetData
                            ABook.PrintDirect
                            'Unload frmPrintMsg
                        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
                            'Load frmPrintMsg
                            'frmPrintMsg.Show
                            'frmPrintMsg.lblCurrPage.Caption = mlngCurPage
                            SetData
                            ABook.PrintDirect
                            'Unload frmPrintMsg
                            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
                            'Load frmPrintMsg
                            'frmPrintMsg.Show
                            '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