reportsumset.cls

金算盘软件代码

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
    If mvarSalFieldID = "" Then mvarSalFieldID = "0"
    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
'''''''''''''''''''''''''''''''''''''''''''''''''''
'                只读属性
'
'''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Get GetSQLPre() As String
    GetSQLPre = mstrSelect & mvarFrom
End Property
Public Property Get GetGroup() As String
    GetGroup = mstrGroup
End Property
Public Property Get GetOrder() As String
    GetOrder = mstrOrder
End Property
'''''''''''''''''''''''''''''''''''''''''''''''''''
'                标准表向导设置类方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''

'没有报表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=8 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
    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
'        Utility.ShowMsg frmMain.hwnd, "没打开记录集!", vbOKOnly, App.title
        Exit Sub
    End If
'    On Error Resume Next
    With rstReport
       mvarOperatorID = !lngOperatorID
       mvarGroupNo = !bytGroup
       mvarViewID = !lngViewId
       mvarReportPrep = !bytPrep
       mvarReportCond = Trim(!strExtraCond)
       mvarVersion = !bytVersion
       mvarLevel = !intLevel
       mvarParentID = !lngParentId
       mvarReportName = !strReportName
       mvarPrintSetID = !lngPrintSetupID
       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
            mvarCondHeight = 330
       End If
       
    End With
    Set rstReport = Nothing
    
    '处理工资报表
    Select Case mvarViewID
    Case 595
         DealSalaryField   'OldDealSalary
    Case Else
    End Select
End Sub
'得到字段内容
Public Sub GetField()
    Dim intCount As Integer
    Dim intGroup As Integer, intSort As Integer
    Dim intList As Integer, intChoosed As Integer
    Dim rstReport As rdoResultset
    Dim strCondVersion As String, strSql As String, strCondHospital As String
    Dim arrFormula(4) As Integer
    #If conVersionType = 1 Then
        strCondVersion = " And MOD(ViewField.bytVersion,2)>0 "
    #Else
      #If conVersionType = 2 Then
        strCondVersion = " And MOD(ViewField.bytVersion,4)>1 "
      #Else
        #If conVersionType = 4 Then
           strCondVersion = " And MOD(ViewField.bytVersion,8)>3 "
        #Else
           #If vonversiontype = 8 Then
              strCondVersion = " And MOD(ViewField.bytVersion,16)>7 "
           #Else
              strCondVersion = " And MOD(ViewField.bytVersion,32)>15 "
           #End If
        #End If
      #End If
    #End If
    Select Case mvarViewID
    Case 593, 595, 596           '工资报表加特殊条件
        If mvarSalFieldID <> "" Then
            strCondVersion = strCondVersion & " And (Upper(ViewField.strFieldType)<>'DOUBLE' OR " _
                        & " Upper(ViewField.strFieldType)='DOUBLE' AND ViewField.lngViewFieldID IN (" & mvarSalFieldID & "))"
        End If
    Case Else
    End Select
    Select Case gclsBase.AccountSys
    Case "3"       '会计制度 3:行政
        strCondHospital = " And ViewField.blnNotHospital=0 "
    Case Else
        strCondHospital = ""
    End Select
'    On Error Resume Next
    strSql = "SELECT   ReportField.*,ViewField.* FROM  ReportField,ViewField " _
            & " WHERE ReportField.lngViewFieldID = ViewField.lngViewFieldID " _
            & strCondVersion & strCondHospital & " And ReportField.lngReportID =" & mvarReportID _
            & " ORDER BY ReportField.blnIsChoosed,ReportField.lngReportFieldNO,ReportField.intShowNO"
    Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rstReport.EOF Then
       Exit Sub
    End If
     With rstReport
        .MoveLast
        .MoveFirst
        Columns = .RowCount + 5
     End With
     strSql = "SELECT   ReportField.*,ViewField.* FROM  ReportField,ViewField " _
            & " WHERE ((ReportField.lngViewFieldID>0 " & strCondVersion & strCondHospital & ") or strFomular<>' ') And " _
            & "  ReportField.lngViewFieldID = ViewField.lngViewFieldID(+) And ReportField.lngReportID =" & mvarReportID _
            & " ORDER BY ReportField.blnIsChoosed,ReportField.lngReportFieldNO,ReportField.intShowNO"
    Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With rstReport
          intGroup = 0: intList = 0
          intSort = 0: intCount = 0
          intChoosed = 0
          mvarCustomFields = 0
          Set mcolFieldID = New Collection
          Do While Not .EOF
    
            mvarColumnID(intCount) = !lngViewFieldID
            mvarColumnDesc(intCount) = !strReportFieldDesc
            mvarColumnWidth(intCount) = !lngDisplayWidth
            mvarColumnHeight(intCount) = !lngDisplayHeight
            mvarColumnLeft(intCount) = !lngDisplayLeft
            mvarColumnTop(intCount) = !lngdisplaytop
            mvarColumnAlign(intCount) = !intAlign
            mvarColumnStyle(intCount) = !bytReportFieldType
            mvarColumnSort(intCount) = !bytsort
            mvarColumnSortNO(intCount) = !intSortNo
            mvarColumnNO(intCount) = !lngReportFieldNO
            mvarColumnChoosed(intCount) = !blnIsChoosed
            mvarColumnSumed(intCount) = !blnTableSum
            mvarCustomFormula(intCount) = Trim(!strFomular)
            mvarCodeName(intCount) = !bytCodeShow
            mvarReportFieldID(intCount) = !lngReportFieldID
            
            If mvarColumnID(intCount) > 0 Then
                mcolFieldID.Add intCount, CStr(mvarColumnID(intCount))
            End If
                  
            mvarColumnFieldName(intCount) = IIf(IsNull(!strFieldName), "", !strFieldName)