Rapid KeyPad Adder

	Rapid KeyPad Adder in Visual Basic® by Rick Meyer Home

This program allows rapid entry of numbers using the numerical keypad to function like an adding machine. Simply press the digits to form the desired number, then press one of the four function keys to combine that number with the total.

Two listboxes keep track of previously entered numbers and totals.

In keeping with the rapid input concept, decimals are never entered. You may choose to show all output with two places for cents and decimal by checking the [D] checkbox. Therefore, although multiplication and division are supported, you may have to place the decimal mentally.

The FmatList Function demonstrates use of the Format function while the FmatText Function shows how to design your own formatted output. These two also demonstrate how you may make a procedure behave somewhat like a single instance class using Static variables and an Optional parameter to initialize.

Active Keys:

[0] to [9] Input numbers
[+] or [Enter] Add current number to total
[-] Subtract current number from total
[*] Multiply current number by total
[/] Divide total by current number
[End] or [C] Clear current number
[Home] or [A] Clear All
[Back] or [Delete] Erase one digit
[Escape] Quit

[+-*/] with no number uses last entered.

CheckBoxes:

[D] Decimal included automatically
[R] Remember values between sessions
[T] Adder always on Top

Instructions for Form1:

1. Start a new standard exe.
2. On Form1 put a TextBox named Text1
3. Set the Text1.Alignment = vbRightJustify
4. On Form1 put a ListBox named List1
5. On Form1 put a ListBox named List2
6. On Form1 put a CheckBox named Check1
7. On Form1 put a CheckBox named Check2
8. On Form1 put a CheckBox named Check3

There is no need to position or size the above controls
on the form since that is all done in the Form_Load.

Now you are ready for the code. Select all of the following code (by clicking on the word 'Option' three times) and copy it to the clipboard [Ctrl][Insert]. Then paste it into the code window of Form1 with [Shift][Insert].

Variable Key
% As Integer
& As Long
! As Single
# As Double
$ As String

Option Explicit

'=======================================================
'    The Declaration to keep the Adder on top
'=======================================================
Private Declare Function SetWindowPos _
    Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal hWndInsertAfter As Long, _
        ByVal x As Long, _
        ByVal y As Long, _
        ByVal CX As Long, _
        ByVal CY As Long, _
        ByVal wFlags As Long) As Long

'=======================================================
'                  General Declarations
'=======================================================
Const S13 = "             "
Dim iniFile$, FmLt!, FmTp!, Total#, LastEntered#

'=======================================================
'                  Key Entry Events
'=======================================================
Private Sub Form_KeyUp(KeyCode%, Shift%)
    Select Case KeyCode
        Case vbKeyHome:   Form_KeyPress 65 'Clear All
        Case vbKeyEnd:    Form_KeyPress 67 'Clear
        Case vbKeyDelete: Form_KeyPress vbKeyBack
    End Select
End Sub

Private Sub Form_KeyPress(KeyAscii%)
    Const MAXNUM = 9999999999#, MINNUM = -9999999999#
    Static length%, num#, Entered#, sign$
        
    If KeyAscii = 13 Then KeyAscii = 43
    sign = Chr$(KeyAscii)
    
    Select Case KeyAscii
        Case vbKeyEscape: Unload Me: Exit Sub
        Case vbKey0 To vbKey9
            If length < 10 Then
                num = KeyAscii - 48
                Entered = Entered * 10 + num
                length = length + 1
                GoTo out2
            Else
                GoTo out1
            End If
            
        Case vbKeyBack
            If length Then
                length = length - 1
                Entered = Fix(Entered / 10)
                GoTo out2
            Else
                GoTo out1
            End If
            
        Case 65, 97 'A for clear All
            Total = 0: LastEntered = 0
            List2.Clear: List1.Clear
            GoTo out3
            
        Case 67, 99 'C for Clear
            GoTo out3
            
        Case 42
            If Entered = 0 Then Entered = LastEntered
            Total = Total * Entered
                            
        Case 43
            If Entered = 0 Then Entered = LastEntered
            Total = Total + Entered
                
        Case 45
            If Entered = 0 Then Entered = LastEntered
            Total = Total - Entered
                
        Case 47
            If Entered = 0 Then Entered = LastEntered
            If Entered = 0 Then
                Total = 0
            Else
                Total = Fix(Total / Entered + Sgn(Total) * 0.5)
            End If
                    
        Case Else: GoTo out1
    End Select
    
    If Total < MINNUM Or Total > MAXNUM Then Total = 0
    
    While List1.ListCount > 9
        List1.RemoveItem 9
    Wend
    List1.AddItem FmatList(Entered) & sign, 0
    
    While List2.ListCount > 9
        List2.RemoveItem 9
    Wend
    List2.AddItem FmatList(Total), 0
    
    LastEntered = Entered
    
out3: Entered = 0: length = 0
out2: Text1.Text = FmatText(Entered)
    Text1.SetFocus
    Text1_GotFocus
out1: KeyAscii = 0
End Sub

Private Sub Text1_GotFocus()
    Text1.SelStart = Len(Text1.Text)
End Sub

Private Sub Check1_Click()
    FmatText 0, True
    FmatList 0, True
End Sub

Private Sub Check3_Click()
    Dim t&
    'Const SWP_NOSIZE = 1
    'Const SWP_NOMOVE = 2
    'Const HWND_TOPMOST = -1
    'Const HWND_NOTOPMOST = -2
    'The API call for on top
    If Check3 Then t = -1 Else t = -2
    SetWindowPos hwnd, t, 0&, 0&, 0&, 0&, 3&
End Sub

'=======================================================
'            General String Handling
'=======================================================
Private Function AddSlash$(ByVal s$)
    If Right$(s, 1) <> "\" Then s = s & "\"
    AddSlash = s
End Function

Function FmatText$(nbr#, Optional b As Boolean)
    Static c1%, c2%, c3%, d1%, i%, j%, x$
    Dim w$
    
    If b Then
        If Check1 Then
            c1 = 3
            c2 = 7
            c3 = 3
            d1 = 11
        Else
            c1 = 2
            c2 = 6
            c3 = 10
            d1 = 99
        End If
        Exit Function
    End If
    
    If nbr = 0 Then
        FmatText = S13
        Exit Function
    End If
    
    j = 13
    x = S13
    w = CStr(nbr)
        
    For i = Len(w) To 1 Step -1
        Select Case j
            Case d1
                Mid$(x, j, 1) = "."
                j = j - 1
            Case c1, c2, c3
                Mid$(x, j, 1) = ","
                j = j - 1
        End Select
        
        Mid$(x, j, 1) = Mid$(w, i, 1)
        j = j - 1
    Next
    
    FmatText = x
End Function

Function FmatList$(nbr#, Optional b As Boolean)
    Static d#, f1$, x$
    
    If b Then
        If Check1 Then
            f1 = "standard"
            d = 100
        Else
            f1 = "#,###,###,###"
            d = 1
        End If
        Exit Function
    End If

    x = S13
    RSet x = Format(Abs(nbr) / d, f1)
    If nbr < 0 Then x = x & "-"
    FmatList = x
End Function

'=======================================================
'                  Load and Unload
'=======================================================
Private Sub Form_Load()
    Dim f%, deciml%, remember%, ontop%, t1$, t2$

    iniFile = AddSlash(App.Path) & "adder.ini"
    
    If Len(Dir$(iniFile)) <> 0 Then
        On Error GoTo fl2
        f = FreeFile
        Open iniFile For Input As f
        Input #f, FmLt, FmTp
        Input #f, deciml, remember, ontop
        
        If remember Then
            Do Until EOF(f)
                Input #f, t1, t2
                List1.AddItem t1
                List2.AddItem t2
            Loop
            Total = CDbl(List2.List(0))
            LastEntered = CDbl(Left$(List1.List(0), 13))
            If deciml Then
                Total = Total * 100
                LastEntered = LastEntered * 100
            End If
        End If
    End If
        
fl1: On Error GoTo 0
    Close
    
    Caption = "Adder"
    KeyPreview = True
    
    With Text1
        .Move 120, 120, 1575, 255
        .FontName = "Courier New"
        .FontSize = 8
        .Text = ""
    End With
    
    With List1
        .Move 120, 495, 1575, 2370
        .FontName = "Courier New"
        .FontSize = 8
    End With
    
    With List2
        .Move 1800, 495, 1575, 2370
        .FontName = "Courier New"
        .FontSize = 8
    End With
    
    With Check1
        .Move 1800, 165, 600, 195
        .Caption = "D"
        .ToolTipText = "Check for decimal."
        .Value = deciml
    End With
    
    FmatText 0, True
    FmatList 0, True
    
    With Check2
        .Move 2400, 165, 600, 195
        .Caption = "R"
        .ToolTipText = _
            "Check to remember between sessions."
        .Value = remember
    End With
    
    With Check3
        .Move 3000, 165, 600, 195
        .Caption = "T"
        .ToolTipText = "Check for always on top."
        .Value = ontop
    End With
    
    'The API call for on top
    ' also used here for size and position
    SetWindowPos hwnd, (-2 + ontop), (FmLt / 15), _
                (FmTp / 15), 242&, 214&, 0&
    
    Exit Sub
    
fl2: Resume fl1
End Sub

Private Sub Form_Unload(Cancel%)
    Dim f%, j%
    
    f = FreeFile
    Open iniFile For Output As f
    
    If WindowState = vbMinimized Then
        Write #f, FmLt, FmTp
    Else
        Write #f, Left, Top
    End If
    
    Print #f, Check1, Check2, Check3
    
    If Check2 Then
        For j = 0 To List1.ListCount - 1
            Write #f, List1.List(j), List2.List(j)
        Next
    End If
    
    Close
End Sub

Rapid KeyPad Adder

in Visual Basic®