Modify the case study project from Chapter 4 to use menus and function procedure

Question

Modify the case study project from Chapter 4 to use menus and function procedure. Refer to Chapter 4 for project specifications. Use a function procedure t calculate the rental fee based on type of video. The Help menu About option should display a message box with information about the program and the programmer. The Color option should change the background color of the form; the font changes can change the control of your choice. What am I doing wrong with setting up my Print button? When I'm in the debug mode it gives me a weird message. It doesn't print and gives me suggestions on what to do, but it doesn't help out.

Here is my code.

PublicClassForm1

PublictotAsDouble

PubliccAsInteger=totalamt

ConstVHSPriceAsDecimal=1.8

ConstVHSNewReleasePriceAsDecimal=2.0

ConstDVDPriceAsDecimal=2.5

ConstDVDNewReleasePriceAsDecimal=3.0

PublicnumberofcustomersAsInteger

PublictotalamtAsDecimal = 0.0

PublicPropertyPrintForm1AsObject

PrivateSubbtnCalculate_Click(senderAsObject,eAsEventArgs)Handles btnCalculate.Click

IftxtMovieTitle.Text.Length>0Then

IfrbVHS.CheckedOrrbDVD.CheckedThen

DimrateAsDecimal

IfrbVHS.CheckedThen

IfchkNewRelease.CheckedThen

rate=VHSNewReleasePrice

Else rate=VHSPrice

EndIf

Else IfchkNewRelease.CheckedThen

rate=DVDNewReleasePrice

Else rate=DVDPrice

EndIf

EndIf

IfchkMember.CheckedThen rate=rate*0.9

EndIf

'calculatetotalsforallcustomers

numberofcustomers=numberofcustomers+1

totalamt=rate+totalamt

Else MessageBox.Show("Error;youmustselectVHSorDVD","Error", MessageBoxButtons.OK,MessageBoxIcon.Error)

EndIf Else

MessageBox.Show("Error;pleaseentermovietitle","Error", MessageBoxButtons.OK,MessageBoxIcon.Error)

EndIf

MsgBox("RentalAmount: "&FormatCurrency(totalamt))

EndSub

PrivateSubbtnClearforNextItem_Click(senderAsObject,eAsEventArgs)Handles btnClearforNextItem.Click

txtMovieTitle.Text=""

rbVHS.Checked=False

rbDVD.Checked=False

chkNewRelease.Checked=False

EndSub

PrivateSubbtnOrderComplete_Click(senderAsObject,eAsEventArgs)Handles btnOrderComplete.Click

DimreplyAsDialogResult=MessageBox.Show("Doyouwanttocompletetheorder?", "Confirm",MessageBoxButtons.YesNo,MessageBoxIcon.Question)

txtMovieTitle.Text=""

rbVHS.Checked=False

rbDVD.Checked=False

chkNewRelease.Checked=False

chkMember.Checked=False

c=c+1

EndSub

PrivateSubbtnSummary_Click(senderAsObject,eAsEventArgs)Handles btnSummary.Click

'calculatetotalrentalamountsforallcustomers

MsgBox("TotalCustomers:"&c&",TotalAmount:"&FormatCurrency(totalamt, 2))

EndSub

PrivateSubbtnPrint_Click(senderAsObject,eAsEventArgs)HandlesbtnPrint.Click

'Printtheform. PrintForm1.Print()

EndSub

PrivateSubbtnExit_Click(senderAsObject,eAsEventArgs)HandlesbtnExit.Click Close()

EndSub

EndClass

Explanation / Answer

Answer :

Private mcurAmount As Currency
Private mcurSubtotal As Currency
Private mcurTotalRentals As Currency
Private mintTotalCustomers As Integer

Private Sub mnuEditCalculate_Click()
Call Calculate
End Sub

Private Sub mnuEditColor_Click()
'Displays the color dialog box
dlgCommon.ShowColor

'Assigns dialog box color to the form
frmVideo.BackColor = dlgCommon.Color
End Sub

Private Sub mnuEditFont_Click()
'Displays the font dialog box
With dlgCommon
.Flags = cdlCFScreenFonts
.ShowFont
End With
End Sub

Private Sub mnuEditNextItem_Click()
'Clears the input and output fields, option and checkboxes
txtMovieTitle.Text = ""
chkNewRelease = 0
chkMember = 0
optDVD.Value = False
optVideotape.Value = False
lblRentalAmount.Caption = ""
lblDiscountAmount.Caption = ""
lblSubtotalAmount.Caption = ""

'Sets focus
txtMovieTitle.SetFocus

End Sub

Private Sub mnuEditOrderComplete_Click()
'Clear the form and prepare for the next customer
If lblSubtotalAmount.Caption <> "" Then
If mcurSubtotal <> 0 Then
'Clear the form
mnuEditNextItem_Click
lblSubtotalAmount.Caption = ""
With chkMember 'Enable checkbox for next customer
.Value = 0
.Enabled = True
End With
txtMovieTitle.SetFocus

'Add this customer to summary totals
mcurTotalRentals = mcurTotalRentals + mcurSubtotal
mintTotalCustomers = mintTotalCustomers + 1
mcurSubtotal = 0 'Reset total amount due for next customer
End If
Else
Call MsgBox("Please calculate and complete the order as soon as possible", vbOKOnly,
"Error")
txtMovieTitle.SetFocus
End If

End Sub

Private Sub mnuFileExit_Click()
'Terminates the program
End

End Sub

Private Sub mnuFilePrintForm_Click()
'Prints the form
frmVideo.PrintForm
End Sub

Private Sub mnuFileSummary_Click()
'Displays the totals
lblCustomerCount.Caption = FormatNumber(mintTotalCustomers, 0) & Space(1)
lblTotalRentalsAmount.Caption = FormatCurrency(mcurTotalRentals) & Space(1)

'Display the summary in a message box

Dim strMessage As String

If lblSubtotalAmount.Caption <> "" Then
Call MsgBox("Incomplete Orders", _
vbOKOnly, "Form is not blank")
ElseIf mintTotalCustomers > 0 Then
Call MsgBox("Total Customers: " & mintTotalCustomers & vbCrLf & _
"Total Rentals: " & FormatCurrency(mcurTotalRentals), vbInformation
+ vbOKOnly, "Summary")
Else
Call MsgBox("No Data to Summarize", vbOKOnly, "Summary")
End If
txtMovieTitle.SetFocus

End Sub

Private Sub mnuHelpAbout_Click()
'Displays information about the programmer
Call MsgBox("Hello", vbInformation + vbOKOnly,
"About the Application")
End Sub

Private Function Calculate()
'Calculates the amount due

Dim curPrice As Currency
Const curDiscount As Currency = 0.1
Dim curDiscountRate As Currency

If txtMovieTitle.Text = "" Then
Call MsgBox("Please enter movie title", vbExclamation + vbOKOnly,
"Title Required")
txtMovieTitle.SetFocus
ElseIf optDVD.Value = False And optVideotape.Value = False Then
Call MsgBox("Please select movie format", vbExclamation + vbOKOnly,
"Format Required")
Else
chkMember.Enabled = True
If chkNewRelease.Value = Checked And optDVD.Value = True Then
curPrice = 3
ElseIf chkNewRelease.Value = Checked And optVideotape.Value = True
Then
curPrice = 2
ElseIf optVideotape.Value = True Then
curPrice = 1.8
ElseIf optDVD.Value = True Then
curPrice = 2.5
End If
If chkMember.Value = Checked Then
curDiscountRate = curDiscount * mcurAmount
Else
mcurAmount = curPrice
End If
End If
'Calculate and display customer's subtotal
mcurSubtotal = mcurSubtotal + mcurAmount

lblRentalAmount.Caption = FormatCurrency(mcurAmount) & Space(1)
lblDiscountAmount.Caption = FormatNumber(curDiscountRate, 2) & Space(1)
lblSubtotalAmount.Caption = FormatCurrency(mcurSubtotal) & Space(1)

End Function

Related Questions

Navigate

• Browse (All)
• Browse M
• Subjects

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.