Chapter 7 Code Tables

1
Chapter 7Code Tables
2
VB Code Box 7-1Event Procedure for Compute
Button
Private Sub hsbExemptions_Change()
txtExemptions.Text Str(hsbExemptions.Value) End
Sub Private Sub cmdCompute_Click() Dim
intNumExemptions as Integer, curIncome as
Currency intNumExemptionsCInt(txtExemptions.Text
) curIncomeCCur(txtIncome.Text)
txtTaxes.TextFormat(curComputetaxes(int
NumExemptions, _ curIncome,
currency) End Sub
3
VB Code Box 7-2Function to Compute Income Taxes

• Public Function curComputeTaxes(intNumExm As
  Integer, _
• curGrossIncome As Currency) as Currency
• Dim curTaxIncome As Currency
• curTaxIncome curGrossIncome - 4400 -
  intNumExm 2800
• Select Case curTaxIncome
• Case Is lt 26250
• curComputeTaxes 0.15 TaxIncome
• Case Is lt 63550
• curComputeTaxes 3937.50 0.28
  (curTaxIncome - 26250)
• Case Is lt 132600
• curComputeTaxes 14385.50 0.31
  (curTaxIncome - 63550)
• Case Is lt 288350
• curComputeTaxes 41170.50 0.36
  (curTaxIncome - 132600)
• Case Else
• curComputeTaxes 86854.50 0.396
  (curTaxIncome - 288350)
• End Select
• End Function

4
VB Code Box 7-3Event Procedure for Sort Button
cmdSort_Click() Sort curPrices(), strPartID(),
intNumPrices End sub
5
VB Code Box 7-4Code to Reverse Two Price Elements
For intCounter0 to intNumPrices -2 If
curPrices(inCounter) gt curPrices(intCounter 1
Then Reverse curPrices(intCounter), cur
Prices (intCounter 1) End If Next
6
VB Code Box 7-5Sub to Reverse Two Values
Sub Reverse(curFirst as Currency, curSecond as
Currency) Dim curTemp as Currency curTemp
curFirst curFirst crSecond curSecond
crTemp End Sub
7
Pseudocode to Sort an Array
Begin Sort procedure Repeat until no reversals
made Repeat for each pair of values If value
gt next value then Reverse values End
decision End repeat End repeat End Procedure
8
VB Code Box 7-6 Code for Sub to Sort an Array
Public Sub Sort(curList1() As Currency,
strList2() _ As String, intNumList As Integer)
Dim blnNoReversal As Boolean, intCounter As
Integer blnNoReversal False Do Until
blnNoReversal blnNoReversal True For
intCounter 0 To intNumList - 2 If
curList1(intCounter) gt curList1(intCounter 1)
Then Reverse curList1(intCounter),curList1
(intCounter 1) ReverseStr
strList2(intCounter),strList2(intCounter1)
blnNoReversal False End If Next
Loop End Sub
9
VB Code Box 7-7New Code for PartList.vbp
Public Sub cmdSort_Click() Sort curPrices(),
strPartID(), intNumPrices End Sub Public Sub
Reverse(curFirst as Currency, curSecond as
Currency) Dim curTemp as Currency curTempcurFir
st curFirstcurSecond CurSecondcurTemp End Sub
10
VB Code Box 7-7New Code for PartList.vbp (cont)
Public Sub Reversestr (strFirst as String,
strSecond as String Dim strTemp as
String strTempstrFirst strFirststrSecond strS
econdstrTemp End Sub
11
VBCode Box 7-8New Code for cmdCalc Event
Procedure
curTaxescurTotalCost sngTaxRate (Existing
code) If txtLateFees.Text "" then MsgBox
"Click Check Members button and try again", _
vbCritical, "Membership status not checked"
Exit Sub User did not click Check Members
button End if curLateFees CCur(txtLateFees.Text)
curAmountDue curTotalCost curTaxes
curLateFees txtLateFees Format(LateFees,
"Currency") txtTotalCost.TextFormat(TotalCost,cu
rrency)(existing)
12
VB Code Box 7-9Global Declarations for Vintage
Videos Project
Public strMembers(100) as String,
curLateFees(100) as Currency Public
strPhoneNumbers(100) as String, intNumMembers as
Integer Public strVideos(100) as String,
curVideoPrice(100) as Currency Public
strVideoLoc(100) as String, intNumVideos as
Integer
13
Code Box 7-10Form_Load Event Procedure for
Vintage Videos
Private Sub Form_Load() lstVideos.AddItem
"Welcome to Vintage Videos" Open
"a\chapter7\members7.txt" For Input As 1 Do
Until EOF(1) Input 1, strMembers(intNumMembers
), _ strPhoneNumbers(intNumMembers),curLateFees
(intNumMembers) intNumMembers intNumMembers
1 Loop Close 1 Open "a\chapter7\videos.t
xt" For Input As 2 Do Until EOF(2) Input
2, strVideos(intNumVideos), _
curVideoPrice(intNumVideos), strVideoLoc(intNumVid
eos) intNumVideos intNumVideos 1 Loop
Close 2 End Sub
14
Pseudocode for Search Sub
Begin search procedure Repeat for each item in
list If SearchString is substring of list item
then Increment Number of matches counter
If Membership list then Add Name, Phone
Number and Late Fee to member list box Else
Add Video Name to video list box End
decision End decision End repeat End procedure
15
VB Code Box 7-11Sub to Search
Public Sub Search(strSearchstr As String,
strList1() As String, _ strList2() As String,
curList3() As Currency, intNumItems _ As Integer,
strWhich As String) Dim NumMatches As Integer,
Found As String ' Procedure searches for
strSearch in List1(). If matches are ' found, 1
or 3 array values are added to appropriate list
box Dim intCounter As Integer intNumMatches
0 For intCounter 0 To intNumItems - 1 If
InStr(UCase(strList1(intCounter)),
UCase(strSearch)) gt 0 Then intNumMatches
intNumMatches 1 If strWhich "Members"
Then frmMembers.lstMembers.AddItem
strList1(intCounter) " "
strList2(intCounter) " " Format(curList3(int
Counter), _ "currency") Else
frmVideos.lstVideos.AddItem strList1(intCounter)
End If End If Next (Continued on
next slide)
16
VB Code Box 7-11Sub to Search (cont)
If intNumMatches 0 Then MsgBox ("No
matching entries found! Try again.") ElseIf
intNumMatches gt 5 Then MsgBox ("Too many
matching entries!") frmMembers.lstMembers.Cle
ar frmVideos.lstVideos.Clear End If End Sub
17
VB Code Box 7-12Invoke the Search Sub for
Members
Private Sub cmdSearch_Click() Dim strFindName
As String lstMembers.Clear strFindName
txtSearch.Text Search strFindName,
strMembers(), strPhoneNumbers(), _
curLateFees(), intNumMembers, "Members" End Sub
18
VB Code Box 7-13Code for lstMembers_Click Event
Procedure
Private Sub lstMembers_Click() Dim
strMemberInfo As String, intNumChar As Integer
Dim intTwoBlankPos As Integer, strMemberName As
String Dim intDollarSignPos As Integer,
strLateFeeAmount As String strMemberInfo
lstMembers intNumChar Len(strMemberInfo)Find
length of lstMembers intTwoBlankPos
InStr(strMemberInfo, " ") Find two blanks
strMemberName Left(strMemberInfo,
intTwoBlankPos - 1) Name is at left side of
lstMembers intDollarSignPos
InStr(strMemberInfo,"") Find sign
intNumChar intNumChar - intDollarSignPos Find
amount length strLateFeeAmount
Right(strMemberInfo, intNumChar) Late fee
amount is at right end of lstMembers
frmVintage.txtCustName.Text strMemberName
frmVintage.txtLateFees.Text strLateFeeAmount Mo
ve name and late fees to frmVintage
lstMembers.Clear frmMembers.Hide
frmVintage.txtVideoName.SetFocus End Sub
19
VB Code Box 7-14Add Members to the Membership
List on frmMembers
Private Sub cmdAdd_Click() strMembers(intNumMemb
ers) InputBox("Enter new member name")
frmVintage.txtCustName.Text strMembers(intNumMem
bers) strPhoneNumbers(intNumMembers)
InputBox("Enter phone number")
LateFees(intNumMembers) 0 frmVintage.txtLateFe
es.Text 0 NumMembers NumMembers 1
frmVintage.txtVideoName.SetFocus
frmMembers.Hide End Sub
20
Code Table 7-15Add Videos to the Video List on
frmVideos
Private Sub cmdAdd_Click() Videos(intNumVideos)
InputBox("Enter new video")
VideoLoc(intNumVideos) InputBox("Enter video
location") VideoPrice(intNumVideos)CCur(InputB
ox("Enter video price")) intNumVideos
intNumVideos 1 End Sub
21
Pseudocode to Delete an Array Element
Begin Procedure Repeat for each element
starting with DeletedIndex
ArrayElement(Index) ArrayElement(Index 1)
End repeat Number of Elements Number of
Elements - 1 End procedure
22
VB Code Box 7-16Code to Find Array Index
Public Function FindDelete() As Integer Dim
intCounter As Integer, strFindPhoneNum As String
intFindDelete -1 strFindPhoneNum
InputBox("Input phone number to be deleted")
For intCounter 0 To intNumMembers - 1 If
strPhoneNumbers(intcounter) strFindPhoneNum
Then intFindDelete intCounter Exit
For End If Next End Function
23
VB Code Box 7-17Code to Delete Array Element
Public Sub Delete(intFoundIndex As Integer) Dim
intCounter As Integer, strOkToDelete As String
If intFoundIndex gt 0 Then strOkToDelete
InputBox("Ok to delete record for " _
strPhoneNumbers(intstrFoundIndex) " Y or N ?")
Else MsgBox "No one with that phone
number!", _ vbExclamation Exit Sub End
If If UCase(strOkToDelete) "Y" Then For
intCounter intFoundIndex To intNumMembers - 2
strMembers(intCounter) strMembers(intCounter
1) strPhoneNumbers(intCounter)
strPhoneNumbers(intCounter 1)
curLateFees(intCcounter) LateFees(intCcurounter
1) Next intNumMembers intNumMembers -
1 Else MsgBox "Record not deleted",
vbInformation End If End Sub
24
VB Code Box 7-18CmdPrint Event Procedure to
Print Sorted Membership List
Private Sub cmdPrint_Click() Sort strMembers(),
strPhoneNumbers(), curLateFees(), _
intNumMembers PrintInfo strMembers(),
strPhoneNumbers(), curLateFees(), _
intNumMembers End Sub
25
VB Code Box 7-19 Code for Sort Sub
Public Sub Sort(strList1() As String, strList2()
As String, _ curList3() As Currency, intNum As
Integer) Dim blnNotSwitched As Boolean,
intCounter As Integer Dim intNextToLast As
Integer blnNotSwitched False intNextToLast
intNum - 2 Do Until blnNotSwitched
blnNotSwitched True For intCounter 0 To
intNextToLast If strList1(intCounter) gt
strList1(intCounter 1) Then ReverseStr
strList1(intCounter), strList1(intCounter 1)
ReverseStr strList2(intCounter),
strList2(intCounter 1) Reverse
curList3(intCounter), curList3(intCounter 1)
blnNotSwitched False End If
Next Loop End Sub
26
VB Code Box 7-20Code for Print Sub
Sub PrintInfo(strList1() As String, strList2() As
_ String, curList3() As Currency, intNumItems As
Integer) Dim intCounter As Integer For
intCounter 0 To inntNumItems - 1
Debug.Print strList1(intCounter)Tab(20) _
strList2(Counter) _ Tab(30) _
Format(curList3(intCounter),"Currency")
Next End Sub
27
VB Code Box 7-21Code to Exit the Project
Private Sub cmdExit_Click() Dim intCounter As
Integer Open "a\chapter7\members7.txt" For
Output As 10 For intCounter 0 To
intNumMembers - 1 Write 10,
strMembers(intCounter), strPhoneNumbers(intCounter
), _ curLateFees(inntCounter) Next Open
"a\chapter7\videos.txt" For Output As 3 For
intCounter 0 To intNumVideos - 1 Write 3,
strVideos(intCounter), curVideoPrice(intCounter),
_ strVideoLoc(intCounter) Next Close 3
Close 10 End End Sub