reportsumset.cls

金算盘软件代码

            Next
            rstDesc.Update
            .MoveNext
         Loop
     End With
     '打开表触发器
    strSql = "Alter Table ReportField Enable All Triggers"
    gclsBase.BaseDB.Execute (strSql)
'     gclsBase.BaseDB.CommitTrans
     Set rstSource = Nothing
     Set rstDesc = Nothing
'     Exit Sub
'
'ErrHandle:
'    gclsBase.BaseDB.RollBacktrans
'    Set rstSource = Nothing
'    Set rstDesc = Nothing
'    Utility.ShowMsg frmMain.hwnd, Err.Description, vbCritical + vbOKOnly, App.Title
'    mvarSaveErr = True
End Sub

'更新用户自定义标准表的修改
Private Sub EditUpdate(Optional blnEdit As Boolean = True)
  Dim strSql As String
  Dim intCount As Integer, intGroup As Integer, intX As Integer
  
'  On Error GoTo ErrHandle
'  If mvarSaveErr Then Exit Sub
'  gclsBase.BaseDB.BeginTrans
  
  '更新报表
  If blnEdit Then
    If mvarSalaryID = "" Then mvarSalaryID = " "
    If mvarSalFieldID = "" Then mvarSalFieldID = " "
    strSql = "UPDATE Report Set " _
            & "intTitleWidth=" & mvarTitleWidth & ",intTitleHeight=" & mvarTitleHeight & ",intTitleTop=" & mvarTitleTop & ",intTitleLeft=" & mvarTitleLeft & ",intTitleAlign=" & mvarTitleAlign _
            & ",intCondWidth=" & mvarCondWidth & ",intCondHeight=" & mvarCondHeight & ",intCondTop=" & mvarCondTop & ",intCondLeft=" & mvarCondLeft & ",intCondAlign=" & mvarCondAlign & ",bytCondShow=" & mvarCondShow _
            & ",strReportName='" & mvarReportName & "',bytVersion=" & mvarVersion _
            & ",intGridTop=" & mvarGridTop & ",strSalaryID='" & mvarSalaryID & "',strSalaryFieldID='" & mvarSalFieldID _
            & "',blnIsIncludeTotal=1,intFixedCol=" & mvarFixedCol _
            & " WHERE lngReportID =" & mvarReportID
  Else
    strSql = "UPDATE Report Set strReportName='" & mvarReportName & "',bytVersion=" & mvarVersion _
            & ",intCondWidth=" & mvarCondWidth & ",intCondHeight=" & mvarCondHeight & ",intCondTop=" & mvarCondTop & ",intCondLeft=" & mvarCondLeft & ",intCondAlign=" & mvarCondAlign & ",bytCondShow=" & mvarCondShow _
            & ",intGridTop=" & mvarGridTop & ",blnIsIncludeTotal=1,intFixedCol=" & mvarFixedCol _
            & " WHERE lngReportID =" & mvarReportID
  End If
  gclsBase.ExecSQL strSql
    
  '初始化报表字段
  strSql = "UPDATE ReportField Set blnIsChoosed=0 ,blnTableSum=0,bytReportFieldType=0 ,bytSort=0,intSortNO=0," & _
            "bytCodeShow=2,dblDistance=0 ,lngReportFieldNO=0  WHERE lngReportID =" & mvarReportID
    
  gclsBase.ExecSQL strSql
  
  '更新报表已选字段
'  Select Case mvarViewID
'  Case 595
'    For intX = 0 To mvarChoosedColumns - 1
'        intCount = mvarChoosedLoc(intX)
'        strSql = "UPDATE ReportField Set strReportFieldDesc='" & mvarColumnDesc(intCount) _
'              & "',lngReportFieldNO=" & intX + 1 & ",lngDisplayWidth=" & mvarColumnWidth(intCount) _
'              & ",blnIsChoosed=1,blnTableSum=" & mvarColumnSumed(intCount) _
'              & " Where lngReportId= " & mvarReportID & " And lngViewFieldId=" & mvarColumnID(intCount)
'        gclsBase.ExecSQL strSql
'    Next intX
'  Case Else
    For intX = 0 To mvarChoosedColumns - 1
        intCount = mvarChoosedLoc(intX)
        If mvarCustomFormula(intCount) = "" Then mvarCustomFormula(intCount) = " "
        strSql = "UPDATE ReportField Set strReportFieldDesc='" & mvarColumnDesc(intCount) _
              & "',bytReportFieldType=" & mvarColumnStyle(intCount) & ",strFomular='" & mvarCustomFormula(intCount) _
              & "',lngReportFieldNO=" & intX + 1 & ",lngDisplayWidth=" & mvarColumnWidth(intCount) _
              & ",bytSort=" & mvarColumnSort(intCount) & ",intSortNO=" & mvarColumnSortNO(intCount) _
              & ",blnIsChoosed=1 ,blnTableSum=" & mvarColumnSumed(intCount) _
              & " Where lngReportFieldId=" & mvarReportFieldID(intCount)
        gclsBase.ExecSQL strSql
    Next intX
'  End Select
  '更新报表列表框字段
  For intX = 0 To mvarListColumns - 1
      intCount = mvarColumnListLoc(intX)
      strSql = "UPDATE ReportField Set strReportFieldDesc='" & mvarColumnDesc(intCount) _
            & "',bytReportFieldType=" & mvarColumnStyle(intCount) & ",bytCodeShow=" & mvarCodeName(intCount) _
            & ",lngReportFieldNO=" & intX + mvarChoosedColumns + 1 & ",lngDisplayWidth=" & mvarColumnWidth(intCount) _
            & ",lngDisplayHeight=" & mvarColumnHeight(intCount) & ",lngDisplayTop=" & mvarColumnTop(intCount) _
            & ",lngDisplayLeft=" & mvarColumnLeft(intCount) & ",intAlign=" & mvarColumnAlign(intCount) _
            & " Where lngReportId= " & mvarReportID & " And lngViewFieldId=" & mvarColumnID(intCount)
      gclsBase.ExecSQL strSql
  Next intX
'  gclsBase.BaseDB.CommitTrans
'  Exit Sub
'
'ErrHandle:
'    gclsBase.BaseDB.RollBacktrans
'    Utility.ShowMsg frmMain.hwnd, Err.Description, vbCritical + vbOKOnly, App.title
'    mvarSaveErr = True
End Sub
'显示向导窗口
Public Function ShowWizard(Optional ByVal lngReportID As Long, Optional lngParentId As Long, _
       Optional intParentLevel As Integer, Optional clsWizardFormCond As FormCond, Optional clsWizardFilt As clsFilter, Optional blnIsNew As Boolean = True) As Boolean
   Dim clsFormCond  As FormCond
   Dim clsFormFilt As clsFilter
    If mvarReportID = 0 Then
        GetReportSet lngReportID
    End If
    If mvarParentID = 0 Then
        mvarParentID = lngParentId
        mvarLevel = intParentLevel
    End If
    If clsWizardFormCond Is Nothing Then
        Set clsFormCond = New FormCond
    Else
        Set clsFormCond = clsWizardFormCond
    End If
    If clsWizardFilt Is Nothing Then
        Set clsFormFilt = New clsFilter
    Else
        Set clsFormFilt = clsWizardFilt
    End If
    ShowWizard = frmReportSum.SetReportSum(Me, clsFormCond, clsFormFilt)
    
    If ShowWizard And blnIsNew Then
       '由向导新生成了一张帐表(还未存到数据库)
        Report.ShowSumReport 0, 0, Me, clsFormCond
    End If
End Function
'分析公式:根据公式得到Sql
Public Sub FormulaToSql(ByVal strFormula As String, strSql As String)
Dim i As Integer, intField As Integer, intLoc As Integer
Dim intStart As Integer, intEnd As Integer
Dim strTemp As String, strReturn As String, strFieldID As String
    On Error Resume Next
    
    i = 1
    strReturn = StandardReport.DivideAnalyse(strFormula)
    intStart = 0
    intLoc = -1
    Do Until intLoc = 0
        intLoc = InStr(i, strFormula, "$")
        If intLoc = 0 Then
            
        ElseIf intStart = 0 Then
            intStart = intLoc
        Else
            strFieldID = Mid(strFormula, intStart + 1, intLoc - intStart - 1)
            intField = -1
            intField = mcolFieldID(strFieldID)
            If intField >= 0 Then
                strTemp = Mid(strFormula, intStart, intLoc - intStart + 1)
                strReturn = strReplace(strReturn, strTemp, "(" & mvarColumnFieldName(intField) & ")")
            End If
            intStart = 0
        End If
        i = intLoc + 1
    Loop
    strSql = strReturn
End Sub

'处理工资报表字段
Private Sub DealSalaryField()
Dim strSql As String, strCond As String
Dim strViewFieldID As String, strReportFieldID As String, strFieldDesc As String, strDecimal As String
Dim lngViewField As Long, lngReportField As Long
Dim lngMaxNo As Long
Dim rstField As rdoResultset, rstAdd As rdoResultset, rstReport As rdoResultset
    
        '删除多余字段
        strCond = "ViewList.lngViewID Is Null And Substr(ViewField.strFieldName,5,Length(ViewField.strFieldName)-5)=ViewList.strFieldName(+) And Upper(ViewField.strFieldName) Like 'SUM(SALARY.SA%' And Upper(ViewField.strFieldType)='DOUBLE'  And ViewField.lngViewID=" & mvarViewID
        strSql = "SELECT ViewField.lngViewFieldID FROM ViewField,(Select * From ViewField Where ViewField .lngViewID=63 ) ViewList Where " & strCond
        Set rstField = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        strViewFieldID = ""
        Do Until rstField.EOF
            If strViewFieldID = "" Then
                strViewFieldID = rstField!lngViewFieldID
            Else
                strViewFieldID = strViewFieldID & "," & rstField!lngViewFieldID
            End If
            rstField.MoveNext
        Loop
        If strViewFieldID <> "" Then
            strSql = "SELECT ReportField.lngReportFieldID From ReportField Where  ReportField.lngViewFieldID In (" & strViewFieldID & ") And lngReportID=" & mvarReportID
            Set rstField = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            strReportFieldID = ""
            Do Until rstField.EOF
                If strReportFieldID = "" Then
                    strReportFieldID = rstField!lngReportFieldID
                Else
                    strReportFieldID = strReportFieldID & "," & rstField!lngReportFieldID
                End If
                rstField.MoveNext
            Loop
            '删除ReportField字段
            If strReportFieldID <> "" Then
'                strSql = "Delete From ReportGroup Where (lngReportGroupFieldID In (" & strReportFieldID & ") Or lngReportSumFieldID In (" & strReportFieldID & ") ) And lngReportId=" & mvarReportID
'                gclsBase.ExecSQL strSql
                strSql = "Delete From ReportField Where lngReportFieldID In (" & strReportFieldID & ") And lngReportId=" & mvarReportID
                gclsBase.ExecSQL strSql
            End If
            '删除ViewField字段
            strSql = "Delete From ViewField Where lngViewFieldID In (" & strViewFieldID & ") And lngViewId=" & mvarViewID
            gclsBase.ExecSQL strSql
        End If
        
        '修改字段
        '得到ReportField表工资字段最大显示序号
        strSql = "SELECT Max(intShowNO) As MaxNo From ReportField Where lngReportID =" & mvarReportID
        Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not rstReport.EOF Then
            lngMaxNo = rstReport!maxno + 1
        Else
            lngMaxNo = 211
        End If
        '关闭触发器
        strSql = "Alter Table ViewField Disable All Triggers "
        gclsBase.BaseDB.Execute (strSql)
        strSql = "Alter Table ReportField Disable All Triggers "
        gclsBase.BaseDB.Execute (strSql)
        '可能出现ViewField表有记录ReportField无相关记录的情况___增加ReportField字段
        strCond = "Upper(ViewField.strFieldType)='DOUBLE' And ViewField.strFieldName Like 'Sum(SALARY.SA%' And ViewField.lngViewFieldID Not In (SELECT lngViewFieldID From ReportField Where lngReportID=" & mvarReportID & ") And lngViewID=" & mvarViewID
        strSql = "SELECT ViewField.lngViewFieldID,ViewField.strViewFieldDesc From ViewField Where " & strCond
        Set rstField = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        strSql = "SELECT * From ReportField  Where lngreportId=" & mvarReportID
        Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
        Do Until rstField.EOF
            With rstReport
                .AddNew
                lngReportField = BillPublic.GetNewID("ReportField")
                !lngReportID = mvarReportID
                !lngReportFieldID = lngReportField
                !lngViewFieldID = rstField!lngViewFieldID
                !strReportFieldDesc = rstField!strViewFieldDesc
                If mvarReportPrep = 1 Then
                    !blnIsChoosed = 1
                Else
                    !blnIsChoosed = 0
                End If
                !lngReportFieldNO = lngMaxNo
                !intShowNO = lngMaxNo
                .Update
                lngMaxNo = lngMaxNo + 1
            End With
            rstField.MoveNext
        Loop
        
        '修改内容
        strCond = "ViewField.strFieldName= 'Sum(' || ViewList.strFieldName || ')' And ViewList.strFieldName Like 'SALARY.SA%' And Upper(ViewField.strFieldType)='DOUBLE'  And ViewField.lngViewID=" & mvarViewID
        strSql = "SELECT ViewField.lngViewFieldID,ViewList.strViewFieldDesc,ViewField.strFieldName,ViewList.bytFieldDec FROM ViewField,(Select * From ViewField Where ViewField .lngViewID=63 ) ViewList Where " & strCond
        Set rstField = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        strViewFieldID = ""
        Do Until rstField.EOF
            If strViewFieldID = "" Then
                strViewFieldID = rstField!lngViewFieldID
                strFieldDesc = rstField!lngViewFieldID & ",'" & rstField!strViewFieldDesc & "'"
                strDecimal = rstField!lngViewFieldID & "," & rstField!bytFieldDec
            Else
                strViewFieldID = strViewFieldID & "," & rstField!lngViewFieldID
                strFieldDesc = strFieldDesc & "," & rstField!lngViewFieldID & ",'" & rstField!strViewFieldDesc & "'"
                strDecimal = strDecimal & "," & rstField!lngViewFieldID & "," & rstField!bytFieldDec
            End If
            rstField.MoveNext
        Loop
        If strViewFieldID <> "" Then
            strFieldDesc = "Decode(lngViewFieldID," & strFieldDesc & ")"
            strDecimal = "Decode(lngViewFieldID," & strDecimal & ")"
            strSql = "Update ViewField Set ViewField.strViewFieldDesc=" & strFieldDesc & ",ViewField.bytFieldDec=" & strDecimal & " Where ViewField.lngViewFieldId In (" & strViewFieldID & ") And lngViewID=" & mvarViewID
            gclsBase.ExecSQL strSql
            strSql = "Update ReportField Set ReportField.strReportFieldDesc=" & strFieldDesc & " Where ReportField.lngViewFieldId In (" & strViewFieldID & ") And lngReportID=" & mvarReportID
            gclsBase.ExecSQL strSql
        End If
        
        '新增字段
        strCond = "ViewList.lngViewID Is Null And 'Sum(' || ViewField.strFieldName || ')'=  ViewList.strFieldName(+) And ViewField.strFieldName Like 'SALARY.SA%' And Upper(ViewField.strFieldType)='DOUBLE'  And ViewField.lngViewID=63"
        strSql = "SELECT ViewField.lngViewFieldID,ViewField.strViewFieldDesc,ViewField.strFieldName,ViewField.bytFieldDec FROM (Select * From ViewField Where ViewField .lngViewID=" & mvarViewID & ") ViewList,ViewField Where " & strCond
        Set rstField = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        strSql = "SELECT * From ViewField  Where lngViewId=" & mvarViewID
        Set rstAdd = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
        strSql = "SELECT * From ReportField  Where lngreportId=" & mvarReportID
        Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
        strViewFieldID = ""
        Do Until rstField.EOF
            '加ViewField表
            With rstAdd
                .AddNew
                lngViewField = BillPublic.GetNewID("ViewField")
                !lngViewFieldID = lngViewField
                !lngViewId = mvarViewID
                !strViewFieldDesc = rstField!strViewFieldDesc
                !strFieldName = "Sum(" & rstField!strFieldName & ")"
                !strTableName = "Salary"
                !strFieldType = "Double"
                !bytFieldDec = rstField!bytFieldDec
                !bytVersion = 21
                !bytFieldSize = 8
                .Update
            End With
            '加ReportField表
            With rstReport
                .AddNew
                lngReportField = BillPublic.GetNewID("ReportField")
                !lngReportID = mvarReportID
                !lngReportFieldID = lngReportField
                !lngViewFieldID = lngViewField
                !strReportFieldDesc = rstField!strViewFieldDesc
                If mvarReportPrep = 1 Then
                    !blnIsChoosed = 1
                Else
                    !blnIsChoosed = 0
                End If
                !lngReportFieldNO = lngMaxNo
                !intShowNO = lngMaxNo
                .Update
                lngMaxNo = lngMaxNo + 1
            End With
            rstField.MoveNext
        Loop
        Set rstField = Nothing
        Set rstAdd = Nothing
        '打开触发器
        strSql = "Alter Table ViewField Enable All Triggers"
        gclsBase.BaseDB.Execute (strSql)