VERSION 5.00
Begin VB.MDIForm MDIForm1 
   BackColor       =   &H8000000C&
   Caption         =   "Sesim"
   ClientHeight    =   7650
   ClientLeft      =   60
   ClientTop       =   630
   ClientWidth     =   9615
   Icon            =   "MDIForm1.frx":0000
   StartUpPosition =   2  'CenterScreen
   Begin VB.Menu menu_Edit 
      Caption         =   "&Edit"
      Begin VB.Menu menu_loadwindowsstate 
         Caption         =   "&Load Window State"
         Enabled         =   0   'False
      End
      Begin VB.Menu menu_savewindowsstate 
         Caption         =   "&Save window state"
         Enabled         =   0   'False
      End
      Begin VB.Menu menu_print 
         Caption         =   "&Print windows"
      End
      Begin VB.Menu menu_exit 
         Caption         =   "&Exit"
      End
   End
   Begin VB.Menu menu_data 
      Caption         =   "&Data"
      Begin VB.Menu menu_skrivtxt 
         Caption         =   "Write SAS file"
      End
      Begin VB.Menu menu_writeaccess 
         Caption         =   "Write Access file"
      End
      Begin VB.Menu menu_writebin 
         Caption         =   "Write binary file"
      End
   End
   Begin VB.Menu menu_hjälp 
      Caption         =   "&Help"
      Begin VB.Menu menu_about 
         Caption         =   "&About"
      End
      Begin VB.Menu menu_variables 
         Caption         =   "Variable Definitions"
      End
      Begin VB.Menu menu_runtime 
         Caption         =   "Runtime switches"
      End
   End
End
Attribute VB_Name = "MDIForm1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'! *************************************
'! This is the main starting form
'! *************************************

Private Sub MDIForm_Load()
'! First Sub running when starting Sesim
  
  
  ' Out program path
  Call setpath
  If Left$(sesimpath, 1) <> "\" Then ChDrive sesimpath
 
  ' Change directory to make available the FORTRAN DLL-library
  ChDir sesimpath & "\source"
  
  ' Documentation file for tracing
  Open sesimpath & "\tempdata\trace_doc.txt" For Output As #101
  Printdok "MDIForm_Load"
  
  
  ' Only one instance in each directory
  If App.PrevInstance = True Then
    MsgBox "Sesim is already running. This instance will terminate."
    End
  End If
    
  ' Load standard forms
  Load controlcenter
  Load statusform
  Load frmEditor
    
  ' Form handling DDE-requests
  Load zsesimDDE
  zsesimDDE.Visible = False
  
  Load frmSESIMDDE
  frmSESIMDDE.Visible = False
  
  '-- Command line arguments:
  '   Syntax SESIM {years} {sample}
  '   Example: SESIM 51 20 Executes the model 51 years with a 20% subsample
  If command <> "" And command <> "Command" Then
        Dim strCmd As String
        Dim i As Long
        Dim x() As String
        strCmd = CStr(command)
        x = Split(strCmd, " ")
        If UBound(x) >= 1 Then
            controlcenter.txtPercentofsample.text = x(1) '-- Sample size
        End If
         
        ' Handle output data object and output file
        If UBound(x) >= 2 Then
        
          Dim filenr As Integer
          filenr = FreeFile
          Open sesimpath & "\parameterdata\" & x(2) For Binary As filenr
          Get #filenr, , OutputData
          Close filenr
          
          OutputData.OutputActive = True
          If UBound(x) >= 3 Then
            OutputData.filename = x(3)
          End If
          
        End If
        
        Call step_to_year(x(0)) '-- Execute the model
        End '-- Terminates the model
  End If

  controlcenter.SetFocus
End Sub



Private Sub menu_about_Click()
'! Menu choice - about
  If Dir(sesimpath & "\sesim.exe") = "" Then
    MsgBox "You are running SESIM in debug mode!"
  Else
    MsgBox "This version of Sesim was compiled" & vbCrLf & FileDateTime(sesimpath & "\sesim.exe")
  End If
End Sub



Private Sub menu_exit_Click()
'! Menu choice - exit
   End
End Sub



Private Sub menu_savewindowsstate_Click()
'! Menu choice - Save window state
  Dim v_s
  Dim C
  
  Open sesimpath & "\parameterdata\wstate.txt" For Output As #3
  Print #3, Me.Top
  Print #3, Me.Left
  Print #3, Me.Width
  Print #3, Me.Height
  For Each v_s In coll_view
    'MsgBox v_s.Caption & " " & v_s.Tag
    Print #3, v_s.name
    Print #3, v_s.Top
    Print #3, v_s.Left
    Print #3, v_s.Width
    Print #3, v_s.Height
    For Each C In v_s.Controls
      If LCase(Mid$(C.name, 1, 4)) = "comb" Then
        Print #3, C.name & ".text:" & C.text
      End If
      If LCase(Mid$(C.name, 1, 3)) = "chk" Then
        Print #3, C.name & ".value:" & C.value
      End If
      If LCase(Mid$(C.name, 1, 3)) = "txt" Then
        Print #3, C.name & ".text:" & C.text
      End If
    Next
  Next
  
  If exclude_tag <> "" Then
    Print #3, "exclude_tag:" & exclude_tag
    Print #3, "exclude_txt:" & exclude_txt
  End If
  Close 3

End Sub



Private Sub menu_loadwindowsstate_Click()
'! Menu choice - Load window state
  Dim v_s
  Dim C
  Dim rad As String
  Dim radnr As Integer
  Dim contr As String
  Dim ord1 As String
  Dim oldh As Integer
  
  If Dir(sesimpath & "\parameterdata\wstate.txt") = "" Then Exit Sub
  
  If init_done = 0 Then Call Initsesim

  contr = ""
  
  Open sesimpath & "\parameterdata\wstate.txt" For Input As #3
  Do While Not EOF(3)
    Line Input #3, rad
    ord1 = getword(rad, 1, ":")
    radnr = radnr + 1
    
    If rad = "monitor_univariate" Or _
       rad = "monitor_freq" Or _
       rad = "monitor_demographics" Or _
       rad = "monitor_kernel" Or _
       rad = "monitor_microdata" Or _
       rad = "monitor_demohist" _
       Then
         contr = rad
         radnr = 0
    End If
    
    If contr = "" And MDIForm1.WindowState = vbNormal Then
      If radnr = 1 Then MDIForm1.Top = CInt(rad)
      If radnr = 2 Then MDIForm1.Left = CInt(rad)
      If radnr = 3 Then MDIForm1.Width = CInt(rad)
      If radnr = 4 Then MDIForm1.Height = CInt(rad)
    End If
    
    If contr <> "" Then
      If radnr = 1 Then coll_view.Item(coll_view.count).Top = CInt(rad)
      If radnr = 2 Then coll_view.Item(coll_view.count).Left = CInt(rad)
      If radnr = 3 Then coll_view.Item(coll_view.count).Width = CInt(rad)
      If radnr = 4 Then coll_view.Item(coll_view.count).Height = CInt(rad)
    End If
    
    If contr = "monitor_univariate" Then
      If radnr = 0 Then Call controlcenter.cmdUnivar_Click
      If ord1 = "Combo1.text" Then coll_view.Item(coll_view.count).Combo1.text = getword(rad, 2, ":")
      If ord1 = "chkNotzero.value" Then coll_view.Item(coll_view.count).chkNotzero.value = CInt(getword(rad, 2, ":"))
      If ord1 = "chkPlot.value" Then
         coll_view.Item(coll_view.count).Height = coll_view.Item(coll_view.count).Height / 1.7
         coll_view.Item(coll_view.count).chkPlot.value = getword(rad, 2, ":")
      End If
    End If
    If contr = "monitor_kernel" Then
      If radnr = 0 Then Call controlcenter.cmdKernel_Click
      If ord1 = "Combo1.text" Then coll_view.Item(coll_view.count).Combo1.text = getword(rad, 2, ":")
    End If
    If contr = "monitor_microdata" Then
      If radnr = 0 Then Call controlcenter.cmdMicrodata_Click
    End If
    If contr = "monitor_freq" Then
      If radnr = 0 Then Call controlcenter.cmdFreq_Click
      If ord1 = "Combo1.text" Then coll_view.Item(coll_view.count).Combo1.text = getword(rad, 2, ":")
      If ord1 = "Combo2.text" Then coll_view.Item(coll_view.count).Combo2.text = getword(rad, 2, ":")
      If ord1 = "chkPlot.value" Then
         coll_view.Item(coll_view.count).Height = coll_view.Item(coll_view.count).Height / 1.7
         coll_view.Item(coll_view.count).chkPlot.value = getword(rad, 2, ":")
      End If
      'If ord1 = "chkPlot.value" Then
      '  oldh = coll_view.Item(coll_view.count).Height
      '  coll_view.Item(coll_view.count).chkPlot.Value = CInt(getword(rad, 2, ":"))
      '  coll_view.Item(coll_view.count).Height = oldh
      '  coll_view.Item(coll_view.count).chkPlot.Value = 0
      'End If
      'If ord1 = "chkSelect.value" Then coll_view.Item(coll_view.count).chkSelect.value = CInt(getword(rad, 2, ":"))
      If ord1 = "chkPercent.value" Then coll_view.Item(coll_view.count).chkPercent.value = CInt(getword(rad, 2, ":"))
    End If
    'If contr = "monitor_microdata" Then
    '  If radnr = 0 Then Call controlcenter.cmdMicrodata_Click
    '  If ord1 = "txtInr.text" Then coll_view.Item(coll_view.count).txtInr.text = getword(rad, 2, ":")
    '  If ord1 = "txtHHnr.text" Then coll_view.Item(coll_view.count).txtHHnr.text = getword(rad, 2, ":")
    'End If
    If contr = "monitor_demohist" Then
      If radnr = 0 Then Call controlcenter.cmdDemohist_Click
    End If
    If contr = "monitor_demographics" Then
      If radnr = 0 Then Call controlcenter.cmdDemo_Click
      If ord1 = "chkPlot.value" Then coll_view.Item(coll_view.count).chkPlot.value = CInt(getword(rad, 2, ":"))
    End If
    
    If ord1 = "exclude_tag" Then exclude_tag = getword(rad, 2, ":")
    If ord1 = "exclude_txt" Then exclude_txt = getword(rad, 2, ":")
    
    DoEvents
  Loop
  Close #3
  

  If exclude_tag = "" Then
    For Each v_s In coll_view
       If v_s.Tag <> "mdem" Then v_s.Text1.text = model_time
    Next
  Else
    For Each v_s In coll_view
      If v_s.Tag = exclude_tag Then v_s.Text1.text = model_time
    Next
  End If


End Sub





Private Sub menu_print_Click()
'! Menu choice - Print all windows

  ' print all monitors
  Dim v_s
  For Each v_s In coll_view
    v_s.PrintForm
  Next
  
End Sub




Private Sub menu_skrivtxt_Click()
'! Menu choice - Write data to be imported to SAS
  'Call write_data_txt
  status "Writing SAS-file..."
  Call write_sas_program
  status "SAS-file written"
End Sub

'**********************************************************************
' Shows a list of the variables that are available in SESIM along with
' their types and definitions.
'**********************************************************************

Private Sub menu_variables_Click()

  FrmVarList.Show
  
End Sub



Public Sub menu_writeaccess_Click()
'! Menu choice - Write data to be imported to MS Access
   Dim dbfil As String
   Dim ws As Workspace
   Dim db As Database
   Dim rs As Recordset
   Dim tb As TableDef
   Dim findnr0 As Field
   Dim findnr1 As Field
   Dim newf As Field
      
   
   dbfil = sesimpath & "\microdata\microdata.mdb"
   

   If Dir(dbfil) = "" Then
   
     status "Create MS-Access file"
     Set ws = DBEngine.Workspaces(0)
     Set db = ws.CreateDatabase(dbfil, dbLangGeneral, dbVersion30)
     Set tb = db.CreateTableDef("Individuals")
   
     Set findnr0 = tb.CreateField("dbnr", dbLong)
     findnr0.Attributes = dbAutoIncrField
     tb.Fields.Append findnr0

     Set findnr1 = tb.CreateField("year", dbLong)
     findnr1.DefaultValue = base_year + model_time
     tb.Fields.Append findnr1

     Set findnr1 = tb.CreateField("i_indnr", dbLong)
     findnr1.DefaultValue = 0
     tb.Fields.Append findnr1

     Set findnr1 = tb.CreateField("i_hhnr", dbLong)
     findnr1.DefaultValue = 0
     tb.Fields.Append findnr1

     Set findnr1 = tb.CreateField("i_next_indnr", dbLong)
     findnr1.DefaultValue = 0
     tb.Fields.Append findnr1


     Dim cv
     Dim txt_str As String
     For Each cv In vartype_coll
        If Left$(cv, 1) = "i" Then
          txt_str = LCase(getword(cv, 1, " "))   ' Variable name
          If txt_str <> "i_indnr" And _
             txt_str <> "i_hhnr" And _
             txt_str <> "i_next_indnr" Then
             txt_str = LCase(getword(cv, 2, " "))   ' Variable type
            Select Case txt_str
              Case "integer"
                Set findnr1 = tb.CreateField(getword(cv, 1, " "), dbInteger)
              Case "long"
                Set findnr1 = tb.CreateField(getword(cv, 1, " "), dbLong)
              Case "double"
                Set findnr1 = tb.CreateField(getword(cv, 1, " "), dbDouble)
              Case "single"
                Set findnr1 = tb.CreateField(getword(cv, 1, " "), dbSingle)
              Case "byte"
                Set findnr1 = tb.CreateField(getword(cv, 1, " "), dbByte)
            End Select
            findnr1.DefaultValue = 0
            tb.Fields.Append findnr1
          End If
        End If
     Next


     db.TableDefs.Append tb

     Dim indnr_idx As index

     Set indnr_idx = tb.CreateIndex("i_indnr")
     indnr_idx.Primary = True
     indnr_idx.Unique = False
     Set newf = indnr_idx.CreateField("i_indnr")
     indnr_idx.Fields.Append newf
     tb.Indexes.Append indnr_idx
  
     db.Close
     status "Access init done"

  End If

  status "Access writing data..."

  Dim write_method As Integer

  write_method = 1 '  write one record a time
  'write_method = 2 '  write one vector a time


  Dim i As Long
  Dim rest
  
  Set db = OpenDatabase(dbfil, dbForwardOnly & dbAppendOnly)

  If write_method = 1 Then
    Set rs = db.OpenRecordset("Individuals", dbOpenTable, dbAppendOnly)
    For i = 1 To m_icount
      
     ' ' Write only marked individuals, used when saving dead peoples last record
     ' If mark_i(i) = 1 Then
     '   rs.AddNew
     '   rs("year") = base_year + model_time
     '   Call write_accessdb(rs, i)
     '   rs.Update
     ' End If

      ' Write 1 individual of 30 to save time
      '***OS 010531 rest = i_indnr(i) Mod 30
      '***OS 010531 If i = 1 Or rest = 0 Then
        rs.AddNew
        rs("year") = base_year + model_time
        Call write_accessdb(rs, i)
        rs.Update
      '***OS 010531 End If
    Next
  End If


  If write_method = 2 Then
    Set rs = db.OpenRecordset("Individuals", dbOpenTable)
  
    Dim lastrow As Long

    Call prepare_temp("i_indnr")
    For i = 1 To m_icount
      rest = i Mod 1000
      If rest = 0 Then status CStr(i)
      rs.AddNew
      rs("i_indnr") = temp(i)
      rs.Update
    Next

    For Each cv In vartype_coll
       DoEvents
       txt_str = getword(cv, 1, " ")  ' variable name
       If Left$(cv, 1) = "i" And txt_str <> "i_indnr" Then
         status txt_str
         Call prepare_temp(txt_str)
         rs.MoveFirst

         lastrow = 1
         For i = 1 To m_icount
           If temp(i) <> 0 Then
             rs.Move i - lastrow
             lastrow = i
             rs.Edit
             rs(txt_str) = temp(i)
             rs.Update
           End If
         Next
       End If
     Next
  End If
        

 
  rs.Close
  db.Close

  status "Access write done"

   
End Sub



Private Sub menu_writebin_Click()
'! Menu choice - Write binary file
  Call Write_Data
End Sub




Private Sub MDIForm_Unload(Cancel As Integer)
'! Unloading
  End
  MsgBox "unload"
End Sub


'**********************************************************************
' Shows a list of runtime parameters or switches that are available in SESIM along with
' their definitions.
'**********************************************************************

Private Sub menu_runtime_Click()
    frmRuntimeparameters.Show
End Sub