frmpayrollschedule.frm

计税程序。可以计算每周收入、最近收入、从年初到目前的所得税、扣除的联邦收入税以及帐目检查等。 This program computes weekly payroll, current earnin

VERSION 5.00
Begin VB.Form frmPayRoll 
   BackColor       =   &H00C0FFFF&
   Caption         =   "Weekly Payroll"
   ClientHeight    =   6795
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   11625
   LinkTopic       =   "Form1"
   ScaleHeight     =   8595
   ScaleWidth      =   11880
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox picResults 
      BackColor       =   &H00FFFFFF&
      Height          =   4215
      Left            =   6120
      ScaleHeight     =   4155
      ScaleWidth      =   4755
      TabIndex        =   15
      Top             =   240
      Width           =   4815
   End
   Begin VB.CommandButton cmdQuit 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Quit"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   6960
      TabIndex        =   14
      Top             =   5400
      Width           =   1935
   End
   Begin VB.CommandButton cmdNext 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Next Employee"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   4200
      TabIndex        =   13
      Top             =   5400
      Width           =   2295
   End
   Begin VB.CommandButton cmdDisplay 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Display PayRoll"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   1800
      TabIndex        =   12
      Top             =   5400
      Width           =   1815
   End
   Begin VB.TextBox txtPriorPay 
      Height          =   735
      Left            =   2760
      TabIndex        =   11
      Top             =   3840
      Width           =   2535
   End
   Begin VB.TextBox txtMarital 
      Height          =   735
      Left            =   2760
      TabIndex        =   9
      Top             =   3000
      Width           =   2535
   End
   Begin VB.TextBox txtExempts 
      Height          =   735
      Left            =   2760
      TabIndex        =   7
      Top             =   2160
      Width           =   2535
   End
   Begin VB.TextBox txtHours 
      Height          =   615
      Left            =   2760
      TabIndex        =   5
      Top             =   1440
      Width           =   2535
   End
   Begin VB.TextBox txtWage 
      Height          =   615
      Left            =   2760
      TabIndex        =   3
      Top             =   720
      Width           =   2535
   End
   Begin VB.TextBox txtName 
      Height          =   615
      Left            =   2760
      TabIndex        =   1
      Top             =   0
      Width           =   2535
   End
   Begin VB.Label lblPriorPay 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Total Pay Prior to this Week"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   735
      Left            =   120
      TabIndex        =   10
      Top             =   3840
      Width           =   2415
   End
   Begin VB.Label lblMarital 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Marital Status[M OR S]"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   120
      TabIndex        =   8
      Top             =   3000
      Width           =   2415
   End
   Begin VB.Label lblExempts 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Number of Exemptions:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   120
      TabIndex        =   6
      Top             =   2280
      Width           =   2415
   End
   Begin VB.Label lblHours 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Number of Hours Worked:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   120
      TabIndex        =   4
      Top             =   1560
      Width           =   2295
   End
   Begin VB.Label lblWage 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Hourly wage:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   120
      TabIndex        =   2
      Top             =   840
      Width           =   2175
   End
   Begin VB.Label lblName 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Employee Name:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   2055
   End
End
Attribute VB_Name = "frmPayRoll"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Rem Program to compute employees'weekly payroll
Rem exempts     number of exemptions for employee
Rem fedtax      federal income tax withheld this week
Rem ficatax     FICA taxes for this week
Rem hrsworked   hours worked this week
Rem hrwage      hourlywage
Rem medicare    medicare tax for this week
Rem mstatus     Marital status: S for Single,M for Married
Rem EmpName     Name of employee
Rem grosspay    this week's pay before taxes
Rem check       paycheck this week (take-home pay)
Rem prevpay     totalpay for year excluding this week
Rem socialsecurity  socialsecurity tax for this week
Rem totalpay    totalpay for year including this week

Private Sub cmdDisplay_Click()
Dim empName As String, hrWage As Single, hrsWorked As Single
Dim exempts As Single, mStatus As String, prevPay As Single
Dim grosspay As Single, totalPay As Single, ficaTax As Single
Dim fedTax As Single, check As Single
Rem obtain data,compute payroll,display results
Rem mStatus Marital Status:S for single,M for Married
Call InputData(empName, hrWage, hrsWorked, exempts, mStatus, prevPay)
Let grosspay = Gross_Pay(hrWage, hrsWorked)
Let totalPay = Total_Pay(prevPay, grosspay)
Let ficaTax = FICA_Tax(grosspay, prevPay, totalPay)
Let fedTax = Fed_Tax(grosspay, exempts, mStatus)
Let check = Net_Check(grosspay, ficaTax, fedTax)
Call ShowPayroll(empName, grosspay, totalPay, ficaTax, fedTax, check)
End Sub

Private Sub cmdNext_Click()
Rem clear all text boxes for next employee's data
Let txtName.Text = ""
Let txtWage.Text = ""
Let txtHours.Text = ""
Let txtExempts.Text = ""
Let txtMarital.Text = ""
Let txtPriorPay.Text = ""
picResults.Cls
End Sub

Private Sub cmdQuit_Click()
    End
End Sub

Private Sub InputData(empName As String, hrWage As Single, hrsWorked As Single, exempts As Single, mStatus As String, prevPay As Single)
Rem Enter above two lines as one
Rem Get payroll data for employee
Let empName = txtName.Text
Let hrWage = Val(txtWage.Text)
Let hrsWorked = Val(txtHours.Text)
Let exempts = Val(txtExempts.Text)
Let mStatus = Left(UCase(txtMarital.Text), 1) 'M or S
Let prevPay = Val(txtPriorPay.Text)
End Sub

Private Sub ShowPayroll(empName As String, pay As Single, totalPay As Single, ficaTax As Single, fedTax As Single, check As Single)
Rem enter above two lines as one
Rem display results of payroll computations
picResults.Cls
picResults.Print "Payroll results for "; empName
picResults.Print
picResults.Print "     Gross pay this period:"; Format(pay, "Currency")
picResults.Print
picResults.Print "     Year-to-date-earnings:"; Format(totalPay, "Currency")
picResults.Print
picResults.Print "     Fica Taxes this period:"; Format(ficaTax, "Currency")
picResults.Print
picResults.Print "     Income tax withheld:"; Format(fedTax, "Currency")
picResults.Print
picResults.Print "Net pay(check amount):"; Format(check, "Currency")
End Sub

Private Function Net_Check(pay As Single, ficaTax As Single, fedTax As Single) As Single
Rem Compute amount of money given to employee
Net_Check = pay - ficaTax - fedTax
End Function

Private Function Fed_Tax(pay As Single, exempts As Single, mStatus As String) As Single
Dim adjPay As Single
Rem Compute federal income tax
Let adjPay = pay - (49.04 * exempts)
If adjPay < 0 Then
    Let adjPay = 0
End If
If mStatus = "S" Then
    Fed_Tax = TaxSingle(adjPay)
    Else
    Fed_Tax = TaxMarried(adjPay)
End If
End Function

Private Function FICA_Tax(pay As Single, prevPay As Single, totalPay As Single) As Single
Dim socialSecurity As Single, medicare As Single
Rem Compute social security and medicare tax
Let socialSecurity = 0
If totalPay <= 62700 Then
    Let socialSecurity = 0.062 * pay
    ElseIf prevPay < 62700 Then
    Let socialSecurity = 0.062 * (62700 - prevPay)
    End If
    Let medicare = 0.0145 * pay
    FICA_Tax = socialSecurity + medicare
End Function

Private Function Gross_Pay(hrWage As Single, hrsWorked As Single) As Single
Rem Compute weekly pay before taxes
If hrsWorked <= 40 Then
    Gross_Pay = hrsWorked * hrWage
    Else
    Gross_Pay = 40 * hrWage + (hrsWorked - 40) * 1.5 * hrWage
    End If
End Function

Private Function Total_Pay(prevPay As Single, pay As Single) As Single
Rem Compute total pay before taxes
Total_Pay = prevPay + pay
End Function

Private Function TaxMarried(adj As Single) As Single
Rem Compute federal tax for married person based on adjusted pay
Select Case adj
    Case 0 To 124
    TaxMarried = 0
    Case 124 To 851
    TaxMarried = 0.15 * (adj - 124)
    Case 851 To 1725
    TaxMarried = 109.5 + 0.28 * (adjPay - 851)
    Case 1725 To 2920
    TaxMarried = 353.77 + 0.31 * (adjPay - 1725)
    Case 2920 To 5152
    TaxMarried = 724.22 + 0.36 * (adjPay - 2920)
    Case Is > 5152
    TaxMarried = 1527.74 + 0.396 * (adjPay - 5152)
    End Select
End Function

Private Function TaxSingle(adjPay As Single) As Single
Rem Compute federal tax for single person based on adjusted pay
Select Case adjPay
    Case 0 To 50
    TaxSingle = 0.15 * (adjPay - 50)
    Case 50 To 489
    TaxSingle = 65.85 + 0.28 * (adjPay - 489)
    Case 489 To 1033
    TaxSingle = 65.85 + 0.28 * (adjPay - 1033)
    Case 1033 To 2361
    TaxSingle = 218.17 + 0.31 * (adjPay - 1033)
    Case 2361 To 5100
    TaxSingle = 629.85 + 0.36 * (adjPay - 2361)
    Case Is > 5100
    TaxSingle = 1615.89 + 0.396 * (adjPay - 5100)
    End Select
End Function