report.bas

金算盘软件代码

                    !strDateOp = rsSource!strDateOp
                    !dtmDate1 = rsSource!dtmDate1
                    !dtmDate2 = rsSource!dtmDate2
                    !strDoubleOP = rsSource!strDoubleOP
                    !dbldouble1 = rsSource!dbldouble1
                    !dbldouble2 = rsSource!dbldouble2
                    !blnismulicond = rsSource!blnismulicond
                    !blnIsMultiCol = rsSource!blnIsMultiCol
                    !blnBoolean = rsSource!blnBoolean
                    !strOthTableName = rsSource!strOthTableName
                .Update
            End With
            rsSource.MoveNext
        Next
        rsSource.Close
        rsTarget.Close
    End If
    '复制ReportMultiIDCond中的条件
    strSql = "Delete  ReportMultiIDCond Where lngReportID = " & lngTargetReportID
    gclsBase.BaseDB.Execute strSql
    strSql = "SELECT * From ReportMultiIDCond Where lngReportID = " & lngSourceReportID
    Set rsSource = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic, 4)
    If rsSource.EOF = False Then
        rsSource.MoveLast
        rsSource.MoveFirst
        Set rsTarget = gclsBase.BaseDB.OpenResultset("Select * From ReportMultiIDCond", rdOpenDynamic, 4)
        For intCount = 0 To rsSource.RowCount - 1
            With rsTarget
                .AddNew
                    !lngReportID = lngTargetReportID
                    !strPath = rsSource!strPath
                    !strCodeID = rsSource!strCodeID
                    !strKeyName = rsSource!strKeyName
                    !bLNISCODETYPE = rsSource!bLNISCODETYPE
                .Update
            End With
            rsSource.MoveNext
        Next
        rsSource.Close
        rsTarget.Close
    End If
    '复制ReportFilter中的条件
    strSql = "Delete  ReportFilter Where ReportFilter.lngReportID = " & lngTargetReportID
    gclsBase.BaseDB.Execute strSql
    strSql = "SELECT * From ReportFilter Where ReportFilter.lngReportID = " & lngSourceReportID
    Set rsSource = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rsSource.EOF = False Then
        rsSource.MoveLast
        rsSource.MoveFirst
        Set rsTarget = gclsBase.BaseDB.OpenResultset("Select * From ReportFilter", rdOpenDynamic, 4)
        For intCount = 0 To rsSource.RowCount - 1
            With rsTarget
                .AddNew
                    !lngReportID = lngTargetReportID
                    !lngViewFieldID = rsSource!lngViewFieldID
                    !strPath = rsSource!strPath
                    !blnHavefathernode = rsSource!blnHavefathernode
                    !strStringOP = rsSource!strStringOP
                    !strString1 = rsSource!strString1
                    !strString2 = rsSource!strString2
                    !strDateOp = rsSource!strDateOp
                    !dtmDate1 = rsSource!dtmDate1
                    !dtmDate2 = rsSource!dtmDate2
                    !strDoubleOP = rsSource!strDoubleOP
                    !dbldouble1 = rsSource!dbldouble1
                    !dbldouble2 = rsSource!dbldouble2
                    !blnismulicond = rsSource!blnismulicond
                    !blnIsMultiCol = rsSource!blnIsMultiCol
                    !blnBoolean = rsSource!blnBoolean
                    !strOthTableName = rsSource!strOthTableName
                .Update
            End With
            rsSource.MoveNext
        Next
        rsSource.Close
        rsTarget.Close
    End If
    CopyReportCond = True
    Exit Function
ErrHandler:
    CopyReportCond = False
End Function
'是否有打开报表权限
Public Function ReportRight(ByVal ReportID As Long, ByVal ViewId As Long, Optional ByVal blnShowMsg As Boolean = False) As Boolean
Dim strSql As String
Dim rstRight As rdoResultset
Dim intGroup As Integer
Dim lngModul As Long
     If ReportID = 0 And ViewId = 0 Then           '向导生成的报表
        ReportRight = True
        Exit Function
     End If
     '找分组号
     strSql = "SELECT bytGroup FROM Report WHERE lngReportID=" & ReportID & " And lngViewID=" & ViewId
     Set rstRight = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
     If rstRight.EOF Then
        ReportRight = False
        Set rstRight = Nothing
        If Not ReportRight Then
            ShowMsg frmMain.hwnd, "你没有查询该表的权限,拒绝访问!", vbInformation + vbOKOnly, App.title
        End If
        Exit Function
     Else
        intGroup = rstRight!bytGroup
     End If
     
     Select Case intGroup
     Case 10, 15, 16                           '我的报表:列表:快捷报表  没做控制
          ReportRight = True
          Exit Function
     End Select
     GetModulID intGroup, lngModul                '得到权限模快ID
     Set rstRight = Nothing
     If lngModul = -1 Then
          ReportRight = False
     Else
          ReportRight = UserRight.IsCanDo(lngModul, gclsBase.OperatorID)
     End If
     If Not ReportRight Then
         ShowMsg frmMain.hwnd, "你没有查询该表的权限,拒绝访问!", vbInformation + vbOKOnly, App.title
     End If
End Function
'得到权限模快ID
Private Sub GetModulID(ByVal intGroup As Integer, lngModulID As Long)
     lngModulID = -1
     Select Case intGroup
     Case 1    '查询总分类帐表
        lngModulID = 35
     Case 2    '应收款项查询
        lngModulID = 42
     Case 3    '应付款项查询
        lngModulID = 211
     Case 4    '查询现金银行帐表
        lngModulID = 49
     Case 5    '工资
        lngModulID = 118
     Case 6    '固定资产
        lngModulID = 123
     Case 7    '采购
        lngModulID = 67
     Case 8    '销售
        lngModulID = 87
     Case 9    '库存
        lngModulID = 114
     Case 11   '财务分析
        lngModulID = 216
     Case 12   '内部稽查
        lngModulID = 217
     Case 13   '领导查询
        lngModulID = 218
     Case 14   '经营分析
        lngModulID = 219
     Case 17   '委托加工
        lngModulID = 220
     Case 18   '医疗保险
        lngModulID = 320
     Case 19  '工程核算
        lngModulID = 390
     Case Else
     End Select
End Sub

Public Function CopyReportHeadTail(ByVal lngSourceReportID As Long, ByVal lngTargetReportID As Long) As Boolean
    Dim strSql As String
    Dim rsSource As rdoResultset
    Dim rsTarget As rdoResultset
    Dim intCount As Integer
    On Error GoTo ErrHandler
    '复制ReportHeadTail中的栏目
    strSql = "Delete   ReportHeadTail Where ReportHeadTail.lngReportID = " & lngTargetReportID
    gclsBase.BaseDB.Execute strSql
    strSql = "SELECT * From ReportHeadTail Where ReportHeadTail.lngReportID = " & lngSourceReportID
    Set rsSource = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rsSource.EOF = False Then
        rsSource.MoveLast
        rsSource.MoveFirst
        Set rsTarget = gclsBase.BaseDB.OpenResultset("Select * from ReportHeadTail", rdOpenDynamic, 4)
        For intCount = 0 To rsSource.RowCount - 1
            With rsTarget
                .AddNew
                    !lngReportID = lngTargetReportID
                    !strFieldDesc = rsSource!strFieldDesc
                    !bytFieldType = rsSource!bytFieldType
                    !intFieldNo = rsSource!intFieldNo
                    !intFuncIndex = rsSource!intFuncIndex
                    !lngFieldWidth = rsSource!lngFieldWidth
                    !lngFieldHeight = rsSource!lngFieldHeight
                    !lngFieldLeft = rsSource!lngFieldLeft
                    !lngFieldTop = rsSource!lngFieldTop
                    !intAlign = rsSource!intAlign
                .Update
            End With
            rsSource.MoveNext
        Next
        rsSource.Close
        rsTarget.Close
    End If
    CopyReportHeadTail = True
ErrHandler:
    CopyReportHeadTail = False
End Function


'删除表的附加信息(应先调用本方法，否则，找不到打印设置ID)
Public Function DelReportInfo(lngReportID As Long, Optional strErr As String) As Boolean
    Dim strSql As String
    Dim RsCord As rdoResultset
    Dim rs As rdoResultset
    Dim mlngFontID(4) As Long
    Dim lngPrintSetupID As Long
    On Error GoTo ErrHandle
    '删除ReportGroup表
    strSql = "DELETE ReportGroup WHERE lngReportId =" & lngReportID
    gclsBase.ExecSQL strSql
    
    '删除ReportHeadTail表
    strSql = "DELETE ReportHeadTail WHERE lngReportId =" & lngReportID
    gclsBase.ExecSQL strSql
    '删除ReportAnalysis表
    strSql = "DELETE ReportAnalysisData WHERE lngReportId =" & lngReportID
    gclsBase.ExecSQL strSql
    '删除AgePeriod表
    strSql = "DELETE AgePeriod WHERE lngReportId =" & lngReportID
    gclsBase.ExecSQL strSql
    
    '删除PrintSetup表
    strSql = "Select lngPrintSetupID From Report Where lngReportID = " & lngReportID
    Set rs = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    lngPrintSetupID = rs!lngPrintSetupID
    rs.Close
    strSql = "Select lngTitleFontID,lngTextFontID,lngPageHeaderFontID,lngTableHFooterFontID,lngColumnCaptionFontID From PrintSetup Where lngPrintSetupID = " & lngPrintSetupID
    Set rs = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With rs
        If Not .EOF Then
            mlngFontID(0) = !lngTitleFontID
            mlngFontID(1) = !lngTextFontID
            mlngFontID(2) = !lngPageHeaderFontID
            mlngFontID(3) = !lngTableHFooterFontID
            mlngFontID(4) = !lngColumnCaptionFontID
        End If
    End With
    rs.Close
    
    strSql = "SELECT count(Report.lngPrintSetupID) as PrintSetupCount FROM Report  " _
        & " WHERE  Report.lngPrintSetupID = " & lngPrintSetupID
    Set RsCord = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not RsCord.EOF Then
        RsCord.MoveFirst
        If RsCord!PrintSetupcount <= 1 Then
            strSql = "DELETE PrintSetup.* FROM PrintSetup WHERE PrintSetup.lngPrintSetupID =" & lngPrintSetupID
            gclsBase.ExecSQL strSql
        End If
    End If
    '删除字体表
    strSql = "Delete * from Font Where lngFontID= " & mlngFontID(0) & " Or lngFontID= " & mlngFontID(1) & " Or lngFontID= " & mlngFontID(2) & " Or lngFontID= " & mlngFontID(3) & " Or lngFontID= " & mlngFontID(4)
    gclsBase.ExecSQL strSql
    
    Filter.DelSelectedCond lngReportID, 2
    DelReportInfo = True
    Exit Function
ErrHandle:
    strErr = Err.Description
    DelReportInfo = False
End Function

Public Sub SetReportTlb()
   frmMain.SetEditUnEnabled
   frmMain.mnuToolRefresh.Enabled = True
   frmMain.mnuFilePrint.Enabled = True
   frmMain.mnuEditShowList.Enabled = False
   frmMain.SetToolBar
End Sub

Public Sub ReSetReportTlb()
   frmMain.mnuFilePrint.Enabled = False
   frmMain.SetToolBar
End Sub

Public Function MyReportExist(ReportID As Long, Optional strReportName As String = "") As Boolean
    Dim strSql As String
    Dim rsTemp As rdoResultset
    strSql = "select lngreportID from Report where LngReportID=" & ReportID
    Set rsTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rsTemp.RowCount > 0 Then
        MyReportExist = True
    Else
        MyReportExist = False
        If strReportName <> "" Then
            MsgBox """" & strReportName & """" & "已经被删除，不能执行该操作。", vbOKOnly + vbExclamation, App.title
        Else
            MsgBox "该报表已经被删除，不能执行该操作。", vbOKOnly + vbExclamation, App.title
        End If
    End If
    rsTemp.Close
End Function
Public Function VersionInfo() As String
    #If conBJ = 0 Then
        #If conWan = 0 Then
            If gExistIndog Then
                VersionInfo = ""
            Else
                If gclsBase.VersionType = 1 Then
                    VersionInfo = "金算盘软件教学版"
                Else
                    VersionInfo = "金算盘软件演示版"
                End If
            End If
        #Else
            If gExistIndog Then
                VersionInfo = ""
            Else
                If gclsBase.VersionType = 1 Then
                    VersionInfo = "万能软件教学版"
                Else
                    VersionInfo = "万能软件演示版"
                End If
            End If
        #End If
    #Else
        VersionInfo = "金算盘财务软件北京市卫生系统专用版"
    #End If
End Function