frmcrossbook.frm

金算盘软件代码

                            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
                        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
'            Me.Show
        Else                '输出到文件
            Dim clsFileSever As New FileSeverClass
            Dim intCount As Integer, intCol As Integer, intRow As Integer
            '设置打印GRID
            With msgPrint
                .Rows = msgTitle.FixedRows + msgAccount.Rows - 1
                .Cols = msgTitle.Cols
                .FixedRows = msgTitle.FixedRows
                .FixedCols = msgTitle.FixedCols
                intRow = 0
                For intCount = 0 To msgTitle.FixedRows - 1
                    For intCol = 0 To msgTitle.Cols - 1
                        .TextMatrix(intRow, intCol) = msgTitle.TextMatrix(intCount, intCol)
                    Next intCol
                    intRow = intRow + 1
                Next intCount
                For intCount = 1 To msgAccount.Rows - 1
                    For intCol = 0 To msgTitle.Cols - 1
                        .TextMatrix(intRow, intCol) = msgTitle.TextMatrix(intCount, intCol)
                    Next intCol
                    intRow = intRow + 1
                Next intCount
            End With
            If frm.GintFileType = 4 Then
                If Not clsFileSever.Saveas(frm.GStrFileName, 4, , , msgPrint, , mclsCross.ReportName, frm.GintFileIndex) Then
                    Utility.ShowMsg Me.hwnd, "文件保存不成功!", vbOKOnly, App.title
                End If
            Else
                If Not clsFileSever.Saveas(frm.GStrFileName, frm.GintFileType, , , msgPrint, , mclsCross.ReportName) Then
                    Utility.ShowMsg Me.hwnd, "文件保存不成功!", vbOKOnly, App.title
                End If
            End If
            Set clsFileSever = Nothing
            msgPrint.Clear
        End If
    End If
    Set frm = Nothing
End Sub

Private Sub cmdSave_Click()
Dim frm As New frmReportSameName
Dim blnIsSameName As Boolean, blnIsOK As Boolean, blnErr As Boolean
Dim strName As String, strErr As String
    
    '是否有同名报表
    strName = mclsCross.ReportName
    blnErr = Report.NameIsErr(strName, strErr)
    If blnErr Then
        blnIsOK = frm.ShowInputBox("报表不能有非法字符:'" & strErr & "',请输入新的报表名!", strName, , True)
        If Not blnIsOK Then Exit Sub
    End If
    blnIsSameName = Report.ReportExist(strName, mclsCross.ParentId, mclsCross.ReportID)
    Do While blnIsSameName
       blnIsOK = frm.ShowInputBox("已有同名报表'" & strName & "'了,请输入新的报表名!", strName, , True)
       If blnIsOK Then
            blnIsSameName = Report.ReportExist(strName, mclsCross.ParentId, mclsCross.ReportID)
       Else
            Exit Sub
       End If
    Loop
    '保存
    mclsCross.ReportName = strName
    gclsBase.BaseDB.BeginTrans
    blnIsOK = mclsCross.SaveCross                                    '保存报表属性
    If blnIsOK Then
        mclsFormCond.KeyID = mclsCross.ReportID
        mclsFormCond.UpdateCond                                      '保存报表条件
        gclsBase.BaseDB.CommitTrans
        Caption = mclsCross.ReportName                               '窗体标题
        SetGridTitle mclsCross.ReportName                            '报表标题
        ABook.Refresh
        gclsSys.SendMessage Me.hwnd, msgReport
        mblnChanged = False
    Else
        gclsBase.BaseDB.RollbackTrans
        Utility.ShowMsg Me.hwnd, "数据库冲突,请重新保存报表", vbOKOnly + vbInformation, App.title
    End If
    Set frm = Nothing
End Sub

Private Sub cmdSaveAs_Click()
Dim frm As New frmReportSameName
Dim blnIsSameName As Boolean, blnIsOK As Boolean
Dim strName As String
    
    strName = mclsCross.ReportName
    blnIsOK = frm.ShowInputBox("请输入新报表名!", strName, , True)
    If Not blnIsOK Then Exit Sub
    '是否有同名报表
    blnIsSameName = Report.ReportExist(strName, mclsCross.ParentId, mclsCross.ReportID, False)
    Do While blnIsSameName
       blnIsOK = frm.ShowInputBox("已有同名报表'" & strName & "'了,请输入新的报表名!", strName, , True)
       If blnIsOK Then
            blnIsSameName = Report.ReportExist(strName, mclsCross.ParentId, mclsCross.ReportID, False)
       Else
            Exit Sub
       End If
    Loop
    '保存
    mclsCross.ReportName = strName
    gclsBase.BaseDB.BeginTrans
    blnIsOK = mclsCross.SaveCross(True)                              '保存报表属性
    If blnIsOK Then
        mclsFormCond.KeyID = mclsCross.ReportID
        mclsFormCond.UpdateCond                                      '保存报表条件
        '设置报表打印ID
        clsFset.UpdatePrintSetupID mclsCross.ReportID, clsFset.GetPrintSetupID(8)
        gclsBase.BaseDB.CommitTrans
        Caption = mclsCross.ReportName         '窗体标题
        mclsCross.TitleWidth = 0
        SetGridTitle mclsCross.ReportName                            '报表标题
        ABook.Refresh
        gclsSys.SendMessage Me.hwnd, msgReport
        mblnChanged = False
    Else
        gclsBase.BaseDB.RollbackTrans
        Utility.ShowMsg Me.hwnd, "数据库冲突,请重新保存报表", vbOKOnly + vbInformation, App.title
    End If
    Set frm = Nothing
End Sub

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

Private Sub mclsMainControl_ListActivityMenu(ByVal intIndex As Integer)
    Select Case intIndex
        Case 0, 1, 2
            ABook.FCAlignment(mintFCIndex) = intIndex
        Case 4, 5, 6
            ABook.FCAlignment(mintFCIndex) = intIndex - 1
        Case 8, 9, 10
            ABook.FCAlignment(mintFCIndex) = intIndex - 2
    End Select
       '返回给类
    With mclsCross
        If mintFCIndex = 0 Then
        '处理报表标题
            .TitleAlign = ABook.FCAlignment(mintFCIndex)
        ElseIf mintFCIndex < .HeadColumns + 1 Then
        '表头栏目
            .HeadAlign(mintFCIndex - 1) = ABook.FCAlignment(mintFCIndex)
        Else
        '表尾栏目
            .TailAlign(mintFCIndex - 1 - .HeadColumns) = ABook.FCAlignment(mintFCIndex)
        End If
    End With
    mblnChanged = True
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
        cmdSave_Click
    Case 4
        cmdSaveAs_Click
    Case 5
    Case 6
        CmdPrint_Click
    End Select
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'                      *             辅助支持                  *
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'刷新纪录
Private Sub RefreshData()
Dim blnPage As Boolean
    SetRecBook                                     '得到记录集
    If mblnIsHaveData Then
        blnPage = DispartPage                      '分页
        If blnPage Then SetData                    '填充数据
    End If
End Sub
'生成新记录集
Private Sub SetRecBook()
  Dim strSql As String, strWhere As String
  Dim rstBook As rdoResultset
    '生成SQL子句
    strSql = mclsCross.GetSQLPre
    strWhere = mclsFormCond.GetCond(mstrDateCond, "日期")
    GetDateStr
    If strWhere <> "" Then
        If mstrDateWhere <> "" Then strWhere = strWhere & " And " & mstrDateWhere
    Else
        If mstrDateWhere <> "" Then strWhere = mstrDateWhere
    End If
    '报表条件
    If mclsCross.ReportCond <> "" Then
        If strWhere = "" Then
            strWhere = mclsCross.ReportCond
        Else
            strWhere = strWhere & " And " & mclsCross.ReportCond
        End If
    End If
    If strWhere <> "" Then
       strSql = mclsCross.GetSQLPre & " WHERE " & strWhere & Space(1) & mclsCross.GetSQLLast
    Else
       strSql = mclsCross.GetSQLPre & Space(1) & mclsCross.GetSQLLast
    End If
    '得到记录集
    Set rstBook = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rstBook.EOF Then
      Me.Hide
      Utility.ShowMsg Me.hwnd, "报表无数据,不能打开窗体!", vbInformation + vbOKOnly, App.title
'      cmdAccSet_Click
'        If blnIsOk Then
'           Me.Show
'        Else
'           frmResManage.CallPopMenu               '调用菜单
'           mblnIsHaveData = False
'           Unload Me
'        End If
      mblnIsHaveData = False
      Exit Sub
    End If
    msgAccount.FixedCols = 0
    Set Data1.Resultset = rstBook
    InitTitle                                    '初始化表头
    DealRowColTotal                              '处理行列合计
    rstBook.Close
    mblnIsHaveData = True
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