quotaset.cls

金算盘软件代码

Public Property Let FieldSize(ByVal ColumnIndex As Integer, ByVal vData As String)
    mvarFieldSize(ColumnIndex) = vData
End Property

Public Property Get FieldSize(ByVal ColumnIndex As Integer) As String
    FieldSize = mvarFieldSize(ColumnIndex)
End Property
'表头编码加名称
Public Property Let CodeName(ByVal ColumnIndex As Integer, ByVal vData As Byte)
    mvarCodeName(ColumnIndex) = vData
End Property

Public Property Get CodeName(ByVal ColumnIndex As Integer) As Byte
    CodeName = mvarCodeName(ColumnIndex)
End Property
'栏目字段说明
Public Property Let ColumnFieldDesc(ByVal ColumnIndex As Integer, ByVal vData As String)
    mvarFieldDesc(ColumnIndex) = vData
End Property

Public Property Get ColumnFieldDesc(ByVal ColumnIndex As Integer) As String
    ColumnFieldDesc = mvarFieldDesc(ColumnIndex)
End Property

'栏目字段表头类型
Public Property Let ColumnFieldHead(ByVal ColumnIndex As Integer, ByVal vData As Integer)
    mvarFieldHead(ColumnIndex) = vData
End Property

Public Property Get ColumnFieldHead(ByVal ColumnIndex As Integer) As Integer
    ColumnFieldHead = mvarFieldHead(ColumnIndex)
End Property
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'已选栏目数
Public Property Let ChoosedColumns(ByVal vData As Integer)
    mvarChoosedColumns = vData
    If mvarChoosedColumns = 0 Then Exit Property
    ReDim mvarChoosedID(mvarChoosedColumns - 1)
    ReDim mvarChoosedLoc(mvarChoosedColumns - 1)
End Property

Public Property Get ChoosedColumns() As Integer
    ChoosedColumns = mvarChoosedColumns
End Property
'已选栏目字段ID
Public Property Let ChoosedID(ByVal ColumnIndex As Integer, ByVal vData As Long)
Dim intCount As Integer
    mvarChoosedID(ColumnIndex) = vData
    For intCount = 0 To mvarColumns - 1
        If mvarColumnID(intCount) = vData Then
            Exit For
        End If
    Next intCount
    mvarChoosedLoc(ColumnIndex) = intCount
End Property

Public Property Get ChoosedID(ByVal ColumnIndex As Integer) As Long
    ChoosedID = mvarChoosedID(ColumnIndex)
End Property
'已选栏目字段位置
Public Property Let ChoosedLoc(ByVal ColumnIndex As Integer, ByVal vData As Integer)
    mvarChoosedLoc(ColumnIndex) = vData
End Property

Public Property Get ChoosedLoc(ByVal ColumnIndex As Integer) As Integer
    ChoosedLoc = mvarChoosedLoc(ColumnIndex)
End Property

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'列表框栏目数
Public Property Let ListColumns(ByVal vData As Integer)
    mvarListColumns = vData
    If mvarListColumns = 0 Then Exit Property
    ReDim mvarListID(mvarListColumns - 1)
    ReDim mvarListLoc(mvarListColumns - 1)
   
End Property

Public Property Get ListColumns() As Integer
    ListColumns = mvarListColumns
End Property
'列表框栏目字段ID
Public Property Let ColumnListID(ByVal ColumnIndex As Integer, ByVal vData As Long)
    mvarListID(ColumnIndex) = vData
End Property

Public Property Get ColumnListID(ByVal ColumnIndex As Integer) As Long
    ColumnListID = mvarListID(ColumnIndex)
End Property
'列表框栏目字段位置
Public Property Let ColumnListLoc(ByVal ColumnIndex As Integer, ByVal vData As Integer)
    mvarListLoc(ColumnIndex) = vData
End Property

Public Property Get ColumnListLoc(ByVal ColumnIndex As Integer) As Integer
    ColumnListLoc = mvarListLoc(ColumnIndex)
End Property
'是否固定栏目
Public Property Let FieldFixed(ByVal ColumnIndex As Integer, ByVal vData As Byte)
    mvarFieldFixed(ColumnIndex) = vData
End Property

Public Property Get FieldFixed(ByVal ColumnIndex As Integer) As Byte
    FieldFixed = mvarFieldFixed(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
'''''''''''''''''''''''''''''''''''''''''''''''''''
'                只读属性
'
'''''''''''''''''''''''''''''''''''''''''''''''''''
'得到SQL语句
Public Property Get GetSQLPre() As String
    GetSQLPre = mstrSelect & mvarFrom
End Property
'得到SQL语句
Public Property Get GetSQLLast() As String
    GetSQLLast = mstrGroup & mstrHaving
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=10 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, strTemp 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
       .MoveNext
       .MoveFirst
       mvarOperatorID = !lngOperatorID
       mvarGroupNo = !bytGroup
       mvarViewID = !lngViewId
       mvarReportPrep = !bytPrep
       mvarVersion = !bytVersion
       mvarLevel = !intLevel
       mvarParentID = !lngParentId
       mvarReportName = !strReportName
       mvarReportCond = Trim(!strExtraCond)
'       mvarFrom = !strFrom
       mvarGridTop = !intGridTop
       mvarPrintSetID = !lngPrintSetupID
       
       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 = 8000
            mvarCondHeight = 330
       End If
       
       mvarSalaryList = Trim(!strSalaryID)
       strTemp = Trim(!strSalaryFieldID)
       mvarSalField = StringOut(strTemp, "$")
       mvarStandard = strTemp
    End With
    Set rstReport = Nothing
 End Sub
'得到字段内容
Private Sub GetField()
    Dim intCount As Integer
    Dim intChoosed As Integer, intList As Integer
    Dim strSql As String
    Dim rstReport As rdoResultset
    Dim strCondVersion As String
    #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
    '对已选栏目
'    On Error Resume Next
    strSql = "SELECT   ReportField.*,ViewField.*  " & _
            "FROM   ReportField , ViewField WHERE ReportField.lngViewFieldID = ViewField.lngViewFieldID " _
            & strCondVersion & " And  ReportField.lngReportID =" & mvarReportID _
            & " ORDER BY ReportField.blnIsChoosed Desc,ReportField.lngReportFieldNO,ReportField.intShowNO"
    Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rstReport.EOF Then
'      Utility.ShowMsg frmMain.hwnd, "没打开Field表!", vbOKOnly, App.title
      Exit Sub
    End If
     With rstReport
      .MoveLast
      .MoveFirst
      Columns = .RowCount
      intChoosed = 0
      intList = 0
      intCount = 0
      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
            mvarColumnChoosed(intCount) = !blnIsChoosed
            mvarFieldDesc(intCount) = !strViewFieldDesc
            mvarFieldSize(intCount) = !bytFieldSize
            mvarFieldName(intCount) = !strFieldName
            mvarFieldType(intCount) = !strFieldType
            mvarFieldHead(intCount) = !bytHead
            mvarCodeName(intCount) = !bytCodeShow
            mvarFieldFixed(intCount) = !blnIsFixed
            
            If !blnIsChoosed Then
                intChoosed = intChoosed + 1
            End If
            If !bytReportFieldType = 6 And !bytHead = 2 Then
                intList = intList + 1
            End If
            .MoveNext
            intCount = intCount + 1
      Loop
    End With
    
    ChoosedColumns = intChoosed
    ListColumns = intList
    intChoosed = 0
    intList = 0
    For intCount = 0 To mvarColumns - 1
        If mvarColumnChoosed(intCount) = 1 Then
            mvarChoosedID(intChoosed) = mvarColumnID(intCount)
            mvarChoosedLoc(intChoosed) = intCount