home *** CD-ROM | disk | FTP | other *** search
/ An Introduction to Progr…l Basic 6.0 (4th Edition) / An Introduction to Programming using Visual Basic 6.0.iso / PROGRAMS / CH5 / 5-4.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-11-02  |  10.2 KB  |  296 lines
  1. VERSION 5.00
  2. Begin VB.Form frmPayroll 
  3.    Caption         =   "Weekly Payroll"
  4.    ClientHeight    =   3120
  5.    ClientLeft      =   1170
  6.    ClientTop       =   2145
  7.    ClientWidth     =   7740
  8.    BeginProperty Font 
  9.       Name            =   "MS Sans Serif"
  10.       Size            =   8.25
  11.       Charset         =   0
  12.       Weight          =   700
  13.       Underline       =   0   'False
  14.       Italic          =   0   'False
  15.       Strikethrough   =   0   'False
  16.    EndProperty
  17.    LinkTopic       =   "Form1"
  18.    PaletteMode     =   1  'UseZOrder
  19.    ScaleHeight     =   3120
  20.    ScaleWidth      =   7740
  21.    Begin VB.CommandButton cmdNext 
  22.       Caption         =   "Next Employee"
  23.       Height          =   495
  24.       Left            =   3000
  25.       TabIndex        =   13
  26.       Top             =   2520
  27.       Width           =   2175
  28.    End
  29.    Begin VB.PictureBox picResults 
  30.       Height          =   2295
  31.       Left            =   4080
  32.       ScaleHeight     =   2235
  33.       ScaleWidth      =   3435
  34.       TabIndex        =   15
  35.       Top             =   120
  36.       Width           =   3495
  37.    End
  38.    Begin VB.TextBox txtPriorPay 
  39.       Height          =   285
  40.       Left            =   2640
  41.       TabIndex        =   11
  42.       Top             =   1920
  43.       Width           =   1215
  44.    End
  45.    Begin VB.TextBox txtMarital 
  46.       Height          =   285
  47.       Left            =   2640
  48.       TabIndex        =   9
  49.       Top             =   1560
  50.       Width           =   1215
  51.    End
  52.    Begin VB.TextBox txtExempts 
  53.       Height          =   285
  54.       Left            =   2640
  55.       TabIndex        =   7
  56.       Top             =   1200
  57.       Width           =   1215
  58.    End
  59.    Begin VB.TextBox txtHours 
  60.       Height          =   285
  61.       Left            =   2640
  62.       TabIndex        =   5
  63.       Top             =   840
  64.       Width           =   1215
  65.    End
  66.    Begin VB.TextBox txtWage 
  67.       Height          =   285
  68.       Left            =   2640
  69.       TabIndex        =   3
  70.       Top             =   480
  71.       Width           =   1215
  72.    End
  73.    Begin VB.TextBox txtName 
  74.       Height          =   285
  75.       Left            =   2640
  76.       TabIndex        =   1
  77.       Top             =   120
  78.       Width           =   1215
  79.    End
  80.    Begin VB.CommandButton cmdQuit 
  81.       Caption         =   "Quit"
  82.       Height          =   495
  83.       Left            =   5640
  84.       TabIndex        =   14
  85.       Top             =   2520
  86.       Width           =   1455
  87.    End
  88.    Begin VB.CommandButton cmdDisplay 
  89.       Caption         =   "Display Payroll"
  90.       Height          =   495
  91.       Left            =   360
  92.       TabIndex        =   12
  93.       Top             =   2520
  94.       Width           =   2175
  95.    End
  96.    Begin VB.Label lblPriorPay 
  97.       Alignment       =   1  'Right Justify
  98.       Caption         =   "Total Pay Prior to this Week:"
  99.       Height          =   255
  100.       Left            =   0
  101.       TabIndex        =   10
  102.       Top             =   1920
  103.       Width           =   2535
  104.    End
  105.    Begin VB.Label lblMarital 
  106.       Alignment       =   1  'Right Justify
  107.       Caption         =   "Marital Status (M or S):"
  108.       Height          =   255
  109.       Left            =   480
  110.       TabIndex        =   8
  111.       Top             =   1560
  112.       Width           =   2055
  113.    End
  114.    Begin VB.Label lblExempts 
  115.       Alignment       =   1  'Right Justify
  116.       Caption         =   "Number of Exemptions:"
  117.       Height          =   255
  118.       Left            =   480
  119.       TabIndex        =   6
  120.       Top             =   1200
  121.       Width           =   2055
  122.    End
  123.    Begin VB.Label lblHours 
  124.       Alignment       =   1  'Right Justify
  125.       Caption         =   "Number of Hours Worked:"
  126.       Height          =   255
  127.       Left            =   240
  128.       TabIndex        =   4
  129.       Top             =   840
  130.       Width           =   2295
  131.    End
  132.    Begin VB.Label lblWage 
  133.       Alignment       =   1  'Right Justify
  134.       Caption         =   "Hourly Wage:"
  135.       Height          =   255
  136.       Left            =   1320
  137.       TabIndex        =   2
  138.       Top             =   480
  139.       Width           =   1215
  140.    End
  141.    Begin VB.Label lblName 
  142.       Alignment       =   1  'Right Justify
  143.       Caption         =   "Employee Name:"
  144.       Height          =   255
  145.       Left            =   1080
  146.       TabIndex        =   0
  147.       Top             =   120
  148.       Width           =   1455
  149.    End
  150. Attribute VB_Name = "frmPayroll"
  151. Attribute VB_GlobalNameSpace = False
  152. Attribute VB_Creatable = False
  153. Attribute VB_PredeclaredId = True
  154. Attribute VB_Exposed = False
  155. 'Program to compute employees' weekly payroll
  156. Private Sub cmdDisplay_Click()
  157.   Dim empName As String      'Name of employee
  158.   Dim hrWage As Single       'Hourly wage
  159.   Dim hrsWorked As Single    'Hours worked this week
  160.   Dim exemptions As Integer  'Number of exemptions for employee
  161.   Dim mStatus As String      'Marital status: S for Single; M for Married
  162.   Dim prevPay As Single      'Total pay for year excluding this week
  163.   Dim pay As Single          'This week's pay before taxes
  164.   Dim totalPay As Single     'Total pay for year including this week
  165.   Dim ficaTax As Single      'FICA taxes for this week
  166.   Dim fedTax As Single       'Federal income tax withheld this week
  167.   Dim check As Single        'Paycheck this week (take-home pay)
  168.   'Obtain data, compute payroll, display results
  169.   Call InputData(empName, hrWage, hrsWorked, exemptions, mStatus, prevPay) 'Task 0
  170.   pay = Gross_Pay(hrWage, hrsWorked)                                       'Task 1
  171.   totalPay = Total_Pay(prevPay, pay)                                       'Task 2
  172.   ficaTax = FICA_Tax(pay, prevPay, totalPay)                               'Task 3
  173.   fedTax = Fed_Tax(pay, exemptions, mStatus)                               'Task 4
  174.   check = Net_Check(pay, ficaTax, fedTax)                                  'Task 5
  175.   Call ShowPayroll(empName, pay, totalPay, ficaTax, fedTax, check)         'Task 6
  176. End Sub
  177. Private Sub cmdNext_Click()
  178.   'Clear all text boxes for next employee's data
  179.   txtName.Text = " "
  180.   txtWage.Text = " "
  181.   txtHours.Text = " "
  182.   txtExempts.Text = " "
  183.   txtMarital.Text = " "
  184.   txtPriorPay.Text = " "
  185.   picResults.Cls
  186. End Sub
  187. Private Sub cmdQuit_Click()
  188.   End
  189. End Sub
  190. Private Function Fed_Tax(pay As Single, exemptions As Integer, mStatus As String)
  191.   Dim adjPay As Single
  192.   'Task 4.1: Compute federal income tax
  193.   adjPay = pay - (51.92 * exemptions)
  194.   If adjPay < 0 Then
  195.       adjPay = 0
  196.   End If
  197.   If mStatus = "S" Then
  198.       Fed_Tax = TaxSingle(adjPay)   'Task 4.2
  199.     Else
  200.       Fed_Tax = TaxMarried(adjPay)  'Task 4.3
  201.   End If
  202.   Fed_Tax = Round(Fed_Tax, 2)       'Round to nearest cent
  203. End Function
  204. Private Function FICA_Tax(pay As Single, prevPay As Single, totalPay As Single)
  205.   Dim socialSecurity As Single       'Social Security tax for this week
  206.   Dim medicare As Single             'Medicare tax for this week
  207.   'Task 3: Compute Social Security and Medicare tax
  208.   If totalPay <= 68400 Then
  209.       socialSecurity = 0.062 * pay
  210.     ElseIf prevPay < 68400 Then
  211.       socialSecurity = 0.062 * (68400 - prevPay)
  212.   End If
  213.   medicare = 0.0145 * pay
  214.   FICA_Tax = socialSecurity + medicare
  215.   FICA_Tax = Round(FICA_Tax, 2)           'Round to nearest cent
  216. End Function
  217. Private Function Gross_Pay(hrWage As Single, hrsWorked As Single)
  218.   'Task 1: Compute weekly pay before taxes
  219.   If hrsWorked <= 40 Then
  220.       Gross_Pay = hrsWorked * hrWage
  221.     Else
  222.       Gross_Pay = 40 * hrWage + (hrsWorked - 40) * 1.5 * hrWage
  223.   End If
  224. End Function
  225. Private Sub InputData(empName As String, hrWage As Single, _
  226.                       hrsWorked As Single, exemptions As Integer, _
  227.                       mStatus As String, prevPay As Single)
  228.   'Get payroll data for employee
  229.   empName = txtName.Text
  230.   hrWage = Val(txtWage.Text)
  231.   hrsWorked = Val(txtHours.Text)
  232.   exemptions = Val(txtExempts.Text)
  233.   mStatus = Left(UCase(txtMarital.Text), 1)   'M or S
  234.   prevPay = Val(txtPriorPay.Text)
  235. End Sub
  236. Private Function Net_Check(pay As Single, ficaTax As Single, fedTax As Single)
  237.   'Task 5: Compute amount of money given to employee
  238.   Net_Check = pay - ficaTax - fedTax
  239. End Function
  240. Private Sub ShowPayroll(empName As String, pay As Single, _
  241.      totalPay As Single, ficaTax As Single, fedTax As Single, check As Single)
  242.   'Display results of payroll computations
  243.   picResults.Cls
  244.   picResults.Print "Payroll results for "; empName
  245.   picResults.Print
  246.   picResults.Print "    Gross pay this period: "; FormatCurrency(pay)
  247.   picResults.Print
  248.   picResults.Print "    Year-to-date earnings: "; FormatCurrency(totalPay)
  249.   picResults.Print
  250.   picResults.Print "   Fica Taxes this period: "; FormatCurrency(ficaTax)
  251.   picResults.Print
  252.   picResults.Print "      Income tax withheld: "; FormatCurrency(fedTax)
  253.   picResults.Print
  254.   picResults.Print "Net pay (check amount): "; FormatCurrency(check)
  255. End Sub
  256. Private Function TaxMarried(adjPay As Single) As Single
  257.   'Task 6.3: Compute federal tax for married person based on adjusted pay
  258.   Select Case adjPay
  259.     Case 0 To 124
  260.       TaxMarried = 0
  261.     Case 124 To 899
  262.       TaxMarried = 0.15 * (adjPay - 124)
  263.     Case 899 To 1855
  264.       TaxMarried = 116.25 + 0.28 * (adjPay - 899)
  265.     Case 1855 To 3084
  266.       TaxMarried = 383.93 + 0.31 * (adjPay - 1855)
  267.     Case 3084 To 5439
  268.       TaxMarried = 764.92 + 0.36 * (adjPay - 3084)
  269.     Case Is > 5439
  270.       TaxMarried = 1612.72 + 0.396 * (adjPay - 5439)
  271.   End Select
  272. End Function
  273. Private Function TaxSingle(adjPay As Single) As Single
  274.   'Task 6.2: Compute federal tax for single person based on adjusted pay
  275.   Select Case adjPay
  276.     Case 0 To 51
  277.       TaxSingle = 0
  278.     Case 51 To 517
  279.       TaxSingle = 0.15 * (adjPay - 51)
  280.     Case 517 To 1105
  281.       TaxSingle = 69.6 + 0.28 * (adjPay - 517)
  282.     Case 1105 To 2493
  283.       TaxSingle = 234.54 + 0.31 * (adjPay - 1105)
  284.     Case 2493 To 5385
  285.       TaxSingle = 664.82 + 0.36 * (adjPay - 2493)
  286.     Case Is > 5385
  287.       TaxSingle = 1705.94 + 0.396 * (adjPay - 5385)
  288.   End Select
  289. End Function
  290. Private Function Total_Pay(prevPay As Single, pay As Single)
  291.   'Compute total pay before taxes
  292.   Total_Pay = prevPay + pay
  293. End Function
  294. Private Sub picResults_Click()
  295. End Sub
  296.