Public Class Form1
Dim xpos As Integer
Dim ypos As Integer
Dim i As Integer
Dim tempTotal As Double
Dim dblTempTotal As Double
Dim dblSum As Double
Dim dblGrandTotal As Double
Dim Printer As PrintDialog
Const MAXNAMES As Integer = 50
Structure ItemInfo
Dim Name As String
Dim Price As Double
Dim Quantity As Double
End Structure
Dim Items(MAXNAMES) As ItemInfo
Dim intNmbrOfItems As Integer
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Call InitItemEntry()
End Sub
Private Sub InitItemEntry()
intNmbrOfItems = 0
dblSum = 0
dblGrandTotal = 0
End Sub
Private Sub txtItemPrice_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles txtItemPrice.KeyPress
Dim dblTemp As Double
If (Asc(e.KeyChar) = 13) Then
' It means an "<enter>" key was pressed
dblTemp = AcceptEntry(txtItemName.Text, txtItemPrice.Text, txtQuantity.Text, dblTempTotal)
If (dblTemp >= 0) Then
intNmbrOfItems = intNmbrOfItems + 1
dblSum = dblSum + dblTemp
End If
End If
End Sub
Private Sub txtQuantity_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtQuantity.TextChanged
Dim intLength As Integer
intLength = txtQuantity.Text.Length
If (intLength > 0) Then
If (Asc(txtQuantity.Text.ToLower.Substring(intLength - 1, 1)) < Asc("0") _
Or Asc(txtQuantity.Text.ToLower.Substring(intLength - 1, 1)) > Asc("9")) Then
' The character is bad
txtQuantity.Text = txtQuantity.Text.Substring(0, intLength - 1)
txtQuantity.SelectionStart = txtQuantity.Text.Length
End If
End If
End Sub
Private Sub txtItemPrice_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtItemPrice.TextChanged
Dim intLength As Integer
intLength = txtItemPrice.Text.Length
If (intLength > 0) Then
If (Asc(txtItemPrice.Text.ToLower.Substring(intLength - 1, 1)) < Asc("0") _
Or Asc(txtItemPrice.Text.ToLower.Substring(intLength - 1, 1)) > Asc("9")) Then
If (Asc(txtItemPrice.Text.ToLower.Substring(intLength - 1, 1)) <> Asc(".")) Then
' The character is bad
txtItemPrice.Text = txtItemPrice.Text.Substring(0, intLength - 1)
txtItemPrice.SelectionStart = txtItemPrice.Text.Length
End If
End If
End If
End Sub
Private Sub txtItemName_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtItemName.TextChanged
Dim intLength As Integer
intLength = txtItemName.Text.Length
If (intLength > 0) Then
If (Not (Asc(txtItemName.Text.ToLower.Substring(intLength - 1, 1)) >= Asc("a") _
And Asc(txtItemName.Text.ToLower.Substring(intLength - 1, 1)) <= Asc("z"))) Then
' The character is bad
txtItemName.Text = txtItemName.Text.Substring(0, intLength - 1)
txtItemName.SelectionStart = txtItemName.Text.Length
End If
End If
End Sub
Private Sub btnAcceptEntry_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
Handles btnAcceptEntry.Click
'Dim strFMT1 As String = "{0, -25} {1, 10:C2}"
AcceptEntry(txtItemName.Text, txtItemPrice.Text, txtQuantity.Text, dblTempTotal)
Return
End Sub
Private Function AcceptEntry(ByRef Name As String, ByRef Price As String, ByRef Quantity As String, ByRef Total As Double) As Double
Dim strTemp As String
Dim strFMT1 As String = "{0, -25} $"
Dim sngThisGrade As Single = -1
Total = dblTempTotal
If (Name.Length > 0 And Price.Length > 0 And Quantity.Length > 0) Then
' I have both entries
strTemp = String.Format(strFMT1, Name)
Total = Price * Quantity
lstBoxItemsOrdered.Items.Add(strTemp & Total)
Name = ""
Price = ""
Quantity = ""
Else
' One or both entries are empty
If (Name.Length <= 0) Then
MsgBox("Enter product name")
End If
If (Price.Length <= 0) Then
MsgBox("Enter price")
End If
If (Quantity.Length <= 0) Then
MsgBox("Enter a quantity")
End If
End If
End Function
Dim SaveFileDesc As IO.StreamWriter
Dim SaveFileOpenFlag As Boolean = False
Dim SaveFileName As String = ""
Dim ReadFileDesc As IO.StreamReader
Dim ReadFileOpenFlag As Boolean = False
Dim ReadFileName As String = ""
Private Sub btnSave_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles btnSave.Click
Dim OpenFileDesc As IO.StreamReader
Dim answer As String
If (SaveFileOpenFlag = False) Then
SaveFileDialog1.ShowDialog()
If (SaveFileDialog1.FileName <> "") Then
' Name provided
SaveFileName = SaveFileDialog1.FileName
If (Not (IO.File.Exists(SaveFileDialog1.FileName))) Then
' New file: can save immediately
SaveIt(SaveFileDesc, SaveFileOpenFlag, SaveFileName, _
btnSave, lstBoxItemsOrdered)
Else
' File exists - Does it have data?
OpenFileDesc = IO.File.OpenText(SaveFileName)
If (OpenFileDesc.Peek <> -1) Then
' File has data
OpenFileDesc.Close()
answer = InputBox( _
"File Exists: Overite, Append, or Cancel [O|A|C]", _
"Resolution of File", "C")
Select Case answer
Case "c", "C"
SaveFileName = ""
Return
Case "a", "A"
SaveFileDesc = IO.File.AppendText(SaveFileName)
SaveFileOpenFlag = True
btnSave.Text = SaveFileName
SaveItems(lstBoxItemsOrdered, SaveFileDesc)
Case "o", "O"
SaveIt(SaveFileDesc, SaveFileOpenFlag, SaveFileName, _
btnSave, lstBoxItemsOrdered)
Case Else
MsgBox("Internal Error #1 in btnSave()")
End Select
Else
' File is empty
OpenFileDesc.Close()
SaveIt(SaveFileDesc, SaveFileOpenFlag, SaveFileName, _
btnSave, lstBoxItemsOrdered)
End If
End If
End If
End If
If (SaveFileOpenFlag = True) Then
SaveFileDesc.Close()
SaveFileOpenFlag = False
SaveFileName = ""
btnSave.Text = "Save Items"
End If
End Sub
Private Sub SaveItems(ByVal ThisListBox As ListBox, _
ByVal FileDesc As IO.StreamWriter)
Dim intEntries, i As Integer
intEntries = ThisListBox.Items.Count
For i = 0 To (intEntries - 1)
FileDesc.WriteLine(ThisListBox.Items(i))
Next
End Sub
Private Sub SaveIt(ByRef Fdesc As IO.StreamWriter, ByRef Status As Boolean, _
ByVal Fname As String, ByRef ThisBtn As Button, _
ByRef ThisList As ListBox)
Fdesc = IO.File.CreateText(Fname)
Status = True
ThisBtn.Text = Fname
SaveItems(ThisList, Fdesc)
End Sub
Private Sub btnRestore_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles btnRestore.Click
Dim answertext As String
'ReadFileDesc
'ReadFileOpenFlag
'ReadFileName
OpenFileDialog1.ShowDialog()
If (OpenFileDialog1.FileName <> "") Then
'File exists
ReadFileName = OpenFileDialog1.FileName
ReadFileDesc = IO.File.OpenText(ReadFileName)
ReadFileOpenFlag = True
If (ReadFileDesc.Peek <> -1) Then
'File has data
If (lstBoxItemsOrdered.Items.Count > 0) Then
' List box has entries
answertext = InputBox("Overwrite (O), Append (A), or Cancel (C)", _
"GradeList has Entries?", "C")
Select Case answertext.ToLower
Case "o"
lstBoxItemsOrdered.Items.Clear()
intNmbrOfItems = Restore_Array(ReadFileDesc, ReadFileOpenFlag, _
Items)
Restore_from_Array(Items, intNmbrOfItems, lstBoxItemsOrdered)
Case "a"
intNmbrOfItems = Restore_Array(ReadFileDesc, ReadFileOpenFlag, _
Items)
Restore_from_Array(Items, intNmbrOfItems, lstBoxItemsOrdered)
Case "c"
Return
Case Else
MsgBox("Input not recognized")
End Select
Else
intNmbrOfItems = Restore_Array(ReadFileDesc, ReadFileOpenFlag, _
Items)
Restore_from_Array(Items, intNmbrOfItems, lstBoxItemsOrdered)
End If
Else
' File isempty
End If
Else
'File is not specified
End If
End Sub
Private Function Restore_it(ByVal FileDesc As IO.StreamReader, _
ByVal FileOpenFlag As Boolean, _
ByVal GradeList As ListBox) As Integer
Dim strItem As String
Dim total As Integer = 0
Dim strName As String
Dim dblPrice As Double
Dim intEndName As Integer
Dim intStartPrice As Integer
Dim intEndPrice As Integer
Dim intStartQuantity As Integer
Dim dblQuantity As Double
If (FileOpenFlag = True) Then
While (FileDesc.Peek <> -1)
strItem = FileDesc.ReadLine
intEndName = strItem.IndexOf(" ")
strName = strItem.Substring(0, intEndName)
strItem = strItem.Substring(intEndName, intEndPrice)
intStartPrice = strItem.IndexOfAny("0123456789.")
intEndPrice = strItem.IndexOf(" ")
strItem = strItem.Substring(intEndPrice)
dblPrice = CDbl(strItem)
intStartQuantity = strItem.Substring(intEndPrice)
dblQuantity = CDbl(strItem)
GradeList.Items.Add(strItem)
total += 1
End While
Else
MsgBox("Internal Error")
End If
Return total
End Function
Private Function Restore_Array(ByVal FileDesc As IO.StreamReader, _
ByVal FileOpenFlag As Boolean, _
ByRef TheseProducts() As ItemInfo) As Integer
Dim strItem As String
Dim total As Integer = 0
Dim whiteIndex As Integer
Dim intStartPrice As Integer
If (FileOpenFlag = True) Then
While (FileDesc.Peek <> -1)
strItem = FileDesc.ReadLine
If (strItem <> "") Then
total += 1
If (total >= TheseProducts.Length) Then
'The array bounds are exceeded
ReDim Preserve TheseProducts(TheseProducts.Length * 2)
End If
whiteIndex = strItem.IndexOf(" ")
TheseProducts(total).Name = strItem.Substring(0, whiteIndex)
strItem = strItem.Substring(whiteIndex)
intStartPrice = strItem.IndexOfAny("0123456789.")
strItem = strItem.Substring(intStartPrice)
TheseProducts(total).Price = CDbl(strItem)
Else
'Ignore Line
End If
End While
Else
MsgBox("Internal Error #1 - Input File not open")
End If
Return total
End Function
Private Function Restore_from_Array(ByVal ProductList() As ItemInfo, _
ByVal intProducts As Integer, _
ByVal GradeList As ListBox) As Integer
Dim i, AllDone As Integer
Dim strTemp As String
Dim strFMT1 As String = "{0, -25} {1, 6:C2} {2,6}"
If (intProducts > 0) Then
AllDone = intProducts
i = 1
While (AllDone > 0)
strTemp = String.Format(strFMT1, ProductList(i).Name, "$", ProductList(i).Price, ProductList(i).Quantity)
GradeList.Items.Add(strTemp)
i += 1
AllDone -= 1
End While
Else
MsgBox("Internal Error #1: Number of Items not set")
End If
Return i - 1
End Function
Private Sub btnClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnClear.Click
lstBoxItemsOrdered.Items.Clear()
End Sub
Private Function MyTempTotal(ByVal txtItemPrice As TextBox, _
ByVal txtQuantity As TextBox)
If (txtItemPrice.TextLength And txtQuantity.TextLength > 0) Then
Dim dblTempTotal As String
dblTempTotal = 0
dblTempTotal = txtItemPrice.Text * txtQuantity.Text
Return dblTempTotal
Else
MsgBox("Enter an Item Price and a Quantity")
End If
End Function
Private Function MyGrandTotal(ByVal NmbrOfItems As Integer, _
ByVal ProductList() As ItemInfo, _
ByVal Sum As Single, ByVal TaxRate As String)
Dim i As Integer
Dim dblGrandTotal As Double
Sum = 0
dblGrandTotal = 0
If (NmbrOfItems > 0) Then
For i = 1 To NmbrOfItems
Sum += ProductList(i).Price * ProductList(i).Quantity
Next
dblGrandTotal = (Sum * TaxRate) + Sum
End If
Return dblGrandTotal
End Function
Private Sub btnTempPrice_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnTempPrice.Click
Dim strFmtAVG = "{0,10:C2}"
dblTempTotal = MyTempTotal(txtItemPrice, txtQuantity)
btnTempPrice.Text = String.Format(strFmtAVG, dblTempTotal)
End Sub
Private Sub btnTempPrice_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnTempPrice.MouseEnter
btnTempPrice.Text = "Calculate Temp Total"
End Sub
Private Sub btnPrintListBox_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPrintListBox.Click
PrintDocument2.DefaultPageSettings.Landscape = False
PrintDocument2.Print()
End Sub
Private Sub PrintDocument1_PrintPage(ByVal sender As System.Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument2.PrintPage
xpos = 0
ypos = 0
Dim MyFont As New Font("Arial", 12)
For i = 0 To lstBoxItemsOrdered.Items.Count - 1
e.Graphics.DrawString(lstBoxItemsOrdered.Items(i), MyFont, Brushes.Black, xpos, ypos)
ypos += 25
Next
End Sub
Private Sub btnGrandTotal_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnGrandTotal.Click
lstBoxItemsOrdered.Items.Add("The grand total will be")
lstBoxItemsOrdered.Items.Add(dblGrandTotal)
End Sub
Private Function ComboBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs)
Dim TaxRate As String
TaxRate = ComboBox1.FindString("0123456789.")
Return TaxRate
End Function
End ClassThere's so much code flying around, I'm not sure where the problem is. When I hit the Grand Total button, it always comes out that the Grand Total is 0. I'm not sure how to fix this problem. Any help would be greatly appreciated. And the Grand Total function should take the Tax Rate from the ComboBox, apply that Tax Rate to all the items in the Listbox or Sum up all the Items in the ListBox and then apply the Tax Rate to that and then output it as a new line to the ListBox.