standardreportset.cls

金算盘软件代码

    mvarColumnSumLoc(ColumnIndex) = vData
End Property

Public Property Get ColumnSumLoc(ByVal ColumnIndex As Integer) As Long
    ColumnSumLoc = mvarColumnSumLoc(ColumnIndex)
End Property

'栏目汇总方式 0=不参与 1=SUM 2=AVG 3=MIN 4=MAX 5=COUNT
Public Property Let ColumnSumMethod(ByVal ColumnIndex As Integer, ByVal vData As Integer)
    mvarColumnSumMethod(ColumnIndex) = vData
    Select Case vData
    Case 0
      mvarColumnSumDesc(ColumnIndex) = "不参与" & Space(100) & "0"
    Case 1
      mvarColumnSumDesc(ColumnIndex) = "求和" & Space(100) & "1"
    Case 2
      mvarColumnSumDesc(ColumnIndex) = "平均" & Space(100) & "2"
    Case 3
      mvarColumnSumDesc(ColumnIndex) = "最大值" & Space(100) & "3"
    Case 4
      mvarColumnSumDesc(ColumnIndex) = "最小值" & Space(100) & "4"
    Case 5
      mvarColumnSumDesc(ColumnIndex) = "计数" & Space(100) & "5"
    End Select
End Property

Public Property Get ColumnSumMethod(ByVal ColumnIndex As Integer) As Integer
    ColumnSumMethod = mvarColumnSumMethod(ColumnIndex)
End Property
'汇总说明(自己用)
Public Property Let ColumnSumDesc(ByVal ColumnIndex As Integer, ByVal vData As String)
    mvarColumnSumDesc(ColumnIndex) = vData
End Property

Public Property Get ColumnSumDesc(ByVal ColumnIndex As Integer) As String
    ColumnSumDesc = mvarColumnSumDesc(ColumnIndex)
End Property
'排序栏目数
Public Property Let SortColumns(ByVal vData As Integer)
    mvarSortColumns = vData
    If vData > 0 Then
    ReDim mvarSortLoc(vData - 1)
    ReDim mvarSortID(vData - 1)
    ReDim mvarSortMethod(vData - 1)
    End If
End Property

Public Property Get SortColumns() As Integer
    SortColumns = mvarSortColumns
End Property
 '排序栏目在已选栏目中的位置
Public Property Let SortLoc(ByVal ColumnIndex As Integer, ByVal vData As Integer)
    mvarSortLoc(ColumnIndex) = vData
End Property
Public Property Get SortLoc(ByVal ColumnIndex As Integer) As Integer
    SortLoc = mvarSortLoc(ColumnIndex)
End Property

Public Sub ClearSortNO()
Dim intCount As Integer
    For intCount = 0 To mvarColumns - 1
        mvarColumnSortNO(intCount) = 0
    Next intCount
End Sub
 '排序栏目ID
 Public Property Let SortID(ByVal ColumnIndex As Integer, ByVal vData As Long)
    Dim intCount As Integer
    mvarSortID(ColumnIndex) = vData
    For intCount = 0 To Columns - 1
     If vData = mvarColumnID(intCount) Then Exit For
    Next intCount
    mvarSortLoc(ColumnIndex) = intCount
    mvarColumnSortNO(intCount) = 1 + ColumnIndex
End Property
Public Property Get SortID(ByVal ColumnIndex As Integer) As Long
    SortID = mvarSortID(ColumnIndex)
End Property
 '排序方式
Public Property Let SortMethod(ByVal ColumnIndex As Integer, ByVal vData As Integer)
    mvarSortMethod(ColumnIndex) = vData
End Property
Public Property Get SortMethod(ByVal ColumnIndex As Integer) As Integer
    SortMethod = mvarSortMethod(ColumnIndex)
End Property
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                           无聊
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'标题宽度
Public Property Let TitleWidth(ByVal vData As Long)
    mvarTitleWidth = vData
End Property

Public Property Get TitleWidth() As Long
    TitleWidth = mvarTitleWidth
End Property
'标题高度
Public Property Let TitleHeight(ByVal vData As Long)
    mvarTitleHeight = vData
End Property

Public Property Get TitleHeight() As Long
    TitleHeight = mvarTitleHeight
End Property
'标题上边距
Public Property Let TitleTop(ByVal vData As Long)
    mvarTitleTop = vData
End Property

Public Property Get TitleTop() As Long
    TitleTop = mvarTitleTop
End Property
'标题左边距
Public Property Let TitleLeft(ByVal vData As Long)
    mvarTitleLeft = vData
End Property

Public Property Get TitleLeft() As Long
    TitleLeft = mvarTitleLeft
End Property
'标题对齐方式
Public Property Let TitleAlign(ByVal vData As Integer)
    mvarTitleAlign = vData
End Property

Public Property Get TitleAlign() As Integer
    TitleAlign = mvarTitleAlign
End Property

'查询条件显示方式
Public Property Let CondShow(ByVal vData As Byte)
    mvarCondShow = vData
End Property

Public Property Get CondShow() As Byte
    CondShow = mvarCondShow
End Property
'查询条件宽度
Public Property Let CondWidth(ByVal vData As Long)
    mvarCondWidth = vData
End Property

Public Property Get CondWidth() As Long
    CondWidth = mvarCondWidth
End Property
'查询条件高度
Public Property Let CondHeight(ByVal vData As Long)
    mvarCondHeight = vData
End Property

Public Property Get CondHeight() As Long
    CondHeight = mvarCondHeight
End Property
'查询条件上边距
Public Property Let CondTop(ByVal vData As Long)
    mvarCondTop = vData
End Property

Public Property Get CondTop() As Long
    CondTop = mvarCondTop
End Property
'查询条件左边距
Public Property Let CondLeft(ByVal vData As Long)
    mvarCondLeft = vData
End Property

Public Property Get CondLeft() As Long
    CondLeft = mvarCondLeft
End Property
'查询条件对齐方式
Public Property Let CondAlign(ByVal vData As Integer)
    mvarCondAlign = vData
End Property

Public Property Get CondAlign() As Integer
    CondAlign = mvarCondAlign
End Property

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'工资表ID串
Public Property Let SalaryID(ByVal vData As String)
Dim strSql As String
Dim rstField As rdoResultset
    mvarSalaryID = vData
    mvarSalFieldID = ""
    If Val(vData) > 0 Then
        strSql = "SELECT ViewField.lngViewFieldID AS FieldID FROM ViewField,ViewField  SalField,SalaryField" _
                & " WHERE ViewField.lngviewid=" & mvarViewID & " And SalField.lngviewid=63 And SalaryField.lngViewFieldID=SalField.lngViewFieldID " _
                & " And ViewField.strViewFieldDesc=SalField.strViewFieldDesc And Upper(ViewField.strFieldType)='DOUBLE'And SalaryField.lngSalaryListID IN (" & mvarSalaryID & ")"
        Set rstField = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        Do Until rstField.EOF
            If mvarSalFieldID = "" Then
                mvarSalFieldID = rstField!FieldID
            Else
                mvarSalFieldID = mvarSalFieldID & "," & rstField!FieldID
            End If
            rstField.MoveNext
        Loop
    End If
    Set rstField = Nothing
End Property

Public Property Get SalaryID() As String
    SalaryID = mvarSalaryID
End Property
'工资字段ID串
Public Property Let SalFieldID(ByVal vData As String)
    mvarSalFieldID = vData
End Property

Public Property Get SalFieldID() As String
    SalFieldID = mvarSalFieldID
End Property


'''''''''''''''''''''''''''''''''''''''''''''''''''
'                只读属性
'
'''''''''''''''''''''''''''''''''''''''''''''''''''
'得到SQL语句
Public Property Get GetSQLPre() As String
    GetSQLPre = mstrSelect & mvarFrom
End Property
'得到SQL语句
Public Property Get GetSQLLast() As String
    GetSQLLast = mstrOrder
End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''
'                标准表向导设置类方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetFieldSize(ByVal lngViewFieldID) As Integer
Dim intLoc As Integer
    On Error Resume Next
    intLoc = -1
    intLoc = mcolFieldID(CStr(lngViewFieldID))
    If intLoc = -1 Then
        GetFieldSize = 10
    Else
        GetFieldSize = mvarColumnFieldSize(intLoc)
    End If
End Function

'没有报表ID号时，根据向导类型得到向导报表ID号
Public Sub GetRepoertID(ByVal lngViewId As Long)
Dim rstView As rdoResultset
Dim strSql As String
    strSql = "SELECT Report.lngReportID FROM  View1 Where Report.bytPrep=0 and Report.bytWizard=3 and Report.lngViewID=" & lngViewId
    Set rstView = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not rstView.EOF Then
        GetReportSet rstView!lngReportID
    End If
    Set rstView = Nothing
End Sub
'从ID号得到设置
Public Function GetReportSet(ByVal lngReportID As Long) As Boolean
Dim rstView As rdoResultset
Dim strSql As String
Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
    strSql = "SELECT View1.* FROM  View1 WHERE View1.lngViewId=(Select Report.lngViewID From Report Where Report.lngReportID=" & lngReportID & ")"
    Set rstView = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    mvarFrom = " FROM " & rstView!strViewSQL
    mvarViewCond = rstView.rdoColumns("strViewWhere").GetChunk(4096)
    Set rstView = Nothing
    mvarReportID = lngReportID
    GetReport
    GetField
    GetReportGroup
    GetReportSet = True
    Exit Function
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         GetReportSet = False
         Utility.ShowMsg frmMain.hWnd, "组织数据失败!", vbOKOnly + vbInformation, App.title
    End If
End Function

'得到Report表内容
Private Sub GetReport()
Dim strSql As String
Dim rstReport As rdoResultset
    
    strSql = "SELECT * FROM Report  WHERE Report.lngReportID = " & mvarReportID
    Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rstReport.EOF Then
        Exit Sub
    End If
'    On Error Resume Next
    With rstReport
       mvarOperatorID = !lngOperatorID
       mvarGroupNo = !bytGroup
       mvarViewID = !lngViewId
       mvarPageFieldID = !lngPageFieldID
       mvarReportPrep = !bytPrep
       mvarReportCond = Trim(!strExtraCond)
       mvarVersion = !bytVersion
       mvarLevel = !intLevel
       mvarParentID = !lngParentId
       mvarReportName = !strReportName
       mvarIsOnlyShowSum = IIf(!blnIsIncludeDetail, 0, 1)
       mvarPrintSetID = !lngPrintSetupID
       mvarRotate = !blnRotate
       mvarSalaryID = Trim(!strSalaryID)
       mvarSalFieldID = Trim(!strSalaryFieldID)
       mvarFixedCol = !intFixedCol
       mvarGridTop = !intGridTop
       
       mvarTitleWidth = !intTitleWidth
       mvarTitleHeight = !intTitleHeight
       mvarTitleTop = !intTitleTop
       mvarTitleLeft = !intTitleLeft
       mvarTitleAlign = !intTitleAlign
       
       mvarCondShow = !bytCondShow
       mvarCondTop = !intCondTop
       mvarCondLeft = !intCondLeft
       mvarCondWidth = !intCondWidth
       mvarCondHeight = !intCondHeight
       mvarCondAlign = !intCondAlign
       
       If mvarTitleWidth = 0 Then
            mvarTitleWidth = StrLen(mvarReportName) * 90 + 30
            mvarTitleHeight = 400
       End If
       If mvarCondWidth = 0 Then
            mvarCondWidth = 6000