So, we found an old sales commission program that we developed in college, in Visual Basic 6. It still works good, and we were able to make it an executable. Good stuff! It still goes into our vintage collection though.
The sales commission program
In college, we called this program Open Door sales commission. Moreover, Open Door is a great name for a company. Most likely, that name is taken. Anyhow, it looks like a very professional program. So, even in college, you should produce good stuff.
Overall, this program was developed on a Windows PC. Therefore, it may not work on every computer. In addition, we will not go through the details of this program. It is vintage. So, just download it, play with it, and explore.
How it looks in run mode
Below is how the sales commission looks in run mode, and as an executable.
Download
Feel free to download this program. It is all open source. Click on the button below to download.
Download Size: 13 kB
Code listing
Here is the code for the Open Door program.
'OpenDoor
'Open Door--Sales Commission
'Professor Maiorisi--CIS 166
'Designed and programmed by: Alex Shaw III
'Date created: November 15, 2003
'Last modified: November 17, 2003
'
'Note: Printout in landscape mode
'
'This program calculates the total commission for a specific salesperson.
'
'Brief Commission and Bonus Breakdown:
'A sales commission is based on sales between $150,000 and $499,999.
'A volume commission is based on sales greater than $499,999.
'A $500 monthly quota bonus is granted for sales of $350,000+.
'A $100 monthly quota bonus is granted for sales below $350,000.
'A customer status bonus is granted based on the customer status.
Option Explicit 'require declaration of variables
'Assign constants
Const SalesLim = 150000 'sales bonus limit
Const VolLim = 499999 'volume bonus limit
Const QuotaLim = 350000 'quota bonus limit
Const StatBon1 = 1000 'new customer
Const StatBon2 = 750 'reinstating old customer
Const StatBon3 = 500 'reactivating inactive customer
Const StatBon4 = 250 'additional sale to customer
Const StatBon5 = 1000 'millionth dollar sale
Const ServRate1 = 0.05 'Project Management rate
Const ServRate2 = 0.04 'Requirements Definition rate
Const ServRate3 = 0.03 'System Design rate
Const ServRate4 = 0.06 'Programming rate
Const VolRate1 = 0.01 'Project Management volume rate
Const VolRate4 = 0.01 'Programming volume rate
'Status Messages
Const StatMes1 = "Congratulations on making a new customer!"
Const StatMes2 = "Congratulations on reinstating an old customer!"
Const StatMes3 = "Congratulations on activating an inactive customer!"
Const StatMes4 = "Congratulations on additional sale to current customer!"
Const StatMes5 = "Congratulations on millionth dollar sale!"
'Allocate variable space
Dim intStatusBonus As Integer
Dim intQuotaBonus As Single
Dim sngVolumeBonus As Single
Dim sngServiceBonus As Single
Dim sngTotalCommission As Single
Private Sub CalcCommission() 'Calculate commission
'Allocate storage space
Dim SType1, SType2, SType3, SType4 As Boolean 'service types 1, 2, 3, and 4
Dim SalesAmt As Single 'sales amount
'Assign values
SType1 = optServiceType1.Value 'project management
SType2 = optServiceType2.Value 'requirements definition
SType3 = optServiceType3.Value 'system design
SType4 = optServiceType4.Value 'programming service
SalesAmt = Val(txtSalesAmount.Text) 'sales amount
'Initialize bonus values
'User may not clear screen before entering next customer
intQuotaBonus = 0
sngVolumeBonus = 0
sngServiceBonus = 0
'Perform comparisons
If ((SType1 = False) And (SType2 = False) And (SType3 = False) And (SType4 = False)) Then
MsgBox ("Please Select a Service Type")
optServiceType1.SetFocus 'set focus to option list
optServiceType1.Value = False 'clear first option value
Else
If (SalesAmt >= 350000) Then intQuotaBonus = 500 Else intQuotaBonus = 100
If ((SalesAmt > 499999) And ((SType1 = True) Or (SType4 = True))) Then
If (SType1 = True) Then
sngServiceBonus = SalesAmt * ServRate1
sngVolumeBonus = SalesAmt * VolRate1
Else
sngServiceBonus = SalesAmt * ServRate4
sngVolumeBonus = SalesAmt * VolRate4
End If
lblSalesStatus.Caption = "S, V" 'service and volume bonus
Else
If (SalesAmt >= 150000) Then
If (SType1 = True) Then sngServiceBonus = SalesAmt * ServRate1
If (SType2 = True) Then sngServiceBonus = SalesAmt * ServRate2
If (SType3 = True) Then sngServiceBonus = SalesAmt * ServRate3
If (SType4 = True) Then sngServiceBonus = SalesAmt * ServRate4
lblSalesStatus.Caption = "S" 'service bonus only
Else
lblSalesStatus.Caption = "N" 'no service bonus granted
End If
End If
sngTotalCommission = intQuotaBonus + sngServiceBonus + sngVolumeBonus + intStatusBonus
Call DisplayResults
End If
End Sub
Private Sub Calculations() 'Perform calculations
Call StatusMessage 'display status message
End Sub
Private Sub CenterForm() 'Centers a form on the screen
frmOpenDoor.Top = (Screen.Height - frmOpenDoor.Height) / 2 'top position
frmOpenDoor.Left = (Screen.Width - frmOpenDoor.Width) / 2 'left position
End Sub
Private Sub ClearValues()
'Clear and restore controls related to user control
'Clear text boxes
txtLastName.Text = "" 'last name
txtFirstName.Text = "" 'first name
txtMidInit.Text = "" 'middle initial
txtSuffix.Text = "" 'suffix
txtSalesAmount.Text = "" 'sales amount
txtCustomerStatus.Text = "" 'customer status
'Clear option values
optServiceType1.Value = False 'Project Management
optServiceType2.Value = False 'Requirements Definition
optServiceType3.Value = False 'System Design
optServiceType4.Value = False 'Programming
'Clear commission and bonus labels
lblSalesCommission.Caption = "" 'sales commission
lblVolumeCommission.Caption = "" 'volume commission
lblStatusBonus.Caption = "" 'customer status bonus
lblQuotaBonus.Caption = "" 'monthly quota bonus
lblTotalCommission.Caption = "" 'total commission
'Restore values
lblStatusMessage.Caption = "Status Message" 'restore status message
lblSalesStatus.Caption = "" 'restore sales status
End Sub
Private Sub DisplayResults() 'Display results
lblSalesCommission.Caption = Format(sngServiceBonus, "Currency")
lblVolumeCommission.Caption = Format(sngVolumeBonus, "Currency")
lblStatusBonus.Caption = Format(intStatusBonus, "Currency")
lblQuotaBonus.Caption = Format(intQuotaBonus, "Currency")
lblTotalCommission.Caption = Format(sngTotalCommission, "Currency")
End Sub
Private Sub Initialize()
'Remove borders around labels
lblSalesStatus.BorderStyle = 0 'sales status
lblSalesCommission.BorderStyle = 0 'sales commission
lblVolumeCommission.BorderStyle = 0 'volume commission
lblStatusBonus.BorderStyle = 0 'customer status bonus
lblQuotaBonus.BorderStyle = 0 'monthly quota bonus
lblTotalCommission.BorderStyle = 0 'total commission
End Sub
Private Sub StatusMessage() 'Display status message
'Initialize bonus value
'User may not clear screen before entering next customer
intStatusBonus = 0
txtCustomerStatus.Text = UCase(txtCustomerStatus.Text) 'uppercase status character
Select Case txtCustomerStatus.Text 'check customer status
Case "N" 'new customer
intStatusBonus = StatBon1
lblStatusMessage.Caption = StatMes1
Call CalcCommission
Case "R" 'old customer
intStatusBonus = StatBon2
lblStatusMessage.Caption = StatMes2
Call CalcCommission
Case "I" 'inactive customer
intStatusBonus = StatBon3
lblStatusMessage.Caption = StatMes3
Call CalcCommission
Case "C" 'current customer
intStatusBonus = StatBon4
lblStatusMessage.Caption = StatMes4
Call CalcCommission
Case "X" 'millionth dollar sale
intStatusBonus = StatBon5
lblStatusMessage.Caption = StatMes5
Call CalcCommission
Case Else
MsgBox ("Please Enter a Valid Customer Status")
txtCustomerStatus.SetFocus
End Select
End Sub
Private Sub cmdCalc_Click()
Call Calculations 'clear values
End Sub
Private Sub cmdClear_Click()
Call ClearValues 'clear values
End Sub
Private Sub cmdExit_Click()
End 'end program
End Sub
Private Sub cmdPrint_Click()
PrintForm 'print form
End Sub
Private Sub Form_Load()
Initialize 'initialize program elements
CenterForm 'center form
End Sub
The video
Here is a very short video of how to use the Open Door program. Make sure you subscribe to Techronology on YouTube, as we plan to do some stuff.
What is next?
Guess what? Now that we know VB6 still works on our system, we may start using it again. Even pinned it to our taskbar. Once we saw that we were able to create an executable, that was it. So, look out!
Related
- Free downloads
- Open Door payroll program
- Payroll program in Visual Basic 6
- PPP – Payroll Processing Program
- Vintage stuff
- Visual Basic (classic)
- Visual Basic 6.0 documentation