databank.cls

create a chart graph using vb 6.0

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "DataBank"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private mDataArr() As Double
Private mDataCount As Integer
Private mDataBasePath As String

Private Sub Class_Initialize()
    'Tentukan path database
    mDataBasePath = App.Path & "\" & DB_NAME
    'Pastikan database ada. Jika tidak, buat baru.
    If Dir(mDataBasePath) = "" Then
        CreateNewdb
    End If
    FillArray
End Sub

Property Get DataCount() As Integer
    DataCount = mDataCount
End Property

Property Get DataItem(ByVal Index As Integer) As Double
    DataItem = mDataArr(Index)
End Property

Public Sub AppendData(ByVal DataValue As Double)
    mDataCount = mDataCount + 1
    ReDim Preserve mDataArr(mDataCount - 1)
    mDataArr(mDataCount - 1) = DataValue
    AddNewValue DataValue
End Sub

'************DATABASE***************
Private Sub CreateNewdb()
    Dim db As Database, tbl As TableDef
    
    Set db = CreateDatabase(mDataBasePath, dbLangGeneral, dbVersion30)
    Set tbl = db.CreateTableDef(DATA_TBL_NAME)
    tbl.Fields.Append tbl.CreateField(DATA_FLD_NAME, dbDouble)
    db.TableDefs.Append tbl
    db.Close
    Set tbl = Nothing
    Set db = Nothing
End Sub

Private Sub FillArray()
    Dim db As Database, Rcdset As Recordset, Idx As Integer
    
    Set db = OpenDatabase(mDataBasePath, False, True)
    Set Rcdset = db.OpenRecordset(DATA_TBL_NAME, dbOpenSnapshot, dbReadOnly)
    If Rcdset.RecordCount > 0 Then
        Rcdset.MoveLast
        mDataCount = Rcdset.RecordCount
        ReDim Preserve mDataArr(mDataCount - 1)
        Rcdset.MoveFirst
        Idx = -1
        Do Until Rcdset.EOF
            Idx = Idx + 1
            mDataArr(Idx) = Rcdset.Fields(DATA_FLD_NAME)
            Rcdset.MoveNext
        Loop
    Else
        mDataCount = 0
        Erase mDataArr
    End If
    Rcdset.Close
    db.Close
    Set Rcdset = Nothing
    Set db = Nothing
End Sub

Private Sub AddNewValue(ByVal DataValue As Double)
    Dim db As Database, Rcdset As Recordset
    Set db = OpenDatabase(mDataBasePath, True, False)
    Set Rcdset = db.OpenRecordset(DATA_TBL_NAME, dbOpenDynaset, dbAppendOnly)
    Rcdset.AddNew
    Rcdset.Fields(DATA_FLD_NAME) = DataValue
    Rcdset.Update
    Rcdset.Close
    db.Close
    Set Rcdset = Nothing
    Set db = Nothing
End Sub

Public Sub Edit(ByVal Index As Integer, ByVal Value As Double)
    Dim db As Database, Rcdset As Recordset
    mDataArr(Index) = Value
    Set db = OpenDatabase(mDataBasePath, True, False)
    Set Rcdset = db.OpenRecordset(DATA_TBL_NAME, dbOpenDynaset)
    Rcdset.MoveFirst
    Rcdset.Move Index
    Rcdset.Edit
    Rcdset.Fields(DATA_FLD_NAME) = Value
    Rcdset.Update
    Rcdset.Close
    Set Rcdset = Nothing
    db.Close
    Set db = Nothing
End Sub

Public Sub DelItem(ByVal Index As Integer)
    Dim db As Database, Rcdset As Recordset
    Set db = OpenDatabase(mDataBasePath, True, False)
    Set Rcdset = db.OpenRecordset(DATA_TBL_NAME, dbOpenDynaset)
    Rcdset.MoveFirst
    Rcdset.Move Index
    Rcdset.Delete
    Rcdset.Close
    Set Rcdset = Nothing
    db.Close
    Set db = Nothing
    FillArray
End Sub