VB Snippet

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

Your browser does Not support Java Applets.

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