VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Lifehistory"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
Private h As Integer
Private buff_inr(1 To 1000) As Long
Private buff_hnr(1 To 1000) As Long
Private buff_sex(1 To 1000) As Integer
Private buff_age(1 To 1000) As Integer
Private buff_time(1 To 1000) As Integer
Private buff_hevent(1 To 1000) As String * 30
Private mdbfil As String
Private init_done As Integer
'local variable(s) to hold property value(s)
Private menabled As Boolean 'local copy
Public Property Let enabled(ByVal vData As Boolean)
    menabled = vData
End Property

Public Property Get enabled() As Boolean
Attribute enabled.VB_UserMemId = 0
    enabled = menabled
End Property
' Init and create db

Public Sub Init()
   Dim ws As Workspace
   Dim db As Database
   Dim tb As TableDef
   Dim findnr0 As Field
   Dim findnr1 As Field
   Dim findnr2 As Field
   Dim findnr3 As Field
   Dim findnr4 As Field
   Dim findnr5 As Field
   Dim findnr6 As Field
   Dim newf As Field
   Dim indnr_idx As Index
      
   If menabled = False Then Exit Sub
   
   mdbfil = sesimpath & "\microdata\event_history.mdb"
   
   status "Create event history database"
   
   If Dir(mdbfil) <> "" Then Kill mdbfil
   Set ws = DBEngine.Workspaces(0)
   Set db = ws.CreateDatabase(mdbfil, dbLangGeneral, dbVersion30)
   
   Set tb = db.CreateTableDef("Hist")
   
   ' Event number
   Set findnr0 = tb.CreateField("Eventnr", dbLong)
   findnr0.Attributes = dbAutoIncrField
   Set findnr1 = tb.CreateField("Indnr", dbLong)
   Set findnr2 = tb.CreateField("Hhnr", dbLong)
   Set findnr3 = tb.CreateField("Sex", dbInteger)
   Set findnr4 = tb.CreateField("Age", dbLong)
   Set findnr5 = tb.CreateField("ModelTime", dbInteger)
   Set findnr6 = tb.CreateField("Event", dbText)
   findnr3.Size = 30
   
   tb.Fields.Append findnr0
   tb.Fields.Append findnr1
   tb.Fields.Append findnr2
   tb.Fields.Append findnr3
   tb.Fields.Append findnr4
   tb.Fields.Append findnr5
   tb.Fields.Append findnr6
   db.TableDefs.Append tb
   
   
   Set indnr_idx = tb.CreateIndex("indnr")
   indnr_idx.Primary = True
   indnr_idx.Unique = False
   Set newf = indnr_idx.CreateField("indnr")
   indnr_idx.Fields.Append newf
   tb.Indexes.Append indnr_idx
   
   db.Close

   init_done = 1
End Sub


Public Sub write_hist(inr As Long, hevent As String)
  
  If menabled = False Then Exit Sub
  If init_done = 0 Then Call Init
  
  h = h + 1
  buff_inr(h) = inr
  
  buff_hnr(h) = 0
  If indnr2index(inr) > 0 Then buff_hnr(h) = i_hhnr(indnr2index(inr))
  
  buff_sex(h) = 0
  If indnr2index(inr) > 0 Then buff_sex(h) = i_sex(indnr2index(inr))
  
  buff_age(h) = 0
  If indnr2index(inr) > 0 Then buff_age(h) = i_age(indnr2index(inr))
  
  buff_time(h) = model_time
  buff_hevent(h) = hevent
    
  ' Write buffer
  If h = 1000 Then write_now
End Sub




' Write buffer to db

Public Sub write_now()
  Dim i As Integer
  
  Dim db As Database
  Dim rs As Recordset
    
  If menabled = False Then Exit Sub
    
  status "Writing event history..."
  
  Set db = OpenDatabase(mdbfil)
   
  Set rs = db.OpenRecordset("Hist", dbOpenTable, dbAppendOnly)
  
  
  For i = 1 To h
  With rs
     .AddNew
     !indnr = buff_inr(i)
     !hhnr = buff_hnr(i)
     !sex = buff_sex(i)
     !age = buff_age(i)
     !modeltime = buff_time(i)
     !event = buff_hevent(i)
     .Update
  End With
  Next
  db.Close
  h = 0
  
  'controlcenter.cmd3Lifeevents.enabled = True
  
  status "History written"
End Sub