standardreportset.cls

金算盘软件代码

      intGroup = mvarSortLoc(intCount)
      If mvarColumnStyle(intGroup) = 2 And mvarSortMethod(intCount) > 0 Then
        If mvarSortMethod(intCount) = 1 Then
         strSort = "ASC"
        Else
         strSort = "DESC"
        End If
         If mstrOrder = "" Then
         mstrOrder = mvarColumnFieldName(intGroup) & Space(1) & strSort
         Else
         mstrOrder = mstrOrder & ", " & mvarColumnFieldName(intGroup) & Space(1) & strSort
         End If
      End If
    Next intCount
    End If
    If mstrOrder <> "" Then mstrOrder = "ORDER BY " & mstrOrder
End Sub

'保存类到数据库
'保存标准表修改结果
Public Function SaveStandard(Optional blnSaveAs As Boolean = False) As Boolean
    On Error GoTo clsErrHandle
    gclsBase.BaseWorkSpace.BeginTrans
    
    If blnSaveAs Then
        AddReport
        mvarReportPrep = 2
    Else
        EditUpdate False
    End If
    gclsBase.BaseWorkSpace.CommitTrans
    SaveStandard = True
    Exit Function
clsErrHandle:
    gclsBase.BaseWorkSpace.RollBacktrans
    SaveStandard = False
End Function
'按用户ID重新保存一份标准表
Private Sub AddReport()
  Dim rstReport As rdoResultset
  Dim strSql As String
  Dim lngReportID As Long
       
    '关闭表触发器
    strSql = "Alter Table Report Disable All Triggers"
    gclsBase.BaseDB.Execute (strSql)
    
    mvarPrintSetID = StandardReport.GetPrintSetupID(3, mvarReportID)
    strSql = "Select * from Report"
    Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    With rstReport
       .AddNew
          lngReportID = BillPublic.GetNewID("Report")
          !lngViewId = mvarViewID
          !bytGroup = mvarGroupNo
          !strReportName = mvarReportName
          !lngOperatorID = gclsBase.OperatorID
          !bytPrep = 2
          !bytWizard = 3
          !lngParentId = mvarParentID
          !strExtraCond = IIf(mvarReportCond = "", " ", mvarReportCond)
          !lngPrintSetupID = mvarPrintSetID
          !intLevel = mvarLevel + 1
          !blnIsDetail = 1
          !strDate = Format(gclsBase.BaseDate, "YYYY-MM-DD")
          !lngReportID = lngReportID
       .Update
    End With
    
    '打开表触发器
    strSql = "Alter Table Report Enable All Triggers"
    gclsBase.BaseDB.Execute (strSql)
'    gclsBase.BaseDB.CommitTrans
    
    Set rstReport = Nothing
    CopyReportField lngReportID
    mvarReportID = lngReportID
    EditUpdate
'    Exit Sub
'
'ErrHandle:
'    gclsBase.BaseDB.RollBacktrans
'    Set rstReport = Nothing
'    Utility.ShowMsg frmMain.hwnd, Err.Description, vbCritical + vbOKOnly, App.title
'    mvarSaveErr = True
End Sub

'复制所有报表字段
Private Sub CopyReportField(ByVal lngReportID As Long)
  Dim strSql As String
  Dim intCount As Integer, intLoc As Integer, intGroup As Integer
  Dim rstSource As rdoResultset, rstDesc As rdoResultset
  Dim lngFieldID As Long
  Dim fldReportField As rdoColumn
  Dim colFieldID As Collection
     
'     On Error GoTo ErrHandle
'     If mvarSaveErr Then Exit Sub
'     gclsBase.BaseDB.BeginTrans
     
     Set colFieldID = New Collection
     For intCount = 0 To UBound(mvarReportFieldID)
        If mvarReportFieldID(intCount) > 0 Then
            colFieldID.Add intCount + 1, CStr(mvarReportFieldID(intCount))
        End If
     Next intCount
     
     strSql = "Select * from ReportField Where lngReportId=" & mvarReportID
     Set rstSource = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
     
     strSql = "Select * from ReportField Where lngReportId=" & lngReportID
     Set rstDesc = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
     
     '关闭表触发器
    strSql = "Alter Table ReportField Disable All Triggers"
    gclsBase.BaseDB.Execute (strSql)
    
     With rstSource
         Do While Not .EOF
            rstDesc.AddNew
            For Each fldReportField In .rdoColumns
                If UCase(fldReportField.Name) = UCase("lngReportId") Then
                    rstDesc!lngReportID = lngReportID
                Else
                     If UCase(fldReportField.Name) <> UCase("lngReportFieldId") Then
                         rstDesc.rdoColumns(fldReportField.Name).Value = fldReportField.Value
                     Else
                         lngFieldID = BillPublic.GetNewID("ReportField")
                         rstDesc.rdoColumns(fldReportField.Name).Value = lngFieldID
                         On Error Resume Next
                         intLoc = -1
                         intLoc = colFieldID(CStr(fldReportField.Value))
                         If intLoc > 0 Then
                            mvarReportFieldID(intLoc - 1) = lngFieldID
                         End If
                         On Error GoTo 0
                     End If
                End If
            Next
            rstDesc.Update
            .MoveNext
         Loop
     End With
     '打开表触发器
    strSql = "Alter Table ReportField Enable All Triggers"
    gclsBase.BaseDB.Execute (strSql)
     
     '处理汇总字段ID
     On Error Resume Next
     For intCount = 0 To mvarGroupColumns - 1
        For intGroup = 1 To conSumCount
          If mvarColumnGroupID(intCount * conSumCount + intGroup) > 0 Then
               intLoc = -1
               intLoc = colFieldID(CStr(mvarColumnGroupID(intCount * conSumCount + intGroup)))
               If intLoc > 0 Then
                    mvarColumnGroupID(intCount * conSumCount + intGroup) = mvarReportFieldID(intLoc - 1)
               End If
               intLoc = -1
               intLoc = colFieldID(CStr(mvarColumnSumID(intCount * conSumCount + intGroup)))
               If intLoc > 0 Then
                    mvarColumnSumID(intCount * conSumCount + intGroup) = mvarReportFieldID(intLoc - 1)
               End If
          End If
        Next intGroup
    Next intCount
'    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
  Dim rstsave As rdoResultset
'  Dim blnSalary As Boolean
  
'  On Error GoTo ErrHandle
'  If mvarSaveErr Then Exit Sub
'  gclsBase.BaseDB.BeginTrans
  
  '更新报表
  If blnEdit Then           '另保存工资发放表ID
        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 & ",bytWizard=3" _
                & ",intGridTop=" & mvarGridTop _
                & ",blnIsIncludeTotal=1" & ",blnIsIncludeDetail= " & IIf(mvarIsOnlyShowSum, 0, 1) _
                & " ,strSalaryID='" & mvarSalaryID & "',strSalaryFieldID='" & mvarSalFieldID _
                & "',blnRotate=" & mvarRotate & ",lngPageFieldID=" & mvarPageFieldID & ",intFixedCol=" & mvarFixedCol _
                & " WHERE lngReportID =" & mvarReportID
  Else
        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 & ",bytWizard=3" _
              & ",intGridTop=" & mvarGridTop _
              & ",blnIsIncludeTotal=1" & ",blnIsIncludeDetail=  " & IIf(mvarIsOnlyShowSum, 0, 1) _
              & ",blnRotate=" & mvarRotate & ",lngPageFieldID=" & mvarPageFieldID & ",intFixedCol=" & mvarFixedCol _
              & " WHERE lngReportID =" & mvarReportID
  End If
  gclsBase.ExecSQL strSql
    
  '初始化报表字段
  strSql = "UPDATE ReportField Set blnIsChoosed=0 ,bytReportFieldType=0 ,bytSort=0,intSortNO=0" _
            & ",bytCodeShow=2,dblDistance=0 ,lngReportFieldNO=0  WHERE lngReportID =" & mvarReportID
  gclsBase.ExecSQL strSql
  
  '更新报表字段
 
    For intX = 0 To mvarChoosedColumns - 1
        intCount = mvarChoosedLoc(intX)
        If mvarCustomFormula(intCount) = "" Then mvarCustomFormula(intCount) = " "
        strSql = "UPDATE ReportField Set strReportFieldDesc='" & mvarColumnDesc(intCount) & "',dblDistance=" _
              & mvarColumnGroup(intCount) & ",bytReportFieldType=" & mvarColumnStyle(intCount) _
              & ",lngReportFieldNO=" & intX + 1 & ",lngDisplayWidth=" & mvarColumnWidth(intCount) _
              & ",strFomular='" & mvarCustomFormula(intCount) & "',bytSort=" & mvarColumnSort(intCount) _
              & ",intSortNO=" & mvarColumnSortNO(intCount) & ",blnIsChoosed=1" _
              & " Where  lngReportFieldId=" & mvarReportFieldID(intCount)
        gclsBase.ExecSQL strSql
    Next intX
    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
  
    '删除以前的分组记录
    strSql = "Delete   FROM ReportGroup WHERE lngReportId =" & mvarReportID
    gclsBase.ExecSQL strSql
    '添加现在的分组记录
    intX = 1
    Set rstsave = gclsBase.BaseDB.OpenResultset("SELECT *  FROM ReportGroup ", rdOpenDynamic, rdConcurValues)
    For intCount = 0 To mvarGroupColumns - 1
        For intGroup = 1 To conSumCount
          If mvarColumnGroupID(intCount * conSumCount + intGroup) > 0 Then
               If rstsave.RowCount > 0 Then rstsave.MoveLast
               rstsave.AddNew
               rstsave!lngReportID = mvarReportID
               rstsave!lngReportGroupFieldID = mvarColumnGroupID(intCount * conSumCount + intGroup)
               rstsave!bytReportGroupNO = intX
               rstsave!lngReportSumFieldID = mvarColumnSumID(intCount * conSumCount + intGroup)
               rstsave!bytSumMethod = mvarColumnSumMethod(intCount * conSumCount + intGroup)
               rstsave.Update
               intX = intX + 1
          End If
        Next intGroup
    Next intCount
    Set rstsave = Nothing
'    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 clsCross As CrossSet = Nothing, Optional clsWizardFormCond As FormCond = Nothing, Optional blnIsNew As Boolean = True) As Boolean
   Dim clsFormCond  As FormCond
   Dim clsFormCross  As CrossSet
   Dim blnStandard As Boolean
   
    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 clsCross Is Nothing Then
        Set clsFormCross = New FormCond
    Else
        Set clsFormCross = clsCross
    End If
    blnStandard = True
    ShowWizard = frmStandard.SetStandard(blnStandard, clsFormCond, Me, clsFormCross)
    
    If ShowWizard And blnIsNew Then
       '由向导新生成了一张帐表(还未存到数据库)
        Report.ShowStandardReport 0, 0, Me, clsFormCross, clsFormCond
    End If
    Set clsFormCond = Nothing
    Set clsFormCross = Nothing
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, strNew 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
                strNew = FormatFieldName(mvarColumnFieldName(intField), mvarColumnFormat(intField))
                strTemp = Mid(strFormula, intStart, intLoc -