vbmysqlcrystaldatasource.cls

来自「一个关于电脑管理汽车的软件」· CLS 代码 · 共 159 行

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "VBMySQLCrystalDataSource"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'###############################################################################
'###############################################################################
'
' VBMySQLCrystal - An interface library to allow VBMySQLDirect to work
'                  with Crystal reports
' Copyright (C) 2004 Robert Rowe
'
' This library is free software; you can redistribute it and/or
' modify it under the terms of the GNU Library General Public
' License as published by the Free Software Foundation; either
' version 2 of the License, or (at your option) any later version.
'
' This library is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
' Library General Public License for more details.
'
' You should have received a copy of the GNU Library General Public
' License along with this library; if not, write to the Free
' Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
'
'###############################################################################
'###############################################################################
'
' Written by Robert Rowe
'
' Please send questions, comments, and changes to [e-mail]
'
'###############################################################################
'###############################################################################

Option Explicit

'Crystal API's
Private Declare Function CreateFieldDefFile Lib "p2smon.dll" (lpUnk As Object, ByVal Filename As String, ByVal bOverWriteExistingFile As Long) As Long
Private Declare Function CreateReportOnRuntimeDS Lib "p2smon.dll" (lpUnk As Object, ByVal reportFile As String, ByVal fieldDefFile As String, ByVal bOverWriteFile As Long, ByVal bLaunchDesigner As Long) As Long
Implements CRDataSourceLib.CRDataSource

'Locals for properties
Private mvarRecordset As MYSQL_RS
Public Function CreateTTX(PathFileName As String, Optional Overwrite As Boolean = True) As Boolean
Dim Result As Long
    Result = CreateFieldDefFile(Me, PathFileName, IIf(Overwrite, 1, 0))
    CreateTTX = IIf(Result = 1, True, False)
End Function
Public Property Set Recordset(ByVal vData As MYSQL_RS)
    Set mvarRecordset = vData
End Property

Public Property Get Recordset() As MYSQL_RS
    Set Recordset = mvarRecordset
End Property

Private Property Let CRDataSource_Bookmark(ByVal RHS As Variant)
    mvarRecordset.Bookmark = RHS
End Property

Private Property Get CRDataSource_Bookmark() As Variant
    CRDataSource_Bookmark = mvarRecordset.Bookmark
End Property

Private Property Get CRDataSource_EOF() As Boolean
    CRDataSource_EOF = mvarRecordset.EOF
End Property

Private Property Get CRDataSource_FieldCount() As Integer
    CRDataSource_FieldCount = mvarRecordset.FieldCount
End Property

Private Property Get CRDataSource_FieldName(ByVal FieldIndex As Integer) As String
    CRDataSource_FieldName = mvarRecordset.Fields(FieldIndex).Name
End Property

Private Property Get CRDataSource_FieldType(ByVal FieldIndex As Integer) As Integer
    
    Select Case mvarRecordset.Fields(FieldIndex).MySqlType
    Case 0 'MYSQL_DECIMAL
        CRDataSource_FieldType = 6
    Case 1 'MYSQL_TINYINT
        CRDataSource_FieldType = 2
    Case 2 'MYSQL_SMALLINT
        CRDataSource_FieldType = 2
    Case 3 'MYSQL_INT
        CRDataSource_FieldType = 3
    Case 4 'MYSQL_FLOAT
        CRDataSource_FieldType = 4
    Case 5 'MYSQL_DOUBLE
        CRDataSource_FieldType = 4
    Case 7 'MYSQL_TIMESTAMP
        CRDataSource_FieldType = 7
    Case 8 'MYSQL_BIGINT
        CRDataSource_FieldType = 3
    Case 9 'MYSQL_MEDIUMINT
        CRDataSource_FieldType = 3
    Case 10 'MYSQL_DATE
        CRDataSource_FieldType = 7
    Case 11 'MYSQL_TIME
        CRDataSource_FieldType = 7
    Case 12 'MYSQL_DATETIME
        CRDataSource_FieldType = 7
    Case 13 'MYSQL_YEAR
        CRDataSource_FieldType = 3
    Case 247 'MYSQL_ENUM
        CRDataSource_FieldType = 8
    Case 248 'MYSQL_SET
        CRDataSource_FieldType = 8
    Case 249 'MYSQL_TINYBLOB
        CRDataSource_FieldType = 65
    Case 250 'MYSQL_MEDIUMBLOB
        CRDataSource_FieldType = 65
    Case 251 'MYSQL_LONGBLOB
        CRDataSource_FieldType = 65
    Case 252 'MYSQL_BLOB
        CRDataSource_FieldType = 65
    Case 253, 254 'MYSQL_VARCHAR, MYSQL_CHAR
        CRDataSource_FieldType = 8
'    Case 254 'MYSQL_CHAR
'        If (mvarRecordset.Fields(FieldIndex).Flags And MY_ENUM_FLAG) > 0 Or (mvarRecordset.Fields(FieldIndex).Flags And MY_SET_FLAG) > 0 Then
'            CRDataSource_FieldType = 8
'        Else
'            CRDataSource_FieldType = 16
'        End If
    End Select
    
    
End Property

Private Property Get CRDataSource_FieldValue(ByVal FieldIndex As Integer) As Variant
    CRDataSource_FieldValue = mvarRecordset.Fields(FieldIndex).Value
End Property

Private Sub CRDataSource_MoveFirst()
    mvarRecordset.MoveFirst
End Sub

Private Sub CRDataSource_MoveNext()
    mvarRecordset.MoveNext
End Sub

Private Property Get CRDataSource_RecordCount() As Long
    CRDataSource_RecordCount = mvarRecordset.RecordCount
End Property