Would you like to make this site your homepage? It's fast and easy...
Yes, Please make this my home page!
VB Project - Calculator
The purpose of this project was to build a
calculator to operate my preferred way - type in
a number, then hit '+' to add to the
total, or '-' to subtract from
the total. I also wanted to include a 'strip list', to check the numbers entered when totals didn't
match.
On most pocket calculators (including the MS calc.exe), these
keystrokes 4+2- are treated as 4(+2)- which will display 6. I wanted a
calculator to treat them as (4+)(2-) which will display 2.
The code for the calculator is a bit
sloppy, but it has worked (so far) without error.
Try it
here, this is a java applet (written without any Swing components)
use mouse or keyboard
Shortcut keys Cancel - C, Clear All - A, Clr List - L
Click for versions in
java/Swing
java/Applet
download source
files, the exe file (as a zip), or
copy/paste code below
(if you download, the exe file, ensure you do a
virus scan, and you may(?) need the VB runtime files)
VB Code
Start a new project with Form1
save the form as Form1
save the project as any name
close vb
copy
Form1.frm as Form1OLD.frm
with notepad, open Form1.frm
replace the entire contents of Form1.frm with the following
(saves building the GUI)
save Form1.frm
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed
Single
Caption
= "MD Calculator"
ClientHeight
= 4815
ClientLeft
= 45
ClientTop
= 330
ClientWidth
= 9105
LinkTopic
= "Form1"
LockControls
= -1 'True
MaxButton = 0
'False
ScaleHeight =
4815
ScaleWidth =
9105
StartUpPosition = 2
'CenterScreen
Begin VB.CommandButton btnClearDisplay
Caption = "Clear
&Display"
Height =
255
Left
= 7200
TabIndex =
30
Top
= 1275
Width =
1800
End
Begin VB.CommandButton btnClearAll
Caption = "Clear
&All"
Height =
255
Left
= 5520
TabIndex =
29
Top
= 1275
Width =
1550
End
Begin VB.CommandButton
btnClearStripList
Caption = "Clear
&Strip List"
Height =
255
Left
= 3840
TabIndex =
28
Top
= 1275
Width =
1550
End
Begin VB.CommandButton btnEquals
Caption =
"="
BeginProperty Font
Name
= "MS Sans
Serif"
Size
= 24
Charset =
0
Weight =
400
Underline = 0
'False
Italic =
0 'False
Strikethrough = 0
'False
EndProperty
Height =
1420
Left
= 8160
TabIndex =
27
Top
= 3240
Width =
855
End
Begin VB.CommandButton btnDivide
Caption =
"÷"
BeginProperty Font
Name
= "MS Sans
Serif"
Size
= 24
Charset =
0
Weight =
400
Underline = 0
'False
Italic =
0 'False
Strikethrough = 0
'False
EndProperty
Height =
735
Left
= 8160
TabIndex =
26
Top
= 2400
Width =
855
End
Begin VB.CommandButton btnMultiply
Caption =
"x"
BeginProperty Font
Name
= "MS Sans
Serif"
Size
= 17.25
Charset =
0
Weight =
400
Underline = 0
'False
Italic =
0 'False
Strikethrough = 0
'False
EndProperty
Height =
735
Left
= 8160
TabIndex =
25
Top
= 1560
Width =
855
End
Begin VB.CommandButton btnMinus
Caption =
"-"
BeginProperty Font
Name
= "MS Sans
Serif"
Size
= 24
Charset =
0
Weight =
400
Underline = 0
'False
Italic =
0 'False
Strikethrough = 0
'False
EndProperty
Height =
735
Left
= 7200
TabIndex =
24
Top
= 1575
Width =
855
End
Begin VB.CommandButton btnAdd
Caption =
"+"
BeginProperty Font
Name
= "MS Sans
Serif"
Size
= 24
Charset =
0
Weight =
400
Underline = 0
'False
Italic =
0 'False
Strikethrough = 0
'False
EndProperty
Height =
2275
Left
= 7200
TabIndex =
23
Top
= 2400
Width =
855
End
Begin VB.Frame fraKeypad
BeginProperty Font
Name
= "MS Sans
Serif"
Size
= 24
Charset =
0
Weight =
400
Underline = 0
'False
Italic =
0 'False
Strikethrough = 0
'False
EndProperty
Height =
3375
Left
= 3840
TabIndex =
10
Top
= 1320
Width =
3255
Begin VB.CommandButton btnKeys
Caption =
"."
BeginProperty Font
Name
= "MS Sans
Serif"
Size
=
24
Charset =
0
Weight =
400
Underline = 0
'False
Italic =
0
'False
Strikethrough = 0
'False
EndProperty
Height =
615
Index =
11
Left
= 2160
TabIndex =
22
Top
= 2640
Width =
735
End
Begin VB.CommandButton btnKeys
Caption =
"00"
Height =
615
Index =
10
Left
= 1200
TabIndex =
21
Top
= 2640
Width =
735
End
Begin VB.CommandButton btnKeys
Caption =
"9"
Height =
615
Index =
9
Left
= 2160
TabIndex =
20
Top
= 480
Width =
735
End
Begin VB.CommandButton btnKeys
Caption =
"8"
Height =
615
Index =
8
Left
= 1200
TabIndex =
19
Top
= 480
Width =
735
End
Begin VB.CommandButton btnKeys
Caption =
"7"
Height =
615
Index =
7
Left
= 240
TabIndex =
18
Top
= 480
Width =
735
End
Begin VB.CommandButton btnKeys
Caption =
"6"
Height =
615
Index =
6
Left
= 2160
TabIndex =
17
Top
= 1200
Width =
735
End
Begin VB.CommandButton btnKeys
Caption =
"5"
Height =
615
Index =
5
Left
= 1200
TabIndex =
16
Top
= 1200
Width =
735
End
Begin VB.CommandButton btnKeys
Caption =
"4"
Height =
615
Index =
4
Left
= 240
TabIndex =
15
Top
= 1200
Width =
735
End
Begin VB.CommandButton btnKeys
Caption =
"3"
Height =
615
Index =
3
Left
= 2160
TabIndex =
14
Top
= 1920
Width =
735
End
Begin VB.CommandButton btnKeys
Caption =
"2"
Height =
615
Index =
2
Left
= 1200
TabIndex =
13
Top
= 1920
Width =
735
End
Begin VB.CommandButton btnKeys
Caption =
"1"
Height =
615
Index =
1
Left
= 240
TabIndex =
12
Top
= 1920
Width =
735
End
Begin VB.CommandButton btnKeys
Caption =
"0"
Height =
615
Index =
0
Left
= 240
TabIndex =
11
Top
= 2640
Width =
735
End
End
Begin VB.Frame fraDisplay
Height =
1215
Left
= 3840
TabIndex =
2
Top
= 0
Width =
5175
Begin VB.OptionButton optPrecision
Caption =
"F"
Height =
240
Index =
5
Left
= 4080
TabIndex =
8
Top
= 850
Width =
375
End
Begin VB.OptionButton optPrecision
Caption =
"4"
Height =
240
Index =
4
Left
= 3480
TabIndex =
7
Top
= 850
Width =
375
End
Begin VB.OptionButton optPrecision
Caption =
"3"
Height =
240
Index =
3
Left
= 2880
TabIndex =
6
Top
= 850
Width =
375
End
Begin VB.OptionButton optPrecision
Caption =
"2"
Height =
240
Index =
2
Left
= 2280
TabIndex =
5
Top
= 850
Value =
-1 'True
Width =
375
End
Begin VB.OptionButton optPrecision
Caption =
"1"
Height =
240
Index =
1
Left
= 1680
TabIndex =
4
Top
= 850
Width =
375
End
Begin VB.OptionButton optPrecision
Caption =
"0"
Height =
240
Index =
0
Left
= 1080
TabIndex =
3
Top
= 850
Width =
375
End
Begin VB.TextBox txtDisplay
Alignment = 1 'Right
Justify
BeginProperty Font
Name
= "MS Sans
Serif"
Size
=
17.25
Charset =
0
Weight =
400
Underline = 0
'False
Italic =
0
'False
Strikethrough = 0
'False
EndProperty
Height =
555
Left
= 120
MaxLength =
35
TabIndex =
0
Top
= 240
Width =
4935
End
Begin VB.Label Label1
Caption =
"Precision"
Height =
195
Left
= 120
TabIndex =
9
Top
= 825
Width =
855
End
End
Begin VB.ListBox lstCalc
BeginProperty Font
Name
= "Courier New"
Size
= 8.25
Charset =
0
Weight =
400
Underline = 0
'False
Italic =
0 'False
Strikethrough = 0
'False
EndProperty
Height =
4470
Left
= 120
TabIndex =
1
Top
= 105
Width =
3615
End
End
Attribute VB_Name = "Form1"
Attribute
VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute
VB_PredeclaredId = True
Attribute VB_Exposed = False
Option
Explicit
Private m_Total As Double
Private m_DataEntered As
Boolean
Private m_OriginalData As Double
Private m_Precision As
Integer
Private m_Operator As Integer
Private m_FromClick As
Boolean
Private m_FormLoaded As Boolean
Private Sub btnAdd_Click()
txtDisplay_KeyPress (43)
End
Sub
Private Sub btnClearAll_Click()
ClearAll
End Sub
Private Sub btnClearDisplay_Click()
ClearDisplay
End Sub
Private Sub btnClearStripList_Click()
ClearStripList
End
Sub
Private Sub btnDivide_Click()
txtDisplay_KeyPress (47)
End
Sub
Private Sub btnEquals_Click()
txtDisplay_KeyPress (13)
End
Sub
Private Sub btnKeys_Click(Index As Integer)
m_FromClick = True
Select
Case Index
Case Is = 11
txtDisplay_KeyPress (46)
'//.
Case Is = 10
txtDisplay_KeyPress (48)
'//0
m_FromClick = True
txtDisplay_KeyPress (48) '//0 = 00
Case Else
txtDisplay_KeyPress (Index + 48) '// 0 to 9
End Select
End Sub
Private Sub btnMinus_Click()
txtDisplay_KeyPress (45)
End
Sub
Private Sub btnMultiply_Click()
txtDisplay_KeyPress (42)
End
Sub
Private Sub Form_Activate()
ClearStripList
End Sub
Private Sub Form_Load()
m_Precision = 2 '//set default to
2
m_DataEntered = True '//set up for first entry
lstCalc.AddItem String(25, " ") & "<Clr>"
lstCalc.Text =
lstCalc.List(0)
m_FormLoaded = True
End Sub
Private Sub lstCalc_Click()
If m_FormLoaded Then
txtDisplay.SetFocus
End Sub
Private Sub optPrecision_Click(Index As Integer)
'//any change to
precision, best to reset, and start over
m_Precision = Index
ClearAll
End Sub
Private Sub txtDisplay_Click()
SendKeys "{END}" '//can't get cursor to
any position other than
rightmost,
'//left arrow disabled
End Sub
Private Sub txtDisplay_DblClick()
txtDisplay.Text = "" '//to
clear the
display,
'//which would normally be highlighted with any double-click
End Sub
Private Sub txtDisplay_KeyDown(KeyCode As Integer, Shift As
Integer)
Select Case KeyCode
Case Is = 46 '//keycode for Del
button
ClearDisplay
KeyCode =
0
txtDisplay.SetFocus
SendKeys
"{END}"
Case Is = 37 '//keycode for left arrow,no need to handle right
arrow,
'//can't get cursor to left
with arrow or mouse (see txtDisplay_Click())
KeyCode =
0
txtDisplay.SetFocus
SendKeys
"{END}"
Case Is = 38 '// up arrow
If
lstCalc.ListIndex > 0 Then lstCalc.ListIndex = lstCalc.ListIndex -
1
If lstCalc.ListIndex = -1 Then lstCalc.ListIndex =
lstCalc.ListCount - 1
txtDisplay.SetFocus
SendKeys "{END}"
Case Is =
40 '// down arrow
If lstCalc.ListIndex <
lstCalc.ListCount - 1 Then
_
lstCalc.ListIndex = lstCalc.ListIndex + 1
txtDisplay.SetFocus
SendKeys "{END}"
End Select
End
Sub
Private Sub txtDisplay_KeyPress(KeyAscii As Integer)
On Error GoTo ErrorHandler
Select Case KeyAscii
Case Is = 13, 42, 43, 45,
47 '//the
operator ascii
codes
'//ensure there is data to work with
If
Val(txtDisplay.Text) = 0 Then KeyAscii = 0: Exit Sub
If Not m_DataEntered Then
m_OriginalData = Val(txtDisplay.Text)
'//transfer screen
data to variable for multiple + or -, without re-entering
data
'//m_DataEntered = true at end of this 'Case', so +
again will only add
the
'//original data, not the displayed data
Do
'// set up escape route for if m_DataEntered, see 2 lines
below
If KeyAscii = 13 Then '
"="
If m_DataEntered
Then
'// allows for 10 x 10 x then =
If m_Operator =
13
Then
'// 10 x 10 x = =
m_OriginalData = 0
m_Total = 0
txtDisplay.Text =
FormatNumber(m_Total)
Exit Do
End
If
'// end 10 x 10 x = =
txtDisplay.Text =
FormatNumber(Val(txtDisplay.Text))
m_OriginalData =
txtDisplay.Text
PrintToStripList txtDisplay.Text,
"="
m_Total =
0
Exit
Do
End
If
'//end allows for 10 x 10 x then =
If
m_Operator = 42 Then '// eg 10 x 10
=
PrintToStripList
txtDisplay.Text, " "
m_Total =
m_Total * Val(txtDisplay.Text)
ElseIf
m_Operator = 47 Then '// eg 10 / 10
=
PrintToStripList
txtDisplay.Text, " "
m_Total =
m_Total / Val(txtDisplay.Text)
ElseIf Not
m_DataEntered Then '//eg 10 + 10 =
PrintToStripList txtDisplay.Text,
"+"
m_Total = m_Total +
Val(txtDisplay.Text)
End
If
m_OriginalData = m_Total '//allow for +
after =
PrintToStripList m_Total,
"="
txtDisplay.Text =
FormatNumber(m_Total)
m_Total =
0
txtDisplay.SetFocus
SendKeys
"{END}"
ElseIf KeyAscii = 43 Then '
"+"
m_Total = m_Total +
FormatNumber(m_OriginalData)
txtDisplay.Text =
FormatNumber(m_Total)
PrintToStripList
m_OriginalData, "+"
ElseIf KeyAscii = 45 Then '
"-"
m_Total = m_Total -
FormatNumber(m_OriginalData)
txtDisplay.Text =
FormatNumber(m_Total)
PrintToStripList
m_OriginalData, "-"
Else
' "*" , "/"
If m_DataEntered And (m_Operator =
42 Or m_Operator = 47) Then
m_Operator =
KeyAscii
'// 10 x 10 x - change to / ie 10 x 10
/
lstCalc.RemoveItem
lstCalc.ListCount - 1
If KeyAscii
= 42 Then PrintToStripList m_Total,
"=x"
If KeyAscii = 47 Then
PrintToStripList m_Total, "=÷"
Exit Do
End
If
'//end new
If m_Operator = 13 Or m_Operator =
43 Or m_Operator = 45 Or m_Operator = 0
Then
If KeyAscii = 42
Then
m_Total =
Val(txtDisplay.Text)
PrintToStripList m_Total, "x"
Else
m_Total =
Val(txtDisplay.Text)
PrintToStripList m_Total, "÷"
End
If
ElseIf m_Operator = 42 Then
'*
PrintToStripList
Val(txtDisplay.Text), " "
m_Total =
m_Total * Val(txtDisplay.Text)
If KeyAscii = 42 Then '// x then x, or x then
÷
PrintToStripList
m_Total, "=x"
Else:
PrintToStripList m_Total, "=÷"
End
If
Else '
/
PrintToStripList
Val(txtDisplay.Text), " "
m_Total =
m_Total / Val(txtDisplay.Text)
PrintToStripList m_Total, "=÷"
End
If
txtDisplay.Text =
m_Total
End If
Exit
Do
'// see comments at "Do"
Loop
'// ditto
m_Operator =
KeyAscii
KeyAscii = 0
m_DataEntered
= True
SendKeys "{END}"
Case Is =
65, 97 '//a and A hotkeys
ClearAll
KeyAscii = 0
Case Is =
68, 100 '//d and D - chose d to match with del
key,
ClearDisplay '//which will also
clear the displayed/unentered data
KeyAscii =
0
Case Is = 83, 115 '//s and
S
ClearStripList
KeyAscii =
0
Case Is = 46, 48, 49, 50, 51, 52, 53, 54, 55,
56, 57 '. and 0 to 9
If m_DataEntered Then txtDisplay.Text =
""
If KeyAscii = 46 And InStr(txtDisplay.Text, ".") >
0 Then KeyAscii = 0
If m_FromClick
Then
txtDisplay.Text = txtDisplay.Text &
Chr$(KeyAscii)
SendKeys
"{END}"
m_FromClick =
False
End If
m_DataEntered =
False
Case Else '//any other keyboard
character, cancel entry
KeyAscii = 0
End
Select
txtDisplay.SetFocus
Exit Sub
ErrorHandler:
MsgBox "Unexpected error. Number too
big?"
KeyAscii = 0
ClearAll
End Sub
Private Sub ClearAll()
m_DataEntered = True
m_OriginalData = 0
m_Total = 0
m_Operator = 0
lstCalc.AddItem String(25, " ") & "<Clr>"
lstCalc.TopIndex =
lstCalc.NewIndex
txtDisplay.Text = FormatNumber(m_Total)
txtDisplay.SetFocus
SendKeys "{END}"
End Sub
Private Sub
ClearDisplay()
m_DataEntered = True
txtDisplay.Text =
FormatNumber(m_Total)
txtDisplay.SetFocus
SendKeys
"{END}"
End Sub
Private Sub ClearStripList()
lstCalc.Clear
ClearAll
lstCalc.Text = lstCalc.List(0)
txtDisplay.SetFocus
End Sub
Private Sub PrintToStripList(ByVal anyNumber As String, ByVal
Operator)
If Operator = "+" Or Operator = "-" Or Operator = "=" Then
_
anyNumber = FormatNumber(anyNumber) 'print unformatted number if *
or /
lstCalc.AddItem String(28 - Len(anyNumber), " ") & anyNumber & " "
& Operator
If Operator = "=" Then lstCalc.AddItem
"=============================="
lstCalc.TopIndex = lstCalc.NewIndex
End
Sub
Private Function FormatNumber(ByVal anyNumber As String) As
String
Select Case m_Precision
Case Is = 0
FormatNumber = Format(anyNumber, "0")
Case Is =
1
FormatNumber = Format(anyNumber, "0.0")
Case
Is = 2
FormatNumber = Format(anyNumber, "0.00")
Case Is = 3
FormatNumber = Format(anyNumber,
"0.000")
Case Is = 4
FormatNumber =
Format(anyNumber, "0.0000")
Case Else
FormatNumber = Format(anyNumber, "0.0000000000")
End Select
anyNumber =
FormatNumber
End Function
Private Function ConvertToPrecision(anyNumber)
Select Case
m_Precision
Case Is = 0
ConvertToPrecision =
Int(anyNumber + 0.5)
Case Is = 1
ConvertToPrecision = Int(anyNumber * 10 + 0.5) / 10
Case Is =
2
ConvertToPrecision = Int(anyNumber * (10 ^ 2) + 0.5) /
(10 ^ 2)
Case Is = 3
ConvertToPrecision =
Int(anyNumber * (10 ^ 3) + 0.5) / (10 ^ 3)
Case Is =
4
ConvertToPrecision = Int(anyNumber * (10 ^ 4) + 0.5) /
(10 ^ 4)
Case Else
ConvertToPrecision =
anyNumber
End Select
End Function
back
top
main page
vb snippets page
java snippets page
vbscript snippets page
email
Page last modified