VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form monitor_microdata 
   Caption         =   "Micro data"
   ClientHeight    =   6030
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7530
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   6030
   ScaleWidth      =   7530
   Begin VB.CheckBox chkLogheaderh 
      Caption         =   "Log header"
      Height          =   255
      Left            =   2520
      TabIndex        =   21
      Top             =   4680
      Width           =   1155
   End
   Begin VB.CheckBox chkLogh 
      Caption         =   "Log"
      Height          =   255
      Left            =   1260
      TabIndex        =   20
      Top             =   4680
      Width           =   1155
   End
   Begin VB.CommandButton cmdLognowi 
      Caption         =   "Log now"
      Height          =   255
      Left            =   4980
      TabIndex        =   19
      Top             =   2340
      Width           =   1035
   End
   Begin VB.CheckBox chkLogheader 
      Caption         =   "Log header"
      Height          =   255
      Left            =   3720
      TabIndex        =   18
      Top             =   2340
      Width           =   1155
   End
   Begin VB.CheckBox chkLogseli 
      Caption         =   "Log sel ind"
      Enabled         =   0   'False
      Height          =   255
      Left            =   2460
      TabIndex        =   17
      Top             =   2340
      Width           =   1155
   End
   Begin VB.CheckBox chkLogalli 
      Caption         =   "Log all ind"
      Height          =   255
      Left            =   1260
      TabIndex        =   16
      Top             =   2340
      Width           =   1155
   End
   Begin VB.TextBox txtInr 
      Height          =   285
      Left            =   3480
      TabIndex        =   14
      Top             =   1140
      Width           =   735
   End
   Begin VB.ListBox LstHh 
      Height          =   1425
      Left            =   1380
      TabIndex        =   7
      Top             =   600
      Width           =   1215
   End
   Begin VB.ListBox lstInd 
      Height          =   1425
      Left            =   60
      TabIndex        =   6
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton cmdSelvar 
      Caption         =   "Select variables"
      Height          =   315
      Left            =   4980
      TabIndex        =   5
      Top             =   120
      Width           =   1515
   End
   Begin VB.ListBox List1 
      Height          =   1815
      Left            =   4980
      MultiSelect     =   1  'Simple
      TabIndex        =   4
      Top             =   540
      Width           =   1935
      Visible         =   0   'False
   End
   Begin VB.TextBox txtHHnr 
      Height          =   285
      Left            =   3480
      TabIndex        =   2
      Top             =   780
      Width           =   735
   End
   Begin VB.TextBox Text1 
      Height          =   255
      Left            =   7380
      TabIndex        =   1
      Top             =   240
      Width           =   495
      Visible         =   0   'False
   End
   Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1 
      Height          =   1935
      Left            =   60
      TabIndex        =   0
      Top             =   2640
      Width           =   6885
      _ExtentX        =   12144
      _ExtentY        =   3413
      _Version        =   393216
      Rows            =   100
      AllowUserResizing=   1
   End
   Begin MSFlexGridLib.MSFlexGrid MSFlexGrid2 
      Height          =   735
      Left            =   120
      TabIndex        =   8
      Top             =   4980
      Width           =   6885
      _ExtentX        =   12144
      _ExtentY        =   1296
      _Version        =   393216
      Rows            =   100
      AllowUserResizing=   1
   End
   Begin VB.Label Label6 
      Caption         =   "Sel indnr"
      Height          =   195
      Left            =   2760
      TabIndex        =   15
      Top             =   1200
      Width           =   615
   End
   Begin VB.Label Label5 
      Caption         =   "Household"
      Height          =   195
      Left            =   120
      TabIndex        =   13
      Top             =   4740
      Width           =   1035
   End
   Begin VB.Label Label4 
      Caption         =   "Individuals"
      Height          =   195
      Left            =   120
      TabIndex        =   12
      Top             =   2340
      Width           =   1035
   End
   Begin VB.Label Label1 
      ForeColor       =   &H0000FFFF&
      Height          =   195
      Left            =   60
      TabIndex        =   11
      Top             =   60
      Width           =   2535
   End
   Begin VB.Label Label3 
      Caption         =   "Household nr"
      Height          =   195
      Left            =   1440
      TabIndex        =   10
      Top             =   360
      Width           =   975
   End
   Begin VB.Label Label2 
      Caption         =   "Individual nr"
      Height          =   195
      Left            =   120
      TabIndex        =   9
      Top             =   360
      Width           =   975
   End
   Begin VB.Label lblselhhnr 
      Caption         =   "Sel hhnr"
      Height          =   195
      Left            =   2760
      TabIndex        =   3
      Top             =   840
      Width           =   615
   End
End
Attribute VB_Name = "monitor_microdata"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 1

Dim iflag As Integer
Dim sel_hhnr As Long, sel_inr As Long, maxrows As Long
Dim vnames(100) As String
Dim vvalues(100) As Variant
Dim mcolwidth(0 To 50) As Integer



Private Sub Form_Load()
  Me.Height = 6435
  Me.Width = 7290
  
  Me.Show
  Me.Refresh
     
  Call load_list
  Call updatenumbers

  maxrows = UBound(indnr2index)
  sel_hhnr = 0
  sel_inr = 0
  
  txtHHnr.text = h_hhnr(1)
  txtInr.text = ""
  
  maxrows = 1000
  
End Sub

Private Sub MSFlexGrid1_Click() ' r = MSFlexGrid1.Row MSFlexGrid1.Col = 1 txtInr.text = MSFlexGrid1.text End Sub
Private Sub Text1_Change() 'If chkauto = 1 Then Call updatenumbers Dim tmp If txtInr.text <> "" Then tmp = txtInr.text txtInr.enabled = False txtInr.text = "" txtInr.enabled = True txtInr.text = tmp iflag = 1 Call txtHHnr_Change iflag = 0 Call cmdLognowi_Click Exit Sub End If If txtHHnr.text <> "" Then Call txtHHnr_Change Call cmdLognowi_Click Exit Sub End If Call updatenow 'End If End Sub
Private Sub updatenow() Dim i As Integer For i = 0 To MSFlexGrid1.Cols - 1 mcolwidth(i) = MSFlexGrid1.ColWidth(i) Next show_i show_h 'Call Copytoeditor End Sub
Private Sub cmdSelvar_Click() If cmdSelvar.Caption = "Select variables" Then cmdSelvar.Caption = "Close" List1.Visible = True Else cmdSelvar.Caption = "Select variables" List1.Visible = False If sel_hhnr > 0 Then Call updatenow End If End Sub
Private Sub load_list() Dim cv Dim typ As String Dim nr As Integer List1.Clear nr = 0 For Each cv In var_coll List1.AddItem cv If List1.List(nr) = "i_indnr" Or _ List1.List(nr) = "i_hhnr" Or _ List1.List(nr) = "i_age" Or _ List1.List(nr) = "i_sex" Or _ List1.List(nr) = "i_inc_taxable" Or _ List1.List(nr) = "i_status" Or _ List1.List(nr) = "h_hhnr" Or _ List1.List(nr) = "h_n_adults" Or _ List1.List(nr) = "h_n_child" Or _ List1.List(nr) = "h_hhnr" Or _ List1.List(nr) = "h_size" Or _ List1.List(nr) = "h_first_indnr" Then List1.Selected(nr) = True End If nr = nr + 1 Next End Sub
Private Sub txtHHnr_Change() Dim hnr As Long sel_hhnr = 0 If iflag = 0 Then sel_inr = 0 txtInr.enabled = False txtInr.text = "" txtInr.enabled = True Call unselect_i End If If txtHHnr.text = "" Then If LstHh.ListIndex >= 0 Then LstHh.enabled = False LstHh.Selected(LstHh.ListIndex) = False LstHh.enabled = True End If MSFlexGrid1.Rows = 1 MSFlexGrid2.Rows = 1 Exit Sub End If hnr = val(txtHHnr.text) If hnr <= 0 Or hnr > UBound(hhnr2index) Then If LstHh.ListIndex >= 0 Then LstHh.enabled = False LstHh.Selected(LstHh.ListIndex) = False LstHh.enabled = True End If MSFlexGrid1.Rows = 1 MSFlexGrid2.Rows = 1 Exit Sub End If If hhnr2index(hnr) = 0 Then Beep If LstHh.ListIndex >= 0 Then LstHh.enabled = False LstHh.Selected(LstHh.ListIndex) = False LstHh.enabled = True End If MSFlexGrid1.Rows = 1 MSFlexGrid2.Rows = 1 Exit Sub End If sel_hhnr = hnr LstHh.enabled = False LstHh.Selected(hhnr2index(sel_hhnr) - 1) = True LstHh.enabled = True Call updatenow End Sub
Private Sub LstHh_Click() Dim hi As Long, hnr As Long, i As Long If LstHh.enabled = False Then Exit Sub hi = LstHh.ListIndex hnr = LstHh.List(hi) txtHHnr.text = hnr LstHh.SetFocus End Sub
Private Sub txtInr_Change() Dim inr As Long If txtInr.enabled = False Then Exit Sub chkLogseli.enabled = False sel_inr = 0 If txtInr.text = "" Then If lstInd.ListIndex >= 0 Then lstInd.enabled = False lstInd.Selected(lstInd.ListIndex) = False lstInd.enabled = True End If iflag = 1 txtHHnr.text = "" iflag = 0 Exit Sub End If inr = val(txtInr.text) If inr <= 0 Or inr > UBound(indnr2index) Then If lstInd.ListIndex >= 0 Then lstInd.enabled = False lstInd.Selected(lstInd.ListIndex) = False lstInd.enabled = True End If iflag = 1 txtHHnr.text = "" iflag = 0 Exit Sub End If If indnr2index(inr) = 0 Then Beep If lstInd.ListIndex >= 0 Then lstInd.enabled = False lstInd.Selected(lstInd.ListIndex) = False lstInd.enabled = True End If iflag = 1 txtHHnr.text = "" iflag = 0 Exit Sub End If sel_inr = inr chkLogseli.enabled = True iflag = 1 txtHHnr.text = i_hhnr(indnr2index(sel_inr)) iflag = 0 Call yellow_i End Sub
Private Sub lstInd_Click() Dim ii As Long, hnr As Long, inr As Long, i As Long If lstInd.enabled = False Then Exit Sub ii = lstInd.ListIndex If ii < 0 Then Exit Sub inr = lstInd.List(ii) txtInr.text = inr End Sub
Private Sub unselect_i() Dim ii As Long ii = lstInd.ListIndex lstInd.enabled = False If ii >= 0 Then lstInd.Selected(ii) = False lstInd.enabled = True End Sub
Private Sub show_i() Dim i As Long, j As Long, n_variabler As Long, nrader As Long, utrader As Long Dim k As Integer Dim txt As String n_variabler = 1 txt = "Index" n_variabler = n_variabler + 1 txt = txt & "|i_indnr" vnames(n_variabler - 1) = "i_indnr" n_variabler = n_variabler + 1 txt = txt & "|i_hhnr" vnames(n_variabler - 1) = "i_hhnr" For i = 1 To List1.ListCount If List1.Selected(i - 1) = True And Left(List1.List(i - 1), 1) = "i" Then If List1.List(i - 1) <> "i_indnr" And List1.List(i - 1) <> "i_hhnr" Then n_variabler = n_variabler + 1 txt = txt & "|" & List1.List(i - 1) vnames(n_variabler - 1) = List1.List(i - 1) End If End If Next MSFlexGrid1.FormatString = txt MSFlexGrid1.Cols = n_variabler j = n_variabler Dim for_to As Long for_to = mini(m_icount, maxrows) If sel_hhnr > 0 Then for_to = m_icount For i = 1 To for_to If sel_hhnr = 0 Or sel_hhnr = i_hhnr(i) Then utrader = utrader + 1 If utrader + 1 > nrader Then MSFlexGrid1.Rows = utrader + 1 ' Fetch values for selected variables Call getvalues(n_variabler - 1, vnames(), vvalues(), i) For k = 1 To n_variabler - 1 If vvalues(k) > 1000 Then vvalues(k) = round(vvalues(k), 1) Next MSFlexGrid1.enabled = False With MSFlexGrid1 .TextArray(j) = i For k = 1 To n_variabler - 1 .TextArray(j + k) = vvalues(k) Next End With MSFlexGrid1.enabled = True j = j + n_variabler End If Next For i = 0 To MSFlexGrid1.Cols - 1 If mcolwidth(i) > 0 Then MSFlexGrid1.ColWidth(i) = mcolwidth(i) Next If sel_hhnr > 0 Then MSFlexGrid1.Rows = utrader + 1 If sel_inr > 0 Then Call yellow_i End Sub
Private Sub show_h() Dim i As Long, j As Long, n_variabler As Long, nrader As Long, utrader As Long Dim k As Integer If txtHHnr.text = "" Then Exit Sub Dim txt As String n_variabler = 1 txt = "Index" n_variabler = n_variabler + 1 txt = txt & "|h_hhnr" vnames(n_variabler - 1) = "h_hhnr" For i = 1 To List1.ListCount If List1.Selected(i - 1) = True And Left(List1.List(i - 1), 1) = "h" Then If List1.List(i - 1) <> "h_hhnr" Then n_variabler = n_variabler + 1 txt = txt & "|" & List1.List(i - 1) vnames(n_variabler - 1) = List1.List(i - 1) End If End If Next MSFlexGrid2.FormatString = txt MSFlexGrid2.Cols = n_variabler j = n_variabler Dim for_to As Long for_to = mini(m_hcount, maxrows) If sel_hhnr > 0 Then for_to = m_hcount For i = 1 To for_to If sel_hhnr = 0 Or sel_hhnr = h_hhnr(i) Then utrader = utrader + 1 If utrader + 1 > nrader Then MSFlexGrid2.Rows = utrader + 1 ' Fetch values for selected variables Call getvalues(n_variabler - 1, vnames(), vvalues(), i) For k = 1 To n_variabler - 1 If vvalues(k) > 1000 Then vvalues(k) = round(vvalues(k), 1) Next MSFlexGrid2.enabled = False With MSFlexGrid2 .TextArray(j) = i For k = 1 To n_variabler - 1 .TextArray(j + k) = vvalues(k) Next End With MSFlexGrid2.enabled = True j = j + n_variabler End If Next For i = 0 To MSFlexGrid2.Cols - 1 If mcolwidth(i) > 0 Then MSFlexGrid2.ColWidth(i) = mcolwidth(i) Next If sel_hhnr > 0 Then MSFlexGrid2.Rows = utrader + 1 End Sub
Private Sub updatenumbers() Dim i As Long Label1.Caption = "Checking individuals" Label1.Refresh lstInd.Visible = False lstInd.Clear For i = 1 To m_icount lstInd.AddItem i_indnr(i) Next lstInd.Visible = True Label1.Caption = "" Label1.Refresh lstInd.Refresh Label1.Caption = "Checking households" Label1.Refresh LstHh.Visible = False LstHh.Clear For i = 1 To m_hcount LstHh.AddItem h_hhnr(i) Next LstHh.Visible = True Label1.Caption = "" Label1.Refresh LstHh.Refresh If txtHHnr.text <> "" Then If hhnr2index(txtHHnr.text) = 0 Then Exit Sub ' Mark household LstHh.Selected(hhnr2index(txtHHnr.text) - 1) = True End If End Sub
Private Sub Copytoeditor() Dim i As Integer, j As Integer Dim txt As String txt = "" ' Individuals ' text headers If chkLogheader.value = 1 Then 'chkLogheader.value = 0 For i = 0 To MSFlexGrid1.Cols - 1 MSFlexGrid1.Row = 0 MSFlexGrid1.Col = i If i = 0 Then txt = txt + "Year " + fspace(MSFlexGrid1.text, 10) Else txt = txt + fspace(MSFlexGrid1.text, 10) End If Next txt = txt + vbCrLf End If ' data If chkLogalli.value = 1 Or chkLogseli.value = 1 Then For j = 1 To MSFlexGrid1.Rows - 1 MSFlexGrid1.Row = j If chkLogalli.value = 1 Then For i = 0 To MSFlexGrid1.Cols - 1 MSFlexGrid1.Col = i If i = 0 Then txt = txt + LTrim(str(model_time + base_year)) + " " + fspace(MSFlexGrid1.text, 10) Else txt = txt + fspace(MSFlexGrid1.text, 10) End If Next txt = txt + vbCrLf End If If chkLogseli.value = 1 Then MSFlexGrid1.Col = 1 If val(MSFlexGrid1.text) = sel_inr Then For i = 0 To MSFlexGrid1.Cols - 1 MSFlexGrid1.Col = i If i = 0 Then txt = txt + LTrim(str(model_time + base_year)) + " " + fspace(MSFlexGrid1.text, 10) Else txt = txt + fspace(MSFlexGrid1.text, 10) End If Next txt = txt + vbCrLf End If End If Next End If ' Households ' text headers If chkLogheaderh.value = 1 Then 'chkLogheaderh.value = 0 For i = 0 To MSFlexGrid2.Cols - 1 MSFlexGrid2.Row = 0 MSFlexGrid2.Col = i If i = 0 Then txt = txt + "Year " + fspace(MSFlexGrid2.text, 10) Else txt = txt + fspace(MSFlexGrid2.text, 10) End If Next txt = txt + vbCrLf End If ' data If chkLogh.value = 1 Then For i = 0 To MSFlexGrid2.Cols - 1 MSFlexGrid2.Row = 1 MSFlexGrid2.Col = i If i = 0 Then txt = txt + "Year " + fspace(MSFlexGrid2.text, 10) Else txt = txt + fspace(MSFlexGrid2.text, 10) End If Next txt = txt + vbCrLf End If frmEditor.rtbLog.text = frmEditor.rtbLog.text & txt frmEditor.rtbLog.SelStart = Len(frmEditor.rtbLog.text) End Sub
Private Sub Form_Resize() If Me.Width > 1000 Then MSFlexGrid1.Width = Me.Width - 200 If Me.Width > 1000 Then MSFlexGrid2.Width = Me.Width - 200 End Sub
Private Sub Form_Unload(Cancel As Integer) coll_view.Remove Me.Tag End Sub
Private Sub yellow_i() Dim i As Integer, j As Integer If sel_inr > 0 Then For i = 1 To MSFlexGrid1.Rows - 1 MSFlexGrid1.Row = i MSFlexGrid1.Col = 1 If MSFlexGrid1.text = sel_inr Then For j = 0 To MSFlexGrid1.Cols - 1 MSFlexGrid1.Col = j MSFlexGrid1.CellBackColor = QBColor(14) Next Else MSFlexGrid1.Col = 0 MSFlexGrid1.CellBackColor = &H8000000F For j = 1 To MSFlexGrid1.Cols - 1 MSFlexGrid1.Col = j MSFlexGrid1.CellBackColor = QBColor(15) Next End If Next End If End Sub
Private Sub chkLogalli_Click() If chkLogalli.value = 1 Then chkLogseli.value = 0 End If End Sub
Private Sub chkLogseli_Click() If chkLogseli.value = 1 Then chkLogalli.value = 0 End If End Sub
Private Sub cmdLognowi_Click() Call Copytoeditor End Sub