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