VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form monitor_demographics 
   AutoRedraw      =   -1  'True
   Caption         =   "Demographics"
   ClientHeight    =   3855
   ClientLeft      =   60
   ClientTop       =   630
   ClientWidth     =   4650
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   3855
   ScaleWidth      =   4650
   Tag             =   "0"
   Visible         =   0   'False
   Begin VB.CheckBox chkPlot 
      Caption         =   "Plot"
      Height          =   195
      Left            =   60
      TabIndex        =   4
      ToolTipText     =   "Show miniplot (select column)"
      Top             =   60
      Width           =   795
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      Height          =   1275
      Left            =   840
      OLEDragMode     =   1  'Automatic
      OLEDropMode     =   2  'Automatic
      ScaleHeight     =   1215
      ScaleWidth      =   1335
      TabIndex        =   3
      Top             =   2160
      Width           =   1395
   End
   Begin VB.TextBox Text1 
      Height          =   315
      Left            =   3720
      TabIndex        =   1
      Top             =   1080
      Width           =   795
      Visible         =   0   'False
   End
   Begin ComctlLib.ListView lv1 
      Height          =   1755
      Left            =   0
      TabIndex        =   0
      Top             =   300
      Width           =   5235
      _ExtentX        =   9234
      _ExtentY        =   3096
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   327682
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.Label lblStat 
      Height          =   195
      Left            =   0
      TabIndex        =   2
      Top             =   1860
      Width           =   855
   End
   Begin VB.Menu menuClear 
      Caption         =   "&Clear"
   End
   Begin VB.Menu menucopytolog 
      Caption         =   "Copy to &editor"
   End
End
Attribute VB_Name = "monitor_demographics"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 1
Dim last_model_time As Integer



Private Sub Form_Load()
  
  Me.Height = 2550
  Me.Width = 4800

  lv1.Width = Me.Width - 200
  lv1.Height = (Me.Height - 300) - 400

  lv1.ColumnHeaders.Clear
  lv1.ColumnHeaders.add , , "Time", 300
  lv1.ColumnHeaders.add , , "Count", 550
  lv1.ColumnHeaders.add , , "Born", 500
  lv1.ColumnHeaders.add , , "Dead", 500
  lv1.ColumnHeaders.add , , "Migr", 500
  lv1.ColumnHeaders.add , , "Incr", 500
 
 
  lv1.ListItems.Clear
  
  Call stat_dem

End Sub

Private Sub Form_Resize() If WindowState = vbMinimized Then Exit Sub If chkPlot.Value = 0 Then Picture1.Visible = False lblStat.Visible = False lv1.Width = Me.Width - 200 lv1.Height = (Me.Height - 300) - 400 Else Picture1.Visible = True lblStat.Visible = True lv1.Width = maxi(200, Me.Width - 200) lv1.Height = maxi(200, Me.Height / 1.7 - 300 - 400) Picture1.Top = lv1.Top + lv1.Height + 100 lblStat.Top = Picture1.Top Picture1.Height = maxi(200, Me.Height - lv1.Top - lv1.Height - 600) Picture1.Width = Me.Width - Picture1.Left - 200 Call plotnew(0) End If End Sub
Private Sub chkPlot_Click() If chkPlot.Value = 1 Then Me.Height = Me.Height * 1.7 Else Me.Height = Me.Height / 1.7 End If End Sub
Private Sub Form_Terminate() ' MsgBox "term" End Sub
Private Sub Form_Unload(Cancel As Integer) coll_view.Remove "mdem" controlcenter.cmdDemo.enabled = True End Sub
Private Sub menuClear_Click() lv1.ListItems.Clear End Sub
Private Sub menuCopytolog_Click() Dim i As Integer Dim j As Integer Dim txt As String txt = frmEditor.rtbLog.text txt = txt + vbCrLf For i = 1 To lv1.ColumnHeaders.count txt = txt + fspace(lv1.ColumnHeaders(i), 10) Next txt = txt + vbCrLf For i = 1 To lv1.ListItems.count txt = txt + fspace(lv1.ListItems(i), 10) For j = 1 To lv1.ColumnHeaders.count - 1 txt = txt + fspace(lv1.ListItems.Item(i).SubItems(j), 10) Next txt = txt + vbCrLf Next frmEditor.rtbLog.text = txt ' Copy txt also to clipboard Clipboard.Clear Clipboard.SetText txt End Sub
Private Function fspace(txt, bredd) fspace = txt & Space(bredd - Len(txt)) End Function
Private Sub Text1_Change() If Text1.text = "Clear" Then Call menuClear_Click Exit Sub End If If model_time = last_model_time Then Exit Sub last_model_time = model_time Call stat_dem Call plotnew(0) End Sub
Private Sub stat_dem() Dim m Dim i As Long, counter(4) As Long Dim n As Integer Dim sum As Double, totalcount As Double totalcount = (m_icount - I_SUMVEC(i_abroad(1), UBound(i_abroad))) * m_weight Set m = lv1.ListItems.add() m.text = CStr(base_year + model_time) m.SubItems(1) = totalcount m.SubItems(2) = m_born m.SubItems(3) = m_dead m.SubItems(4) = m_netmigration m.SubItems(5) = (m_born - m_dead + m_netmigration) n = lv1.ListItems.count Set lv1.SelectedItem = lv1.ListItems(n) End Sub
Private Sub lv1_ColumnClick(ByVal ColumnHeader As ComctlLib.ColumnHeader) Dim i As Integer For i = 1 To lv1.ColumnHeaders.count If lv1.ColumnHeaders(i) = ColumnHeader Then Exit For Next If i > 1 Then Call plotnew(i) End If End Sub
Private Sub plotnew(colnr As Integer) Dim n As Integer, i As Integer Dim y() As Double, miny As Double, maxy As Double Static oldcolnr As Integer ' If no items - exit n = lv1.ListItems.count If n = 0 Then Exit Sub ' If colnr=0 - redraw If colnr = 0 And oldcolnr = 0 Then Exit Sub If colnr = 0 Then colnr = oldcolnr oldcolnr = colnr ' Fill plot-vector with values and compute max and min ReDim y(1 To n) maxy = -999999999 miny = 999999999 For i = 1 To n ' Exit if there are no values If IsNumeric(lv1.ListItems(i).SubItems(colnr - 1)) = False Then Exit Sub ' y(i) = CDbl(lv1.ListItems(i).SubItems(colnr - 1)) y(i) = val(lv1.ListItems(i).SubItems(colnr - 1)) If y(i) > maxy Then maxy = y(i) If y(i) < miny Then miny = y(i) Next miny = miny * 0.95 maxy = maxy * 1.05 If miny = maxy Then miny = miny - 1 maxy = maxy + 1 End If If n = 1 Then n = 2 ReDim Preserve y(1 To n) y(2) = y(1) End If ' Set scale for upper-left and lower-right Picture1.Cls Picture1.Scale (1, maxy)-(n, miny) For i = 2 To n Picture1.Line (i - 1, y(i - 1))-(i, y(i)), QBColor(0) Next lblStat.Caption = lv1.ColumnHeaders(colnr) End Sub