Exercise - Information Tracking

Design and develop an application that allows the user to enter (on a daily basis) some piece of information that is to be saved for future review and reference. Examples could be stock price, weight, or high temperature for the day. The input screen should display the current date and an input box for the desired information. all values should be saved on disk for future retrieval and update. A scroll bar should be available for reviewing all previously-stored values.


Properties:
Form frmWeight:
BorderStyle = 1 - Fixed Single
Caption = Weight Program
VScrollBar vsbControl:
Min = 1
Value = 1

TextBox txtWeight:
Alignment = 2 - Center
FontName = MS Sans Serif
FontSize = 13.5
Label lblFile:
BackColor = &H0000FFFF& (White)
BorderStyle = 1 - Fixed Single
Caption = New File
FontName = MS Sans Serif
FontBold = True
FontItalic = True
FontSize = 8.25
Label lblDate:
Alignment = 2 - Center
BackColor = &H00FFFFFF& (White)
BorderStyle = 1 - Fixed Single
FontName = MS Sans Serif
FontSize = 13.5
Label Label2:
Alignment = 2 - Center
Caption = Weight
FontName = MS Sans Serif
FontSize = 13.5
FontBold = True
Label Label1:
Alignment = 2 - Center
Caption = Date
FontName = MS Sans Serif
FontSize = 13.5
FontBold = True
CommonDialog cdlFiles:
CancelError = True
Menu mnuFile:
Caption = &File
Menu mnuFileNew:
Caption = &New

Menu mnuFileOpen:
Caption = &Open
Menu mnuFileSave:
Caption = &Save
Menu mnuLine:
Caption = -
Menu mnuFileExit:
Caption = E&xit
Code:
General Declarations:
Option Explicit
Dim Dates(1000) As Date
Dim Weights(1000) As String
Dim NumWts As Integer
Init General Procedure:
Sub Init()
NumWts = 1: vsbControl.Value = 1: vsbControl.Max = 1
Dates(1) = Format(Now, "mm/dd/yy")
Weights(1) = ""
lblDate.Caption = Dates(1)
txtWeight.Text = Weights(1)
lblFile.Caption = "New File"
End Sub
Form Load Event:
Private Sub Form_Load()
frmWeight.Show
Call Init
End Sub
mnufileExit Click Event:
Private Sub mnuFileExit_Click()
'Make sure user really wants to exit
Dim Response As Integer
Response = MsgBox("Are you sure you want to exit the weight program?", vbYesNo + vbCritical + vbDefaultButton2, "Exit Editor")
If Response = vbNo Then
Exit Sub
Else
End
End If
End Sub
mnuFileNew Click Event:
Private Sub mnuFileNew_Click()
'User wants new file
Dim Response As Integer
Response = MsgBox("Are you sure you want to start a new file?", vbYesNo + vbQuestion, "New File")
If Response = vbNo Then
Exit Sub
Else
Call Init
End If
End Sub
mnuFileOpen Click Event:
Private Sub mnuFileOpen_Click()
Dim I As Integer
Dim Today As Date
Dim Response As Integer
Response = MsgBox("Are you sure you want to open a new file?", vbYesNo + vbQuestion, "New File")
If Response = vbNo Then Exit Sub
cdlFiles.Filter = "Files (*.wgt)|*.wgt"
cdlFiles.DefaultExt = "wgt"
cdlFiles.DialogTitle = "Open File"
cdlFiles.Flags = cdlOFNFileMustExist + cdlOFNPathMustExist
On Error GoTo No_Open
cdlFiles.ShowOpen
Open cdlFiles.filename For Input As #1
lblFile.Caption = cdlFiles.filename
Input #1, NumWts
For I = 1 To NumWts
Input #1, Dates(I), Weights(I)
Next I
Close 1
Today = Format(Now, "mm/dd/yy")
If Today <> Dates(NumWts) Then
NumWts = NumWts + 1
Dates(NumWts) = Today
Weights(NumWts) = ""
End If
vsbControl.Max = NumWts
vsbControl.Value = NumWts
lblDate.Caption = Dates(NumWts)
txtWeight.Text = Weights(NumWts)
Exit Sub
No_Open:
Resume ExitLine
ExitLine:
Exit Sub
End Sub
mnuFileSave Click Event:
Private Sub mnuFileSave_Click()
Dim I As Integer
cdlFiles.Filter = "Files (*.wgt)|*.wgt"
cdlFiles.DefaultExt = "wgt"
cdlFiles.DialogTitle = "Save File"
cdlFiles.Flags = cdlOFNOverwritePrompt + cdlOFNPathMustExist
On Error GoTo No_Save
cdlFiles.ShowSave
Open cdlFiles.filename For Output As #1
lblFile.Caption = cdlFiles.filename
Write #1, NumWts
For I = 1 To NumWts
Write #1, Dates(I), Weights(I)
Next I
Close 1
Exit Sub
No_Save:
Resume ExitLine
ExitLine:
Exit Sub
End Sub
txtWeight Change Event:
Private Sub txtWeight_Change()
Weights(vsbControl.Value) = txtWeight.Text
End Sub
txtWeight KeyPress Event:
Private Sub txtWeight_KeyPress(KeyAscii As Integer)
If KeyAscii >= vbKey0 And KeyAscii <= vbKey9 Then
Exit Sub
Else
KeyAscii = 0
End If
End Sub
vsbControl Change Event:
Private Sub vsbControl_Change()
lblDate.Caption = Dates(vsbControl.Value)
txtWeight.Text = Weights(vsbControl.Value)
txtWeight.SetFocus
End Sub