1 / 27

Chapter 7 Code Tables

Chapter 7 Code Tables. VB Code Box 7-1 Event 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

lamont
Télécharger la présentation

Chapter 7 Code Tables

An Image/Link below is provided (as is) to download presentation Download Policy: Content on the Website is provided to you AS IS for your information and personal use and may not be sold / licensed / shared on other websites without getting consent from its author. Content is provided to you AS IS for your information and personal use only. Download presentation by click this link. While downloading, if for some reason you are not able to download a presentation, the publisher may have deleted the file from their server. During download, if you can't get a presentation, the file might be deleted by the publisher.

E N D

Presentation Transcript

  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 intNumExemptions=CInt(txtExemptions.Text) curIncome=CCur(txtIncome.Text) txtTaxes.Text=Format(curComputetaxes(intNumExemptions, _ 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 <= 26250 curComputeTaxes = 0.15 * TaxIncome Case Is <= 63550 curComputeTaxes = 3937.50 + 0.28 * (curTaxIncome - 26250) Case Is <= 132600 curComputeTaxes = 14385.50 + 0.31 * (curTaxIncome - 63550) Case Is < 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 intCounter=0 to intNumPrices -2 If curPrices(inCounter) > 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 > 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) > curList1(intCounter + 1) Then Reverse curList1(intCounter),curList1(intCounter + 1) ReverseStr strList2(intCounter),strList2(intCounter+1) 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 curTemp=curFirst curFirst=curSecond CurSecond=curTemp End Sub

  10. VB Code Box 7-7New Code for PartList.vbp (con’t) Public Sub Reversestr (strFirst as String, strSecond as String Dim strTemp as String strTemp=strFirst strFirst=strSecond strSecond=strTemp End Sub

  11. VBCode Box 7-8New Code for cmdCalc Event Procedure curTaxes=curTotalCost +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.Text+Format(TotalCost,”currency”)(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.txt" For Input As #2 Do Until EOF(2) Input #2, strVideos(intNumVideos), _ curVideoPrice(intNumVideos), strVideoLoc(intNumVideos) 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)) > 0 Then intNumMatches = intNumMatches + 1 If strWhich = "Members" Then frmMembers.lstMembers.AddItem strList1(intCounter) & " " & strList2(intCounter) & " " & Format(curList3(intCounter), _ "currency") Else frmVideos.lstVideos.AddItem strList1(intCounter) End If End If Next(Continued on next slide)

  16. VB Code Box 7-11Sub to Search (con’t) If intNumMatches = 0 Then MsgBox ("No matching entries found! Try again.") ElseIf intNumMatches > 5 Then MsgBox ("Too many matching entries!") frmMembers.lstMembers.Clear 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 ’Move 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(intNumMembers) = InputBox("Enter new member name:") frmVintage.txtCustName.Text = strMembers(intNumMembers) strPhoneNumbers(intNumMembers) = InputBox("Enter phone number:") LateFees(intNumMembers) = 0 frmVintage.txtLateFees.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(InputBox("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 >= 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) > 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

More Related