VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frm_outputdata 
   Caption         =   "Output Data Management"
   ClientHeight    =   5940
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3945
   LinkTopic       =   "Form1"
   ScaleHeight     =   5940
   ScaleWidth      =   3945
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame Frame2 
      Caption         =   "Output File Name"
      Height          =   855
      Left            =   120
      TabIndex        =   10
      Top             =   5040
      Width           =   3735
      Begin VB.TextBox txt_OutputFileName 
         Enabled         =   0   'False
         Height          =   495
         Left            =   120
         MultiLine       =   -1  'True
         TabIndex        =   12
         Text            =   "frm_outputdata.frx":0000
         ToolTipText     =   "Note: only midsection of filename without filepath and extensions"
         Top             =   240
         Width           =   2295
      End
      Begin VB.CommandButton cmd_ChangeFileName 
         Caption         =   "Change File Name"
         Height          =   495
         Left            =   2520
         TabIndex        =   11
         ToolTipText     =   "Note: only midsection of filename without filepath and extensions"
         Top             =   240
         Width           =   1095
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "Filetype"
      Height          =   855
      Left            =   2640
      TabIndex        =   7
      Top             =   3480
      Width           =   1215
      Begin VB.OptionButton opt_binary 
         Caption         =   "BINARY"
         Height          =   255
         Left            =   120
         TabIndex        =   9
         Top             =   480
         Width           =   960
      End
      Begin VB.OptionButton opt_ascii 
         Caption         =   "ASCII"
         Height          =   255
         Left            =   120
         TabIndex        =   8
         Top             =   240
         Value           =   -1  'True
         Width           =   840
      End
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   3240
      Top             =   4320
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmd_SaveList 
      Caption         =   "Save List"
      Height          =   375
      Left            =   2760
      TabIndex        =   6
      ToolTipText     =   "Saves a list of variables to file"
      Top             =   1800
      Width           =   975
   End
   Begin VB.CommandButton cmd_LoadList 
      Caption         =   "Load List"
      Height          =   375
      Left            =   2760
      TabIndex        =   5
      ToolTipText     =   "Loads a list of variables from file"
      Top             =   1320
      Width           =   975
   End
   Begin VB.CommandButton cmd_Cancel 
      Caption         =   "Cancel"
      Height          =   375
      Left            =   2760
      TabIndex        =   4
      ToolTipText     =   "No output data is written"
      Top             =   3000
      Width           =   975
   End
   Begin VB.CommandButton cmd_mark 
      Caption         =   "Mark All"
      Height          =   375
      Left            =   2760
      TabIndex        =   3
      ToolTipText     =   "Marks all items in the listbox"
      Top             =   600
      Width           =   975
   End
   Begin VB.CommandButton cmd_WriteData 
      Caption         =   "Write Data"
      Height          =   375
      Left            =   2760
      TabIndex        =   2
      ToolTipText     =   "Output data is written immediately and after each year"
      Top             =   2520
      Width           =   975
   End
   Begin VB.CommandButton cmd_unmark 
      Caption         =   "Unmark All"
      Height          =   375
      Left            =   2760
      TabIndex        =   1
      ToolTipText     =   "Unmarks all items in the listbox"
      Top             =   120
      Width           =   975
   End
   Begin VB.ListBox lst_varnames 
      Height          =   4740
      Left            =   120
      MultiSelect     =   1  'Simple
      TabIndex        =   0
      Top             =   120
      Width           =   2415
   End
End
Attribute VB_Name = "frm_outputdata"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Base 1
Option Explicit

'*** Writing output data is NOT activated when clicking the cancel button!!

Private Sub cmd_Cancel_Click()

  frm_outputdata.Hide
  OutputData.OutputActive = False

End Sub

Private Sub cmd_ChangeFileName_Click() Dim filename As String Dim validname As Integer validname = 0 Do filename = InputBox("Input new filename:") If Len(filename) > 0 And InStr(filename, " ") = 0 Then validname = 1 Else MsgBox ("Error: filenames has to have length >= 1 and cannot contain blanks!") End If Loop While validname = 0 frm_outputdata.txt_OutputFileName = filename OutputData.filename = filename End Sub
'*** Load variable list from file
Private Sub cmd_LoadList_Click() Dim counter As Integer, i As Integer, filenr As Integer Dim filename As String, x() As String CommonDialog1.Filter = "SESIM Variable List (*.Vlst)|*.Vlst" CommonDialog1.InitDir = sesimpath & "\parameterdata" CommonDialog1.ShowOpen filename = CommonDialog1.filename If CommonDialog1.filename <> "" Then filenr = FreeFile Open CommonDialog1.filename For Binary As filenr Get #filenr, , OutputData Close filenr '*** Update listbox For counter = 0 To lst_varnames.ListCount - 1 lst_varnames.Selected(counter) = False Select Case Left(lst_varnames.List(counter), 2) Case "i_" For i = 1 To UBound(OutputData.VarList_i) If OutputData.VarList_i(i) = lst_varnames.List(counter) Then lst_varnames.Selected(counter) = True Exit For End If Next Case "h_" For i = 1 To UBound(OutputData.VarList_h) If OutputData.VarList_h(i) = lst_varnames.List(counter) Then lst_varnames.Selected(counter) = True Exit For End If Next Case "m_" For i = 1 To UBound(OutputData.VarList_m) If OutputData.VarList_m(i) = lst_varnames.List(counter) Then lst_varnames.Selected(counter) = True Exit For End If Next End Select Next '*** Change file type selection If OutputData.filetype = 1 Then opt_ascii = True opt_binary = False Else opt_binary = True opt_ascii = False End If '*** Set filename OutputData.filename = frm_outputdata.txt_OutputFileName End If End Sub
'*** Mark all items in the listbox
Private Sub cmd_mark_Click() Dim counter As Integer lst_varnames.Visible = False For counter = 0 To lst_varnames.ListCount - 1 lst_varnames.Selected(counter) = True Next lst_varnames.Visible = True lst_varnames.ListIndex = 0 End Sub
'*** Saves the OutputData type to file
Private Sub cmd_SaveList_Click() '*** First the OutputData type has to be updated with the selected '*** variables from the listbox Call UpdateOutputDataType CommonDialog1.Filter = "SESIM Variable List (*.Vlst)|*.Vlst" CommonDialog1.InitDir = sesimpath & "\parameterdata" CommonDialog1.ShowSave If CommonDialog1.filename <> "" Then Dim filenr As Integer filenr = FreeFile Open CommonDialog1.filename For Binary As filenr Put #filenr, , OutputData Close filenr End If End Sub
'*** Unmark all items in the listbox
Private Sub cmd_unmark_Click() Dim counter As Integer For counter = 0 To lst_varnames.ListCount - 1 lst_varnames.Selected(counter) = False Next End Sub
'*** On clicking Write Data the form is closed and the OutputData type is activated. '*** Data for the current year is written to file directly. Data for later years is '*** written after the simulation of each year.
Private Sub cmd_writedata_Click() '*** First the OutputData type has to be updated with the selections in the '*** listbox. Call UpdateOutputDataType frm_outputdata.Hide OutputData.OutputActive = True Call Write_Output_Data '*** Disable the controlcenter calling button controlcenter.cmd_OutputData.enabled = False End Sub
'*** On loading, the listbox is populated with all global SESIM variables. All variables are '*** selected.
Private Sub Form_Load() Dim cv As Variant Dim typ As String, filename As String Dim nr As Integer, counter As Integer, i As Integer lst_varnames.Clear ' Display all variables. nr = 0 For Each cv In var_coll lst_varnames.AddItem cv lst_varnames.Selected(nr) = True nr = nr + 1 Next For Each cv In mvar_coll lst_varnames.AddItem cv lst_varnames.Selected(nr) = True nr = nr + 1 Next lst_varnames.ListIndex = 0 ' Create default filename OutputData.filename = Mid(Date, 3, 2) & Mid(Date, 6, 2) & Right(Date, 2) & "_" & _ Left(Time, 2) & Mid(Time, 4, 2) & Right(Time, 2) frm_outputdata.txt_OutputFileName = OutputData.filename End Sub
'*** The routine populates the variable lists in type Outputdata with all '*** selected items in the listbox.
Public Sub UpdateOutputDataType() Dim counter_i As Integer, counter_h As Integer, counter_m As Integer Dim counter As Integer ReDim OutputData.VarList_i(1 To lst_varnames.ListCount) ReDim OutputData.VarList_h(1 To lst_varnames.ListCount) ReDim OutputData.VarList_m(1 To lst_varnames.ListCount) counter_i = 0 counter_h = 0 counter_m = 0 ' Loop through listbox For counter = 0 To lst_varnames.ListCount - 1 ' If variable marked... If lst_varnames.Selected(counter) = True Then Select Case Left(lst_varnames.List(counter), 2) Case "i_" counter_i = counter_i + 1 OutputData.VarList_i(counter_i) = lst_varnames.List(counter) Case "h_" counter_h = counter_h + 1 OutputData.VarList_h(counter_h) = lst_varnames.List(counter) Case "m_" counter_m = counter_m + 1 OutputData.VarList_m(counter_m) = lst_varnames.List(counter) End Select End If Next ReDim Preserve OutputData.VarList_i(1 To maxi(1, counter_i)) ReDim Preserve OutputData.VarList_h(1 To maxi(1, counter_h)) ReDim Preserve OutputData.VarList_m(1 To maxi(1, counter_m)) End Sub
Private Sub opt_ascii_Click() OutputData.filetype = 1 opt_binary = False End Sub
Private Sub opt_binary_Click() OutputData.filetype = 2 opt_ascii = False MsgBox "Note that when writing to binary data ALL observations are written to file, " & _ vbCrLf & "not just the ones selected for analysis!", , "About selections and filetypes" End Sub