VERSION 2.00
Begin Form FormCalc 
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Tape Calculator"
   ClientHeight    =   3345
   ClientLeft      =   75
   ClientTop       =   900
   ClientWidth     =   7575
   FontBold        =   -1  'True
   FontItalic      =   0   'False
   FontName        =   "Fixedsys"
   FontSize        =   9
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   4275
   Icon            =   TAPECALC.FRX:0000
   KeyPreview      =   -1  'True
   Left            =   15
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3345
   ScaleWidth      =   7575
   Top             =   30
   Width           =   7695
   Begin SSPanel TapePanel 
      BackColor       =   &H00C0C0C0&
      BevelInner      =   1  'Inset
      BorderWidth     =   1
      Caption         =   "Panel3D3"
      Font3D          =   0  'None
      ForeColor       =   &H000000FF&
      Height          =   3345
      Left            =   3405
      TabIndex        =   30
      Top             =   0
      Width           =   4215
      Begin Grid GridTape 
         BorderStyle     =   0  'None
         FixedCols       =   0
         FixedRows       =   0
         GridLines       =   0   'False
         Height          =   3165
         Left            =   75
         Rows            =   1
         ScrollBars      =   2  'Vertical
         TabIndex        =   29
         Top             =   90
         Width           =   4050
      End
      Begin CommonDialog CMDialog1 
         Left            =   0
         Top             =   1440
      End
   End
   Begin Timer Timer1 
      Left            =   6240
      Top             =   1200
   End
   Begin SSPanel ButtonPanel 
      BackColor       =   &H00C0C0C0&
      BevelInner      =   1  'Inset
      BorderWidth     =   1
      Font3D          =   0  'None
      Height          =   3345
      Left            =   0
      TabIndex        =   31
      Top             =   0
      Width           =   3405
      Begin SSCommand TCButton 
         Caption         =   "^"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   18
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   510
         HelpContextID   =   112
         Index           =   28
         Left            =   2265
         TabIndex        =   19
         TabStop         =   0   'False
         Top             =   690
         Width           =   510
      End
      Begin SSCommand TCButton 
         Caption         =   "é"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Wingdings"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H000000C0&
         Height          =   495
         HelpContextID   =   113
         Index           =   23
         Left            =   1680
         TabIndex        =   3
         TabStop         =   0   'False
         Top             =   690
         Width           =   495
      End
      Begin PictureBox PictureMem 
         AutoSize        =   -1  'True
         BorderStyle     =   0  'None
         Height          =   480
         Left            =   120
         Picture         =   TAPECALC.FRX:0302
         ScaleHeight     =   480
         ScaleWidth      =   480
         TabIndex        =   32
         TabStop         =   0   'False
         Top             =   1290
         Visible         =   0   'False
         Width           =   480
      End
      Begin SSPanel PanelResult 
         Alignment       =   4  'Right Justify - MIDDLE
         BackColor       =   &H00000000&
         BevelOuter      =   1  'Inset
         BorderWidth     =   1
         FloodColor      =   &H00C0E0FF&
         Font3D          =   0  'None
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H0000FF00&
         Height          =   495
         Left            =   120
         TabIndex        =   33
         Top             =   120
         Width           =   3165
      End
      Begin SSCommand TCButton 
         Caption         =   "ç"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Wingdings"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H000000C0&
         Height          =   495
         HelpContextID   =   113
         Index           =   21
         Left            =   1080
         TabIndex        =   2
         TabStop         =   0   'False
         Top             =   690
         Width           =   495
      End
      Begin SSCommand TCButton 
         Caption         =   "CE"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H000000C0&
         Height          =   495
         HelpContextID   =   113
         Index           =   20
         Left            =   600
         TabIndex        =   1
         TabStop         =   0   'False
         Top             =   690
         Width           =   495
      End
      Begin SSCommand TCButton 
         Caption         =   "C"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H000000C0&
         Height          =   495
         HelpContextID   =   113
         Index           =   19
         Left            =   120
         TabIndex        =   0
         TabStop         =   0   'False
         Top             =   690
         Width           =   495
      End
      Begin SSCommand TCButton 
         Caption         =   "MC"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00800080&
         Height          =   375
         HelpContextID   =   111
         Index           =   18
         Left            =   120
         TabIndex        =   4
         TabStop         =   0   'False
         Top             =   1770
         Width           =   525
      End
      Begin SSCommand TCButton 
         Caption         =   "MR"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00800080&
         Height          =   375
         HelpContextID   =   111
         Index           =   17
         Left            =   120
         TabIndex        =   5
         TabStop         =   0   'False
         Top             =   2130
         Width           =   525
      End
      Begin SSCommand TCButton 
         Caption         =   "MS"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00800080&
         Height          =   375
         HelpContextID   =   111
         Index           =   16
         Left            =   120
         TabIndex        =   6
         TabStop         =   0   'False
         Top             =   2490
         Width           =   525
      End
      Begin SSCommand TCButton 
         Caption         =   "M+"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00800080&
         Height          =   375
         HelpContextID   =   111
         Index           =   15
         Left            =   120
         TabIndex        =   7
         TabStop         =   0   'False
         Top             =   2850
         Width           =   525
      End
      Begin SSCommand TCButton 
         Caption         =   "="
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00C0C000&
         Height          =   510
         HelpContextID   =   115
         Index           =   14
         Left            =   2775
         TabIndex        =   28
         TabStop         =   0   'False
         Top             =   2730
         Width           =   510
      End
      Begin SSCommand TCButton 
         Caption         =   "1/x"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00008000&
         Height          =   510
         HelpContextID   =   113
         Index           =   13
         Left            =   2775
         TabIndex        =   26
         TabStop         =   0   'False
         Top             =   1710
         Width           =   510
      End
      Begin SSCommand TCButton 
         Caption         =   "%"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00C0C000&
         Height          =   510
         HelpContextID   =   114
         Index           =   12
         Left            =   2775
         TabIndex        =   27
         TabStop         =   0   'False
         Top             =   2220
         Width           =   510
      End
      Begin SSCommand TCButton 
         Caption         =   "Ö`"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Symbol"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00008000&
         Height          =   510
         HelpContextID   =   113
         Index           =   11
         Left            =   2775
         TabIndex        =   25
         TabStop         =   0   'False
         Top             =   1200
         Width           =   510
      End
      Begin SSCommand TCButton 
         Caption         =   "/"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   510
         HelpContextID   =   112
         Index           =   27
         Left            =   2265
         TabIndex        =   20
         TabStop         =   0   'False
         Top             =   1200
         Width           =   510
      End
      Begin SSCommand TCButton 
         Caption         =   "*"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   510
         HelpContextID   =   112
         Index           =   26
         Left            =   2265
         TabIndex        =   21
         TabStop         =   0   'False
         Top             =   1710
         Width           =   510
      End
      Begin SSCommand TCButton 
         Caption         =   "-"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   510
         HelpContextID   =   112
         Index           =   25
         Left            =   2265
         TabIndex        =   22
         TabStop         =   0   'False
         Top             =   2220
         Width           =   510
      End
      Begin SSCommand TCButton 
         Caption         =   "+"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   510
         HelpContextID   =   112
         Index           =   24
         Left            =   2265
         TabIndex        =   23
         TabStop         =   0   'False
         Top             =   2730
         Width           =   510
      End
      Begin SSCommand TCButton 
         Caption         =   "."
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Symbol"
         FontSize        =   17.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00800000&
         Height          =   495
         HelpContextID   =   110
         Index           =   10
         Left            =   1200
         TabIndex        =   18
         TabStop         =   0   'False
         Top             =   2730
         Width           =   495
      End
      Begin SSCommand TCButton 
         Caption         =   "±"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   18
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00008000&
         Height          =   510
         HelpContextID   =   113
         Index           =   22
         Left            =   2775
         TabIndex        =   24
         TabStop         =   0   'False
         Top             =   690
         Width           =   510
      End
      Begin SSCommand TCButton 
         Caption         =   "9"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00800000&
         Height          =   495
         HelpContextID   =   110
         Index           =   9
         Left            =   1680
         TabIndex        =   10
         TabStop         =   0   'False
         Top             =   1290
         Width           =   495
      End
      Begin SSCommand TCButton 
         Caption         =   "8"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00800000&
         Height          =   495
         HelpContextID   =   110
         Index           =   8
         Left            =   1200
         TabIndex        =   9
         TabStop         =   0   'False
         Top             =   1290
         Width           =   495
      End
      Begin SSCommand TCButton 
         Caption         =   "7"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00800000&
         Height          =   495
         HelpContextID   =   110
         Index           =   7
         Left            =   720
         TabIndex        =   8
         TabStop         =   0   'False
         Top             =   1290
         Width           =   495
      End
      Begin SSCommand TCButton 
         Caption         =   "6"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00800000&
         Height          =   495
         HelpContextID   =   110
         Index           =   6
         Left            =   1680
         TabIndex        =   13
         TabStop         =   0   'False
         Top             =   1770
         Width           =   495
      End
      Begin SSCommand TCButton 
         Caption         =   "5"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00800000&
         Height          =   495
         HelpContextID   =   110
         Index           =   5
         Left            =   1200
         TabIndex        =   12
         TabStop         =   0   'False
         Top             =   1770
         Width           =   495
      End
      Begin SSCommand TCButton 
         Caption         =   "4"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00800000&
         Height          =   495
         HelpContextID   =   110
         Index           =   4
         Left            =   720
         TabIndex        =   11
         TabStop         =   0   'False
         Top             =   1770
         Width           =   495
      End
      Begin SSCommand TCButton 
         Caption         =   "3"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00800000&
         Height          =   495
         HelpContextID   =   110
         Index           =   3
         Left            =   1680
         TabIndex        =   16
         TabStop         =   0   'False
         Top             =   2250
         Width           =   495
      End
      Begin SSCommand TCButton 
         Caption         =   "2"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00800000&
         Height          =   495
         HelpContextID   =   110
         Index           =   2
         Left            =   1200
         TabIndex        =   15
         TabStop         =   0   'False
         Top             =   2250
         Width           =   495
      End
      Begin SSCommand TCButton 
         Caption         =   "1"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00800000&
         Height          =   495
         HelpContextID   =   110
         Index           =   1
         Left            =   720
         TabIndex        =   14
         TabStop         =   0   'False
         Top             =   2250
         Width           =   495
      End
      Begin SSCommand TCButton 
         Caption         =   "0"
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   13.5
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00800000&
         Height          =   495
         HelpContextID   =   110
         Index           =   0
         Left            =   720
         TabIndex        =   17
         TabStop         =   0   'False
         Top             =   2730
         Width           =   495
      End
      Begin MhState NumLockState 
         BackColor       =   &H00C0C0C0&
         Height          =   420
         Left            =   1740
         Style           =   1  'Num Lock
         TabIndex        =   34
         TabStop         =   0   'False
         TimerInterval   =   1000
         Top             =   2790
         Value           =   0   'False
         Width           =   420
      End
   End
   Begin Menu mnu_Main 
      Caption         =   "&File"
      HelpContextID   =   101
      Index           =   0
      Begin Menu mnu_File 
         Caption         =   "&New tape"
         HelpContextID   =   101
         Index           =   0
         Shortcut        =   ^N
      End
      Begin Menu mnu_File 
         Caption         =   "&Save tape"
         HelpContextID   =   101
         Index           =   1
      End
      Begin Menu mnu_File 
         Caption         =   "Save tape &As..."
         HelpContextID   =   101
         Index           =   2
      End
      Begin Menu mnu_File 
         Caption         =   "-"
         Index           =   3
      End
      Begin Menu mnu_File 
         Caption         =   "E&xit"
         HelpContextID   =   101
         Index           =   4
      End
   End
   Begin Menu mnu_Main 
      Caption         =   "&Edit"
      Index           =   1
      Begin Menu mnu_Edit 
         Caption         =   "&Copy"
         HelpContextID   =   102
         Index           =   0
         Shortcut        =   ^C
      End
      Begin Menu mnu_Edit 
         Caption         =   "&Paste"
         HelpContextID   =   103
         Index           =   1
         Shortcut        =   ^V
      End
      Begin Menu mnu_Edit 
         Caption         =   "Copy &Result"
         HelpContextID   =   116
         Index           =   2
         Shortcut        =   ^R
      End
      Begin Menu mnu_Edit 
         Caption         =   "-"
         Index           =   3
      End
      Begin Menu mnu_Edit 
         Caption         =   "Paste &Options..."
         HelpContextID   =   106
         Index           =   4
      End
   End
   Begin Menu mnu_Main 
      Caption         =   "&View"
      Index           =   2
      Begin Menu mnu_View 
         Caption         =   "&Tape Visible"
         Checked         =   -1  'True
         HelpContextID   =   107
         Index           =   0
      End
      Begin Menu mnu_View 
         Caption         =   "Tape &Font..."
         HelpContextID   =   108
         Index           =   1
      End
      Begin Menu mnu_View 
         Caption         =   "-"
         Index           =   2
      End
      Begin Menu mnu_View 
         Caption         =   "Floating &Point"
         HelpContextID   =   109
         Index           =   3
      End
      Begin Menu mnu_View 
         Caption         =   "Fixed - &2 decimals"
         HelpContextID   =   109
         Index           =   4
      End
      Begin Menu mnu_View 
         Caption         =   "Fixed - &4 decimals"
         HelpContextID   =   109
         Index           =   5
      End
   End
   Begin Menu mnu_Main 
      Caption         =   "&Help"
      HelpContextID   =   104
      Index           =   3
      Begin Menu mnu_Help 
         Caption         =   "&Contents"
         HelpContextID   =   104
         Index           =   0
      End
      Begin Menu mnu_Help 
         Caption         =   "&Search for Help on..."
         HelpContextID   =   104
         Index           =   1
      End
      Begin Menu mnu_Help 
         Caption         =   "&How to Use Help"
         HelpContextID   =   104
         Index           =   2
      End
      Begin Menu mnu_Help 
         Caption         =   "-"
         Index           =   3
      End
      Begin Menu mnu_Help 
         Caption         =   "&About TapeCalc..."
         HelpContextID   =   104
         Index           =   4
      End
   End
End
Option Explicit

Const MODAL = 1

Dim Entry#      ' value entered in calculator
Dim Accum#      ' accumulated result of calculations
Dim Memory#     ' the value controlled by memory buttons
Dim EntryStr$   ' string equivalent of value entered
Dim ButtonUp%   ' button equivalent to last key pressed;
                '  used to show button down/up

Dim State%      ' effect of buttons depends on state; value is
                '  one of following constants
Const STATE_FIRST = 0     ' entering first number
Const STATE_OP = 1      ' entered an operator; first number frozen
Const STATE_SECOND = 2    ' entering second number
Const STATE_FROZE = 3     ' second number frozen
Const STATE_OVERFLOW = 4  ' calculation overflowed; must press clear

Dim Op%         ' the pending operation; value is one of following
Const OPS_NONE = 0
Const OPS_PLUS = 1
Const OPS_MINUS = 2
Const OPS_TIMES = 3
Const OPS_DIVIDE = 4
' If you add another operator, define a constant for it that
'  has the current value of OPS_POWER, and add one to
'  the value of OPS_POWER
Const OPS_POWER = 5


Dim CharsInTape%    ' number of chars that fit in tape's
                    '  width (changes with font)
Dim GridBaseHeight% ' defined height of tape
Dim LinesShown%     ' actual number of lines shown in grid
                    '  (changes with font)

Dim FixedFloat%     ' fixed or floating point format for results
Dim FormatStr$(0 To 4) ' strings to produce fixed, 2-decimal, 4-decimal
                       '  formats, plus font-specific regular and
                       '  scientific notation for too-wide numbers

Dim TapeFileName$
Dim AddWhere%   ' determines where (if at all) to insert
                '  operators during paste from clipboard
Dim AddWhat%    ' determines what operator to insert during
                '  paste from clipboard
Dim AddOp%(0 To 4) ' string used for operator during paste
                   '  from clipboard

Dim Sync% ' used to keep Entry and EntryStr in sync
Const SYNC_StrAhead = 0
Const SYNC_NumAhead = 1
Const SYNC_InSync = 2

Dim TapeLength%   ' number of lines saved in tape. If more
                  '  lines added, oldest lines are discarded

Const BTN_0 = 0
Const BTN_1 = 1
Const BTN_2 = 2
Const BTN_3 = 3
Const BTN_4 = 4
Const BTN_5 = 5
Const BTN_6 = 6
Const BTN_7 = 7
Const BTN_8 = 8
Const BTN_9 = 9
Const BTN_DEC = 10
Const BTN_SQRT = 11
Const BTN_PERCENT = 12
Const BTN_INVERSE = 13
Const BTN_EQUAL = 14
Const BTN_MP = 15
Const BTN_MS = 16
Const BTN_MR = 17
Const BTN_MC = 18
Const BTN_CLEAR = 19
Const BTN_CE = 20
Const BTN_BACKSPACE = 21
Const BTN_PLUSMINUS = 22
Const BTN_ADVANCE = 23
' Add constants for any new non-operator
'   buttons in order here, and update values
'   of operator button constants that follow
Const BTN_PLUS = 24
Const BTN_MINUS = 25
Const BTN_TIMES = 26
Const BTN_DIVIDE = 27
' If you add a new binary operator button, define a BTN_
'  constant for it that has the current value of BTN_POWER.
'  Add 1 to the value of BTN_POWER, and make sure that
'  the Index property of the power button and the new button
'  are the same as their BTN_XXXX constants.
'The code for handling the new operator goes in
'  the Operate subroutine.
Const BTN_POWER = 28

Const OPBTN_FIRST = BTN_PLUS
Const OPBTN_LAST = BTN_POWER

' Windows API function call declarations
Declare Function GetTextExtent& Lib "GDI" (ByVal hDC%, ByVal lpString$, ByVal nCount%)
Declare Function GetSystemMetrics% Lib "User" (ByVal nIndex%)
Const SM_CXVSCROLL = 2

Declare Function SendMessage& Lib "User" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, lParam As Any)
Const BM_SETSTATE = &H403

Declare Sub MessageBeep Lib "User" (ByVal wType%)

Declare Function GetPrivateProfileInt% Lib "Kernel" (ByVal lpApplicationName$, ByVal lpKeyName$, ByVal nDefault%, ByVal lpFileName$)
Declare Function WritePrivateProfileString% Lib "Kernel" (ByVal lpApplicationName$, ByVal lpKeyName$, ByVal lpString$, ByVal lplFileName$)
Declare Function GetPrivateProfileString% Lib "Kernel" (ByVal lpApplicationName$, ByVal lpKeyName As Any, ByVal lpDefault$, ByVal lpReturnedString$, ByVal nSize%, ByVal lpFileName$)

Sub AddToTape (ByVal S1$, ByVal S2$)
  ' Add number in S1, symbol in S2 to tape
  If S1 = "" Then S1 = "0"
  ' If tape is full, discard first line
  If GridTape.Rows = TapeLength Then GridTape.RemoveItem 0
  GridTape.AddItem S1 + Chr$(9) + " " + S2
  ' Bring new line into view
  If GridTape.Rows > LinesShown Then
    GridTape.TopRow = GridTape.Rows - LinesShown
  End If
End Sub

Sub Dispatch (ByVal vState%, ByVal C%)
  ' Pass value of pressed button to the appropriate
  '  function, depending on the current state
  Select Case vState
    Case STATE_FIRST
      StateFirst C
    Case STATE_OP
      StateOp C
    Case STATE_SECOND
      StateSecond C
    Case STATE_FROZE
      StateFroze C
    Case STATE_OVERFLOW
      StateOverflow C
  End Select
  SyncUp
End Sub

Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
  ' Handle keys that aren't detected by KeyPress. Converts
  '  them into the equivalent of button-presses
  Dim Success%
  ' If a button is visibly pressed, un-press it
  If ButtonUp >= BTN_0 Then
    Success = SendMessage(TCButton(ButtonUp).hWnd, BM_SETSTATE, 0, 0)
    ButtonUp = -1
  End If
  ' Constants defining virtual keys
  Const VK_DELETE = &H2E
  Const VK_F2 = &H71
  Const VK_F3 = &H72
  Const VK_F4 = &H73
  Const VK_F5 = &H74
  Const VK_F6 = &H75
  Const VK_F7 = &H76
  Const VK_F8 = &H77
  Const VK_F9 = &H78
  Select Case KeyCode
    Case 13, 32
      KeyCode = 0
    Case VK_F2
      ButtonUp = BTN_PLUSMINUS
    Case VK_F3
      ButtonUp = BTN_SQRT
    Case VK_F4
      ButtonUp = BTN_INVERSE
    Case VK_F5
      ButtonUp = BTN_MC
    Case VK_F6
      ButtonUp = BTN_MR
    Case VK_F7
      ButtonUp = BTN_MS
    Case VK_F8
      ButtonUp = BTN_MP
    Case VK_F9
      ButtonUp = BTN_ADVANCE
    Case VK_DELETE
      ButtonUp = BTN_CE
  End Select
  If ButtonUp >= 0 Then
    ' Visibly press the corresponding button, and set the timer
    '  to un-press it in 0.3 seconds.
    Success = SendMessage(TCButton(ButtonUp).hWnd, BM_SETSTATE, 1, 0)
    TCButton(ButtonUp).SetFocus
    Timer1.Interval = 300
    Dispatch State, ButtonUp
  End If
End Sub

Sub Form_KeyPress (KeyAscii As Integer)
  Dim Success%
  ' If a button is visibly pressed, un-press it.
  If ButtonUp >= BTN_0 Then
    Success = SendMessage(TCButton(ButtonUp).hWnd, BM_SETSTATE, 0, 0)
    ButtonUp = -1
  End If
  ButtonUp = -1
  Select Case KeyAscii
    Case 8 ' Backspace
      ButtonUp = BTN_BACKSPACE
    Case 27 ' Escape
      ButtonUp = BTN_CLEAR
    Case 37 ' %
      ButtonUp = BTN_PERCENT
    Case 42 ' *
      ButtonUp = BTN_TIMES
    Case 43 ' +
      ButtonUp = BTN_PLUS
    Case 45 ' -
      ButtonUp = BTN_MINUS
    Case 46 ' .
      ButtonUp = BTN_DEC
    Case 47 ' /
      ButtonUp = BTN_DIVIDE
    Case 48 ' 0
      ButtonUp = BTN_0
    Case 49 ' 1
      ButtonUp = BTN_1
    Case 50 ' 2
      ButtonUp = BTN_2
    Case 51 ' 3
      ButtonUp = BTN_3
    Case 52 ' 4
      ButtonUp = BTN_4
    Case 53 ' 5
      ButtonUp = BTN_5
    Case 54 ' 6
      ButtonUp = BTN_6
    Case 55 ' 7
      ButtonUp = BTN_7
    Case 56 ' 8
      ButtonUp = BTN_8
    Case 57 ' 9
      ButtonUp = BTN_9
    Case 61, 13 ' = or Enter
      ButtonUp = BTN_EQUAL
    Case 94 ' ^
      ButtonUp = BTN_POWER
  End Select
  If ButtonUp >= 0 Then
    ' Visibly press the corresponding button, and set the timer
    '  to un-press it in 0.3 seconds.
    Success = SendMessage(TCButton(ButtonUp).hWnd, BM_SETSTATE, 1, 0)
    TCButton(ButtonUp).SetFocus
    Timer1.Interval = 300
    Dispatch State, ButtonUp
  End If
End Sub

Sub Form_Load ()
  Dim N%
  ' Initialize variables
  FormatStr(0) = "#,,0.###############"
  FormatStr(1) = "Standard"
  FormatStr(2) = "#,,0.0000"
  Entry = 0
  EntryStr = ""
  Accum = 0
  Memory = 0
  ButtonUp = -1
  State = STATE_FIRST
  Op = OPS_NONE
  Sync = SYNC_InSync
  TapeFileName = ""
  AddOp(0) = 43 ' +
  AddOp(1) = 45 ' -
  AddOp(2) = 42 ' *
  AddOp(3) = 47 ' /
  AddOp(4) = 94 ' ^

  ' Get stored values from INI file
  mnu_View(0).Checked = GetPrivateProfileInt("Options", "TapeVisible", True, "TAPECALC.INI")
  FixedFloat = GetPrivateProfileInt("Options", "FixedFloat", 0, "TAPECALC.INI")
  mnu_View(FixedFloat + 3).Checked = True
  If mnu_View(0).Checked Then
    FormCalc.Width = ButtonPanel.Width + TapePanel.Width + 30
  Else
    FormCalc.Width = ButtonPanel.Width + 30
  End If
  TapeLength = GetPrivateProfileInt("Options", "TapeLength", 255, "TAPECALC.INI")
  AddWhere = GetPrivateProfileInt("Options", "PasteAddWhere", 0, "TAPECALC.INI")
  AddWhat = GetPrivateProfileInt("Options", "PasteAddWhat", 0, "TAPECALC.INI")
  Left = GetPrivateProfileInt("Position", "Main Left", 120, "TAPECALC.INI")
  Top = GetPrivateProfileInt("Position", "Main Top", 120, "TAPECALC.INI")
  ' If main form's stored position is off-screen, put it on-screen
  If Left + Width > Screen.Width Then Left = Screen.Width - Width
  If Top + Height > Screen.Height Then Top = Screen.Height - Height
  FormOptions.Left = GetPrivateProfileInt("Position", "Options Left", 240, "TAPECALC.INI")
  FormOptions.Top = GetPrivateProfileInt("Position", "Options Top", 240, "TAPECALC.INI")
  ' If options form's stored position is off-screen, put it on-screen
  If FormOptions.Left + FormOptions.Width > Screen.Width Then
    FormOptions.Left = Screen.Width - FormOptions.Width
  End If
  If FormOptions.Top + FormOptions.Height > Screen.Height Then
    FormOptions.Top = Screen.Height - FormOptions.Height
  End If
  GridTape.FontBold = GetPrivateProfileInt("Font", "Bold", True, "TAPECALC.INI")
  GridTape.FontItalic = GetPrivateProfileInt("Font", "Italic", False, "TAPECALC.INI")
  GridTape.FontSize = GetPrivateProfileInt("Font", "Size", 8, "TAPECALC.INI")
  Dim FntNam$, FntNamLen%
  FntNam = Space$(81)
  FntNamLen = GetPrivateProfileString("Font", "Name", "MS Sans Serif", FntNam, 80, "TAPECALC.INI")
  GridTape.FontName = Left(FntNam, FntNamLen)
  ' Set font info for Picture because we use its hDC
  PictureMem.FontBold = GridTape.FontBold
  PictureMem.FontItalic = GridTape.FontItalic
  PictureMem.FontSize = GridTape.FontSize
  PictureMem.FontName = GridTape.FontName
  ' Perform necessary run-time initialization
  GridTape.ColAlignment(0) = 1 ' right align
  GridBaseHeight = GridTape.Height
  GetTapeMetrics
  ' Fill visible portion of tape with blank lines
  For N = 1 To LinesShown
    GridTape.AddItem ""
  Next N
End Sub

Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
  ' Save position of both windows to INI file
  Dim Success%
  If WindowState = 0 Then ' record main form's position if NOT iconic
    Success = WritePrivateProfileString("Position", "Main Top", Format$(Top), "TAPECALC.INI")
    Success = WritePrivateProfileString("Position", "Main Left", Format$(Left), "TAPECALC.INI")
  End If
  Success = WritePrivateProfileString("Position", "Options Top", Format$(FormOptions.Top), "TAPECALC.INI")
  Success = WritePrivateProfileString("Position", "Options Left", Format$(FormOptions.Left), "TAPECALC.INI")
  ' It's polite to close the help system when the program ends
  Const HELP_QUIT = &H2
  CMDialog1.HelpCommand = HELP_QUIT
  CMDialog1.Action = 6
End Sub

Sub Form_Unload (Cancel As Integer)
  ' When unloading main form, don't forget the option form!
  Unload FormOptions
End Sub

Sub GetTapeMetrics ()
  ' Adjust variables to selected font
  Dim TextEx&, TestStr$, PixelsPerDigit%, LineHeight%, N%, FmtWid%
  TestStr$ = "0123456789"
  TextEx = GetTextExtent(PictureMem.hDC, TestStr, 10)
  PixelsPerDigit = (TextEx Mod &H10000) \ 10
  ' Set tape columns to fill tape's width exactly
  GridTape.ColWidth(1) = (PixelsPerDigit * 4) * Screen.TwipsPerPixelX
  GridTape.ColWidth(0) = GridTape.Width - GridTape.ColWidth(1) - (GetSystemMetrics(SM_CXVSCROLL) * Screen.TwipsPerPixelX)
  LineHeight = ((TextEx \ &H10000) + 2) * Screen.TwipsPerPixelY
  ' Calculate number of lines that will show in current font
  LinesShown = GridBaseHeight \ LineHeight
  ' Set tape height to avoid partial lines
  GridTape.Height = LinesShown * LineHeight
  ' Set existing rows to new height
  For N = 0 To GridTape.Rows - 1
    GridTape.RowHeight(N) = LineHeight
  Next N
  ' Adjust tape if necessary so last line is shown
  If GridTape.Rows > LinesShown Then
    GridTape.TopRow = GridTape.Rows - LinesShown
  End If
  ' Calculate how many characters fit in tape's width
  CharsInTape = (GridTape.Width \ Screen.TwipsPerPixelX) \ PixelsPerDigit
  FmtWid = CharsInTape - 14
  If FmtWid > 14 Then FmtWid = 14
  ' Create scientific format string for use with too-wide numbers
  FormatStr(3) = "0." + String$(FmtWid, "0") + "E+00"
  TextEx = 0
End Sub

Sub GridTape_KeyDown (KeyCode As Integer, Shift As Integer)
  ' Prevents the user from accidentally "shoving" the
  ' left column of the grid off-screen.
  Const VK_RIGHT = &H27
  GridTape.Col = 0
  If KeyCode = VK_RIGHT Then KeyCode = 0
End Sub

Sub GridTape_MouseMove (Button As Integer, Shift As Integer, X As Single, y As Single)
  ' Prevents the user from accidentally "shoving" the
  ' left column of the grid off-screen.
  GridTape.LeftCol = 0
End Sub

Sub GridTape_RowColChange ()
  ' Prevents the user from accidentally "shoving" the
  ' left column of the grid off-screen.
  GridTape.LeftCol = 0
End Sub

Sub GridTape_SelChange ()
  ' Prevents the user from accidentally "shoving" the
  ' left column of the grid off-screen.
  GridTape.LeftCol = 0
End Sub

Sub mnu_Edit_Click (Index As Integer)
  Dim N%, Txt$, AscVal%
  Select Case Index
    Case 0
      ' Copy all or selected tape to clipboard
      If SelectedTape(Txt) > 0 Then
        Clipboard.Clear
        Clipboard.SetText Txt
      End If
    Case 1
      ' Paste clipboard into tape, optionally adding
      '  an operator after each number or each line
      Txt = Clipboard.GetText(1)
      If Txt <> "" Then
        For N = 1 To Len(Txt)
          AscVal = Asc(Mid(Txt, N, 1))
          Select Case AscVal
            Case 37, 42, 43, 45 To 57, 61, 94
              Form_KeyPress (AscVal)
            Case 44 ' ignore
            Case Else
              Select Case AddWhere
                Case 0 ' ignore
                Case 1 ' add after word
                  Form_KeyPress (AddOp(AddWhat))
                Case 2 ' add after line
                  If AscVal = 13 Then
                    Form_KeyPress (AddOp(AddWhat))
                  End If
              End Select
          End Select
        Next N
      End If
    Case 2
      ' Copy result to clipboard
      Clipboard.SetText PanelResult.Caption
    Case 4 ' Options dialog
      ' Initialize controls to current values
      For N = 0 To 2
        FormOptions.OptionWhere(N).Value = False
        FormOptions.OptionWhat(N).Value = False
      Next N
      FormOptions.OptionWhat(3).Value = False
      FormOptions.OptionWhere(AddWhere) = True
      FormOptions.OptionWhat(AddWhat) = True
      FormOptions.TextTapeLen.Text = Format$(TapeLength)
      FormOptions.Show MODAL
      ' If OK selected, make use of changed values
      If FormOptions.Tag = 1 Then
        For N = 0 To 2
          If FormOptions.OptionWhere(N).Value Then AddWhere = N
          If FormOptions.OptionWhat(N).Value Then AddWhat = N
        Next N
        If FormOptions.OptionWhat(3).Value Then AddWhat = 3
        'TapeLength value returned
        TapeLength = Val(FormOptions.TextTapeLen.Text)
        If TapeLength < 40 Then TapeLength = 40
        If TapeLength > 1000 Then TapeLength = 1000
        Dim Success%
        Success = WritePrivateProfileString("Options", "TapeLength", Format$(TapeLength), "TAPECALC.INI")
        Success = WritePrivateProfileString("Options", "PasteAddWhere", Format$(AddWhere), "TAPECALC.INI")
        Success = WritePrivateProfileString("Options", "PasteAddWhat", Format$(AddWhat), "TAPECALC.INI")
        ' Delete rows if necessary to fit in new length
        Do While GridTape.Rows > TapeLength
          GridTape.RemoveItem 0
        Loop
      End If
  End Select
End Sub

Sub mnu_File_Click (Index As Integer)
  On Error GoTo FileError
  Select Case Index
    Case 0 ' new tape
      GridTape.Rows = 1
      Dim N%
      For N = 1 To LinesShown
        GridTape.AddItem ""
      Next N
      EntryStr = ""
      Entry = 0
      Accum = 0
      Sync = SYNC_InSync
      PanelResult.Caption = ""
      Op = OPS_NONE
      State = STATE_FIRST
      TapeFileName = ""
      Caption = "TapeCalc"
    Case 1 ' save tape
      If TapeFileName = "" Then
        mnu_File_Click (2)
      Else
        SaveFile
      End If
    Case 2 ' save as
      CMDialog1.CancelError = True
      CMDialog1.DefaultExt = "TAP"
      CMDialog1.DialogTitle = "Save Tape As"
      If TapeFileName = "" Then
        CMDialog1.Filename = "TAPEFILE.TAP"
      Else
        CMDialog1.Filename = TapeFileName
      End If
      CMDialog1.FilterIndex = 0
      CMDialog1.Filter = "Tape Files (*.tap)|*.tap|Text Files (*.txt)|*.txt"
      CMDialog1.HelpCommand = 0
      CMDialog1.HelpContext = 0
      CMDialog1.HelpFile = ""
      CMDialog1.HelpKey = ""
      CMDialog1.InitDir = ""
      CMDialog1.MaxFileSize = 256

      ' Constants for file open/save common dialog
      Const OFN_OVERWRITEPROMPT = &H2&
      Const OFN_HIDEREADONLY = &H4&
      Const OFN_PATHMUSTEXIST = &H800&

      CMDialog1.Flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_PATHMUSTEXIST
      CMDialog1.Action = 2
      TapeFileName = CMDialog1.Filename
      SaveFile
      Caption = "TapeCalc - (" + TapeFileName + ")"
    Case 4
      Unload Me
  End Select
  Exit Sub
FileError:
  Exit Sub
End Sub

Sub mnu_Help_Click (Index As Integer)
  CMDialog1.HelpFile = "TAPECALC.HLP"
  ' Constants for help system
  Const HELP_CONTEXT = &H1
  Const HELP_HELPONHELP = &H4
  Const HELP_PARTIALKEY = &H105
  Select Case Index
    Case 0 ' Contents
      CMDialog1.HelpContext = 0
      CMDialog1.HelpCommand = HELP_CONTEXT
      CMDialog1.Action = 6
    Case 1 ' Search for Help On...
      CMDialog1.HelpKey = ""
      CMDialog1.HelpCommand = HELP_PARTIALKEY
      CMDialog1.Action = 6
    Case 2 ' Help On Help
      CMDialog1.HelpCommand = HELP_HELPONHELP
      CMDialog1.Action = 6
    Case 4 ' About TapeCalc...
      DisplayAboutBox FormCalc, "TAPECALC", 1#, 1995, "Neil J. Rubenking", "First Published in PC Magazine", "February 7, 1995, U.S. Edition", 0, False, 0, &HC0C0C0
  End Select
End Sub

Sub mnu_View_Click (Index As Integer)
  Dim Success%
  On Error GoTo ViewError
  Select Case Index
    Case 0 ' Tape Visible
      If mnu_View(0).Checked Then
        FormCalc.Move Left, Top, ButtonPanel.Width + 30
      Else
        FormCalc.Move Left, Top, TapePanel.Left + TapePanel.Width + 30
      End If
      mnu_View(0).Checked = Not mnu_View(0).Checked
      Success = WritePrivateProfileString("Options", "TapeVisible", Format$(mnu_View(0).Checked), "TAPECALC.INI")
    Case 1 ' Tape font
      CMDialog1.CancelError = True
      CMDialog1.FontBold = GridTape.FontBold
      CMDialog1.FontItalic = GridTape.FontItalic
      CMDialog1.FontName = GridTape.FontName
      CMDialog1.FontSize = GridTape.FontSize
      CMDialog1.HelpCommand = 0
      CMDialog1.HelpContext = 0
      CMDialog1.HelpFile = ""
      CMDialog1.HelpKey = ""
      CMDialog1.Max = 20
      CMDialog1.Min = 6

      ' Constants for font common dialog
      Const CF_SCREENFONTS = &H1&
      Const CF_ANSIONLY = &H400&
      Const CF_LIMITSIZE = &H2000&
      Const CF_FORCEFONTEXIST = &H10000

      CMDialog1.Flags = CF_ANSIONLY Or CF_FORCEFONTEXIST Or CF_SCREENFONTS Or CF_LIMITSIZE
      CMDialog1.Action = 4
     ' Store font info in PictureMem because we use its
     '  hDC property to make calculations.
      PictureMem.FontBold = CMDialog1.FontBold
      PictureMem.FontItalic = CMDialog1.FontItalic
      PictureMem.FontName = CMDialog1.FontName
      PictureMem.FontSize = CMDialog1.FontSize
      GridTape.FontBold = CMDialog1.FontBold
      GridTape.FontItalic = CMDialog1.FontItalic
      GridTape.FontName = CMDialog1.FontName
      GridTape.FontSize = CMDialog1.FontSize
      ' Store changes in INI file
      Success = WritePrivateProfileString("Font", "Bold", Format$(GridTape.FontBold), "TAPECALC.INI")
      Success = WritePrivateProfileString("Font", "Italic", Format$(GridTape.FontItalic), "TAPECALC.INI")
      Success = WritePrivateProfileString("Font", "Size", Format$(GridTape.FontSize), "TAPECALC.INI")
      Success = WritePrivateProfileString("Font", "Name", GridTape.FontName, "TAPECALC.INI")
      ' Recalculate number of tape lines visible etc.
      GetTapeMetrics
    Case 3 To 5 ' Set fixed/floating option
      mnu_View(3).Checked = False
      mnu_View(4).Checked = False
      mnu_View(5).Checked = False
      mnu_View(Index).Checked = True
      FixedFloat = Index - 3
      PanelResult.Caption = SpecialFormat(Entry)
      Success = WritePrivateProfileString("Options", "FixedFloat", Format$(FixedFloat), "TAPECALC.INI")
  End Select
  Exit Sub
ViewError:
  Exit Sub
End Sub

Function OpChar$ (TheOp%)
  ' Return the character corresponding to passed value
  Select Case TheOp
    Case OPS_PLUS
      OpChar = "+"
    Case OPS_MINUS
      OpChar = "-"
    Case OPS_TIMES
      OpChar = "*"
    Case OPS_DIVIDE
      OpChar = "/"
    'If you add a new binary operator, you need to add its
    ' operator constant to this Select Case statement, returning
    ' the character or string associated with the operator
    Case OPS_POWER
      OpChar = "^"
  End Select
End Function

Sub Operate ()
  ' Perform the pending operation.
  Dim Rslt#
  On Error GoTo OFlow
  UnHighlightOp
  Select Case Op
    Case OPS_NONE
      Accum = 0
      AddToTape PanelResult.Caption, "T"
      AddToTape " ", ""
      Exit Sub
    Case OPS_PLUS
      Rslt = Accum + Entry
    Case OPS_MINUS
      Rslt = Accum - Entry
    Case OPS_TIMES
      Rslt = Accum * Entry
    Case OPS_DIVIDE
      Rslt = Accum / Entry
    'If you add a new binary operator, you need to add its
    ' operator constant to this Select Case statement, followed
    ' by code that implements the operation
    Case OPS_POWER
      Rslt = Accum ^ Entry
  End Select
  Accum = Rslt
  Entry = Accum
  Sync = SYNC_NumAhead
  SyncUp
  Op = OPS_NONE
  Exit Sub
OFlow:
  State = STATE_OVERFLOW
  EntryStr = "Overflow"
  PanelResult.Caption = EntryStr
  AddToTape PanelResult.Caption, ""
  Exit Sub
End Sub

Sub SaveFile ()
  ' If two or more rows highlighted, save highlighted
  '  part to file. Otherwise save entire tape to file.
  Dim fNum%, Success%, Txt$
  Success = SelectedTape(Txt)
  fNum = FreeFile
  Open TapeFileName For Output Access Write As fNum
  Print #fNum, Txt
  Close fNum
End Sub

Function SelectedTape% (Txt$)
  ' Fill variable Txt with selected portion of tape. If
  '  fewer than two rows selected, fill with entire
  '  contents of tape. In either case, omit leading
  '  blank rows. Return length of Txt.
  Dim N%, CopStart%, CopEnd%, WasRow%
  CopStart = GridTape.SelStartRow
  CopEnd = GridTape.SelEndRow
  WasRow = GridTape.Row
  If CopStart = CopEnd Then
    CopStart = 0
    CopEnd = GridTape.Rows - 1
  End If
  GridTape.Row = CopStart
  GridTape.Col = 0
  Do While (GridTape.Text = "") And (GridTape.Row < CopEnd)
    GridTape.Row = GridTape.Row + 1
  Loop
  If GridTape.Row = CopEnd Then
    GridTape.Row = WasRow
    Exit Function
  End If
  Txt = ""
  For N = GridTape.Row To CopEnd
    GridTape.Row = N
    GridTape.Col = 0
    Txt = Txt + GridTape.Text + Chr(9)
    GridTape.Col = 1
    Txt = Txt + GridTape.Text + Chr(13) + Chr(10)
  Next N
  GridTape.Row = WasRow
  GridTape.Col = 0
  SelectedTape = Len(Txt)
End Function

Function SpecialFormat$ (ByVal Valu#)
  ' Convert passed number to a string in the selected
  '  format. If result is too wide, adjust for current
  '  font.
  Dim Temp$, DecPosn%
  Temp = Format$(Valu, FormatStr(FixedFloat))
  If Len(Temp) > CharsInTape - 6 Then
    If FixedFloat = 0 Then ' floating point
      DecPosn = InStr(Temp, ".")
      If (DecPosn = 0) Or (DecPosn > CharsInTape - 6) Then
        Temp = Format$(Valu, FormatStr(3))
      Else
        Temp = Left$(Temp, CharsInTape - 6)
      End If
    Else
      Temp = Format$(Valu, FormatStr(3))
    End If
  End If
  If (Valu = 0) And (Left$(EntryStr, 1) = "-") Then
    Temp = "-" + Temp
  End If
  SpecialFormat = Temp
End Function

Sub StandardAction (C%)
  ' The StateXxxx functions call StandardAction when
  '  the behavior of a button is the same for two or
  '  more states.
  Select Case C
    '=== the first group of buttons don't change the state
    Case BTN_CE
      EntryStr = ""
      Entry = 0
    Case BTN_BACKSPACE
      If Len(EntryStr) > 0 Then
        EntryStr = Left$(EntryStr, Len(EntryStr) - 1)
      End If
      If EntryStr = "-" Then
        EntryStr = ""
      End If
      Sync = SYNC_StrAhead
    Case BTN_0 To BTN_9
      If EntryStr = "0" Then
        EntryStr = Format(C)
      ElseIf EntryStr = "-0" Then
        EntryStr = "-" + Format(C)
      Else
        EntryStr = EntryStr + Format(C)
      End If
      Sync = SYNC_StrAhead
    Case BTN_DEC
      If InStr(EntryStr, ".") = 0 Then
        EntryStr = EntryStr + "."
        Sync = SYNC_StrAhead
      Else
        MessageBeep (0)
      End If
    Case BTN_PLUSMINUS
      If EntryStr = "" Then EntryStr = "0"
      If Left$(EntryStr, 1) = "-" Then
        EntryStr = Mid$(EntryStr, 2)
      Else
        EntryStr = "-" + EntryStr
      End If
      Sync = SYNC_StrAhead
    Case BTN_MP
      Memory = Memory + Entry
      PictureMem.Visible = True
    Case BTN_MS
      Memory = Entry
      PictureMem.Visible = True
    Case BTN_MR
      EntryStr = Format(Memory)
      Entry = Memory
    Case BTN_MC
      Memory = 0
      PictureMem.Visible = False
    Case BTN_ADVANCE
      GridTape.AddItem ""
      If GridTape.Rows > LinesShown Then
        GridTape.TopRow = GridTape.Rows - LinesShown
      End If
    '=== the next group of buttons change the state
    Case BTN_SQRT
      If Entry < 0 Then
        State = STATE_OVERFLOW
        EntryStr = "Overflow"
        AddToTape "Overflow", ""
      Else
        AddToTape PanelResult.Caption, "SQ"
        Entry = Sqr(Entry)
        Sync = SYNC_NumAhead
        State = STATE_FROZE
      End If
    Case BTN_INVERSE
      If Entry = 0 Then
        State = STATE_OVERFLOW
        EntryStr = "Overflow"
        AddToTape "Overflow", ""
      Else
        AddToTape PanelResult.Caption, "1/"
        Entry = 1 / Entry
        Sync = SYNC_NumAhead
        State = STATE_FROZE
      End If
    Case BTN_PERCENT
      If (Op <> OPS_PLUS) And (Op <> OPS_MINUS) Then
        MessageBeep (0)
        Exit Sub
      End If
      Entry = (Entry / 100) * Accum
      AddToTape PanelResult.Caption, "%="
      Operate
      If State <> STATE_OVERFLOW Then
        AddToTape PanelResult.Caption, "T"
        AddToTape " ", ""
        State = STATE_FROZE
      End If
      Op = OPS_NONE
    Case BTN_CLEAR
      AddToTape "Clear", ""
      StateOverflow BTN_CLEAR
    Case OPBTN_FIRST To OPBTN_LAST
      TCButton(C).ForeColor = &HFFFFFF
      Op = C - OPBTN_FIRST + 1
      AddToTape PanelResult.Caption, OpChar(Op)
      State = STATE_OP
  End Select
End Sub

Sub StateFirst (C%)
  Select Case C
    Case BTN_EQUAL
      AddToTape PanelResult.Caption, "T"
      AddToTape " ", ""
    Case BTN_PERCENT
      Entry = Entry / 100
      Sync = SYNC_NumAhead
      SyncUp
    Case Else
      StandardAction C
  End Select
End Sub

Sub StateFroze (C%)
  Select Case C
    Case BTN_EQUAL
      AddToTape PanelResult.Caption, "="
      Operate
      If State <> STATE_OVERFLOW Then
        AddToTape PanelResult.Caption, "T"
        AddToTape " ", ""
      End If
    Case BTN_BACKSPACE, BTN_0 To BTN_9, BTN_DEC, BTN_MR
      Accum = 0
      Select Case C
        Case BTN_BACKSPACE
          EntryStr = "0"
        Case BTN_0 To BTN_9
          EntryStr = Format(C)
        Case BTN_DEC
          EntryStr = "0."
        Case BTN_MR
          EntryStr = Format(Memory)
      End Select
      Sync = SYNC_StrAhead
      State = STATE_FIRST
    Case BTN_PERCENT
      State = STATE_FIRST
      StateFirst C
    Case BTN_SQRT, BTN_INVERSE
      Op = OPS_NONE
      StandardAction C
    Case Else
      StandardAction C
  End Select
End Sub

Sub StateOp (C%)
  Select Case C
    Case OPBTN_FIRST To OPBTN_LAST
      UnHighlightOp
      TCButton(C).ForeColor = &HFFFFFF
      Op = C - OPBTN_FIRST + 1
      GridTape.Row = GridTape.Rows - 1
      GridTape.Col = 1
      GridTape.Text = " " + OpChar(Op)
      State = STATE_OP
    Case BTN_BACKSPACE, BTN_0 To BTN_9, BTN_DEC, BTN_MR
      UnHighlightOp
      Accum = Entry
      Select Case C
        Case BTN_BACKSPACE
          EntryStr = "0"
        Case BTN_0 To BTN_9
          EntryStr = Format(C)
        Case BTN_DEC
          EntryStr = "0."
        Case BTN_MR
          EntryStr = Format(Memory)
      End Select
      Sync = SYNC_StrAhead
      State = STATE_SECOND
    Case BTN_PERCENT
      MessageBeep (0)
    Case BTN_EQUAL
      UnHighlightOp
      GridTape.Row = GridTape.Rows - 1
      GridTape.Col = 1
      GridTape.Text = " ="
      AddToTape PanelResult.Caption, "T"
      AddToTape " ", ""
      State = STATE_FROZE
    Case Else
      StandardAction C
  End Select
End Sub

Sub StateOverflow (C%)
  Select Case C
    Case BTN_CLEAR, BTN_CE
      EntryStr = ""
      Accum = 0
      Sync = SYNC_StrAhead
      Op = OPS_NONE
      State = STATE_FIRST
    Case Else
      MessageBeep (0)
  End Select
End Sub

Sub StateSecond (C%)
  Select Case C
    Case OPBTN_FIRST To OPBTN_LAST
      AddToTape PanelResult.Caption, OpChar(C - OPBTN_FIRST + 1)
      Operate
      Op = C - OPBTN_FIRST + 1
      If State <> STATE_OVERFLOW Then State = STATE_OP
    Case BTN_EQUAL
      AddToTape PanelResult.Caption, "="
      Operate
      If State <> STATE_OVERFLOW Then
        AddToTape PanelResult.Caption, "T"
        AddToTape " ", ""
        State = STATE_FROZE
      End If
    Case Else
      StandardAction C
  End Select
End Sub

Sub SyncUp ()
  ' Synchronize the numeric entry with the
  ' displayed string
  If State = STATE_OVERFLOW Then
    PanelResult.Caption = "Overflow"
  Else
    Select Case Sync
      Case SYNC_NumAhead
        EntryStr = Format(Entry)
      Case SYNC_StrAhead
        If EntryStr = "" Then EntryStr = "0"
        Entry = Val(EntryStr)
    End Select
    Sync = SYNC_InSync
    PanelResult.Caption = SpecialFormat(Entry)
  End If
End Sub

Sub TCButton_Click (Index As Integer)
  Dispatch State, Index
End Sub

Sub Timer1_Timer ()
  Dim Success%
  ' If a button is visibly pressed, un-press it
  If ButtonUp >= BTN_0 Then
    Success = SendMessage(TCButton(ButtonUp).hWnd, BM_SETSTATE, 0, 0)
  End If
  ' Disable the timer
  Timer1.Interval = 0
  ButtonUp = -1
End Sub

Sub UnHighlightOp ()
  ' When an operator is pending, its button is highlighted.
  '  This function removes the highlight from ALL four
  '  operator buttons
  Dim N%
  For N = OPBTN_FIRST To OPBTN_LAST
    TCButton(N).ForeColor = 0
  Next N
End Sub