Dr. CD ROM (Annual Premium Edition)/premium.zip/premium/REFERENC/RPNCAL.ZIP/RPNCALC.FRM

Text File | 1993-05-17 | 16KB | 585 lines

VERSION 2.00
Begin Form Calculator
   BackColor       =   &H00C0C000&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "RPN Calculator"
   FontBold        =   -1  'True
   FontItalic      =   0   'False
   FontName        =   "System"
   FontSize        =   9.75
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   4065
   Icon            =   RPNCALC.FRX:0000
   KeyPreview      =   -1  'True
   Left            =   1110
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3540
   ScaleWidth      =   3690
   Top             =   3390
   Width           =   3810
   Begin CommandButton Enter
      Caption         =   "Enter"
      Default         =   -1  'True
      Height          =   1095
      Left            =   1920
      TabIndex        =   1
      Top             =   2400
      Width           =   495
   End
   Begin CommandButton LastX
      Caption         =   "L"
      Height          =   495
      Left            =   3120
      TabIndex        =   0
      Top             =   1800
      Width           =   495
   End
   Begin CheckBox FixDec
      Caption         =   "Check1"
      Height          =   255
      Left            =   240
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   840
      Width           =   255
   End
   Begin CommandButton Number
      Caption         =   "7"
      Height          =   480
      Index           =   7
      Left            =   120
      TabIndex        =   3
      TabStop         =   0   'False
      Top             =   1200
      Width           =   480
   End
   Begin CommandButton Number
      Caption         =   "8"
      Height          =   480
      Index           =   8
      Left            =   720
      TabIndex        =   4
      TabStop         =   0   'False
      Top             =   1200
      Width           =   480
   End
   Begin CommandButton Number
      Caption         =   "9"
      Height          =   480
      Index           =   9
      Left            =   1320
      TabIndex        =   5
      TabStop         =   0   'False
      Top             =   1200
      Width           =   480
   End
   Begin CommandButton Number
      Caption         =   "4"
      Height          =   480
      Index           =   4
      Left            =   120
      TabIndex        =   6
      TabStop         =   0   'False
      Top             =   1800
      Width           =   480
   End
   Begin CommandButton Number
      Caption         =   "5"
      Height          =   480
      Index           =   5
      Left            =   720
      TabIndex        =   7
      TabStop         =   0   'False
      Top             =   1800
      Width           =   480
   End
   Begin CommandButton Number
      Caption         =   "6"
      Height          =   480
      Index           =   6
      Left            =   1320
      TabIndex        =   8
      TabStop         =   0   'False
      Top             =   1800
      Width           =   480
   End
   Begin CommandButton Number
      Caption         =   "1"
      Height          =   480
      Index           =   1
      Left            =   120
      TabIndex        =   9
      TabStop         =   0   'False
      Top             =   2400
      Width           =   480
   End
   Begin CommandButton Number
      Caption         =   "2"
      Height          =   480
      Index           =   2
      Left            =   720
      TabIndex        =   10
      TabStop         =   0   'False
      Top             =   2400
      Width           =   480
   End
   Begin CommandButton Number
      Caption         =   "3"
      Height          =   480
      Index           =   3
      Left            =   1320
      TabIndex        =   11
      TabStop         =   0   'False
      Top             =   2400
      Width           =   480
   End
   Begin CommandButton Number
      Caption         =   "0"
      Height          =   480
      Index           =   0
      Left            =   120
      TabIndex        =   12
      TabStop         =   0   'False
      Top             =   3000
      Width           =   1080
   End
   Begin CommandButton Decimal
      Caption         =   "."
      Height          =   480
      Left            =   1320
      TabIndex        =   13
      TabStop         =   0   'False
      Top             =   3000
      Width           =   480
   End
   Begin Image Pi
      Height          =   480
      Left            =   3120
      Picture         =   RPNCALC.FRX:0302
      Top             =   600
      Width           =   480
   End
   Begin Image XSquare
      Height          =   480
      Left            =   3120
      Picture         =   RPNCALC.FRX:0604
      Top             =   1200
      Width           =   480
   End
   Begin Label LabelFix
      Alignment       =   2  'Center
      BackColor       =   &H00C0C000&
      Caption         =   "Fix 4"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "System"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   255
      Left            =   105
      TabIndex        =   14
      Top             =   600
      Width           =   510
   End
   Begin Image Change
      Height          =   480
      Left            =   2520
      Picture         =   RPNCALC.FRX:0906
      Top             =   1800
      Width           =   480
   End
   Begin Image SquareRoot
      Height          =   480
      Left            =   2520
      Picture         =   RPNCALC.FRX:0C08
      Top             =   1200
      Width           =   480
   End
   Begin Image Up
      Height          =   480
      Left            =   3120
      Picture         =   RPNCALC.FRX:0F0A
      Top             =   2400
      Width           =   480
   End
   Begin Image Down
      Height          =   480
      Left            =   2520
      Picture         =   RPNCALC.FRX:120C
      Top             =   2400
      Width           =   480
   End
   Begin Image Plus
      Height          =   480
      Left            =   1920
      Picture         =   RPNCALC.FRX:150E
      Top             =   1200
      Width           =   480
   End
   Begin Image Minus
      Height          =   480
      Left            =   1920
      Picture         =   RPNCALC.FRX:1810
      Top             =   600
      Width           =   480
   End
   Begin Image Devide
      Height          =   480
      Left            =   720
      Picture         =   RPNCALC.FRX:1B12
      Top             =   600
      Width           =   480
   End
   Begin Image Mult
      Height          =   480
      Left            =   1320
      Picture         =   RPNCALC.FRX:1E14
      Top             =   600
      Width           =   480
   End
   Begin Image SwapXY
      Height          =   480
      Left            =   1920
      Picture         =   RPNCALC.FRX:2116
      Top             =   1800
      Width           =   480
   End
   Begin Image xby1
      Height          =   480
      Left            =   2520
      Picture         =   RPNCALC.FRX:2418
      Top             =   600
      Width           =   480
   End
   Begin Image Backspace
      Height          =   480
      Left            =   2520
      Picture         =   RPNCALC.FRX:271A
      Top             =   3000
      Width           =   1080
   End
   Begin Label Readout
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFF80&
      Caption         =   "0"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   13.5
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   375
      Index           =   0
      Left            =   120
      TabIndex        =   15
      Top             =   120
      Width           =   3495
   End
End

' ------------------------------------------------------------------------
'                       Public Domain
'                       RPN Caculator
' ------------------------------------------------------------------------

Option Explicit

Dim Register(0 To 5)  As Variant       ' RPN Registers
                    ' 0 = Last X
                    ' 1 = x
                    ' 2 = y
                    ' 3 = z
                    ' 4 = t
                    ' 5 = temp storage

Dim DecimalFlag As Integer              ' Decimal point present yet?
Dim UserInput As String                 ' Numeric InPut String
Dim UseStr As String                    ' Format Control String

' Event Functions ----------------------------------------------------------
'----------------------------------------------------------------------------

Sub BackSpace_Click ()
    Call submit(Chr$(8))
End Sub

Sub Change_Click ()
    Call submit(Chr$(241))
End Sub

' Misc Functions ----------------------------------------------------------
Sub CheckInput ()
    If Len(UserInput) > 0 Then
        Call PushUp
        Register(1) = Val(UserInput)
        Register(0) = Register(1)
        UserInput = ""
        DecimalFlag = False
    End If
End Sub

Sub Decimal_Click ()
    Call submit(".")
End Sub

Sub Devide_Click ()
    Call submit("/")
End Sub

Sub Devide0 () ' Devide by zero error display
    MsgBox "Attempted Devide by zero.", 48, "ERROR"
End Sub

Sub Down_Click ()
    Call submit(Chr$(31))
End Sub

Sub Enter_Click ()
    Call submit(Chr$(13))
End Sub

Sub FixDec_Click ()
    If FixDec.Value = 1 Then
    UseStr = "###,###,###.0000;\-###,###,###.0000;0.0000;0.0"
    Else
    UseStr = ""
    End If
    Call Ok
End Sub

Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
    KeyCode = 0
End Sub

Sub Form_KeyPress (KeyAscii As Integer)
    ' Readout(6).Caption = KeyAscii
    If KeyAscii = 27 Then End
    If KeyAscii = 8 Then Call submit(Chr$(8))
    Dim k As String * 1
    k = UCase$(Chr$(KeyAscii))
    If InStr("0123456789XSRLC.+-*/=", k) Then
    Call submit(k)
    End If
    KeyAscii = 0
End Sub

Sub Form_KeyUp (KeyCode As Integer, Shift As Integer)
    ' Readout(6).Caption = KeyCode
    ' NOTE: Contrary to the documentation the next line is useless !
    If KeyCode = 13 Then Call submit(Chr$(13))
    If KeyCode = 33 Then Call submit(Chr$(30))
    If KeyCode = 34 Then Call submit(Chr$(31))
End Sub

' Initialization routine for the form.
Sub Form_Load ()
    Calculator.Caption = App.EXEName + ".EXE"
    If Left$(Calculator.Caption, 3) <> "RPN" Then
        Calculator.Caption = Calculator.Caption + "  RPN"
    End If
    ' Calculator.Height  =   5910
    ' NOTE: Contrary to the documentation the next line is useless !
    Calculator.KeyPreview = True
    Dim i As Integer
    For i = 0 To 5
        Register(i) = 0
    Next i
    UserInput = "0"
    Call CheckInput
End Sub

Sub LastX_Click ()
    Call submit("L")
End Sub

Sub Minus_Click ()
    Call submit("-")
End Sub

Sub Mult_Click ()
    Call submit("*")
End Sub

Sub Number_Click (Index As Integer)
    Call submit(Chr$(48 + Index))
End Sub

Sub Number_KeyUp (Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then Call submit(Chr$(13))
End Sub

Sub Ok ()
    If Len(UserInput) > 0 Then
    Readout(0) = UserInput
    Else
    Readout(0) = Format$(Register(1), UseStr)
    ' ReadOut(1) = Register(0)
    ' ReadOut(2) = Register(1)
    ' ReadOut(3) = Register(2)
    ' ReadOut(4) = Register(3)
    ' ReadOut(5) = Register(4)
    End If
End Sub

Sub Pi_Click ()
    Call submit("P")
End Sub

Sub Plus_Click ()
    Call submit("+")
End Sub

' Stack Functions ----------------------------------------------------------
' Push Registers down, T retains Value
Sub PushDown ()
    Register(1) = Register(2)
    Register(2) = Register(3)
    Register(3) = Register(4)
End Sub

' Push Registers up, X retains value
Sub PushUp ()
    Register(4) = Register(3)
    Register(3) = Register(2)
    Register(2) = Register(1)
End Sub

' Rotate Register x-t (1 to 4) down
Sub RollDown ()
    Register(5) = Register(1)      ' Save X register
    Call PushDown
    Register(4) = Register(5)
End Sub

' Rotate Register x-t (1 to 4) up
Sub RollUp ()
    Register(5) = Register(4)      ' Save T register
    Call PushUp
    Register(1) = Register(5)
End Sub

Sub SquareRoot_Click ()
    Call submit("R")
End Sub

' Program Core ---------------------------------------------------------------
' All input is processed here. This Subroutine is used so that multiple
' events can be mapped to the same function:
' EXAMPLE: Image Enter_Click and KeyPress (Enter)
' It also allows for a future implimentation of *.RPN script files
' or the assingment userdefined functions.
'
Sub submit (s As String)
   Select Case s
    Case "."                                ' Decimal Point
        If Len(UserInput) > 0 Then
            If DecimalFlag = False Then UserInput = UserInput + "."
        Else
            UserInput = "0."
        End If
        DecimalFlag = True
    Case "0" To "9"
        UserInput = UserInput + s
    Case "*"                                ' Multiply Y by X
        Call CheckInput
        Register(0) = Register(1)
        Register(2) = Register(2) * Register(1)
        Call PushDown
    Case "+"                                ' Add X to Y
        Call CheckInput
        Register(0) = Register(1)
        Register(2) = Register(2) + Register(1)
        Call PushDown
    Case "-"                                ' Sub X from Y
        Call CheckInput
        Register(0) = Register(1)
        Register(2) = Register(2) - Register(1)
        Call PushDown
    Case "/"                                ' Devide Y by X
        Call CheckInput
        If Abs(Register(1)) > 0 Then
            Register(0) = Register(1)
            Register(2) = Register(2) / Register(1)
            Call PushDown
        Else
            Call Devide0
        End If
    Case "="                                ' Exchange X and Y
        Call CheckInput
        Register(5) = Register(1)      ' Save X register
        Register(1) = Register(2)
        Register(2) = Register(5)
    Case "X"                                ' X = 1/X
        Call CheckInput
        If Abs(Register(1)) > 0 Then
            Register(0) = Register(1)
            Register(1) = 1 / Register(1)
        Else
            Call Devide0
        End If
    Case Chr$(241)                          ' Change Sign of X
        Call CheckInput
        Register(1) = -(Register(1))
    Case Chr$(30)                           ' Roll Up
        Call CheckInput
        Call RollUp
    Case Chr$(31)                           ' Roll Down
        Call CheckInput
        Call RollDown
    Case "S"                                ' Square (X = X * X)
        Call CheckInput
        Register(1) = Register(1) * Register(1)
    Case "R"                                ' SquareRoot
        Call CheckInput
        Register(1) = Sqr(Abs(Register(1)))
    Case "P"                                ' Insert Value for Pi
        Call CheckInput
        UserInput = "3.141592654"
        Call CheckInput
    Case "L"                                ' Resstore last "X" value
        Call CheckInput
        UserInput = Register(0)
        Call CheckInput
    Case Chr$(8)                            ' BackSpace
        If Len(UserInput) > 0 Then
            If Right$(UserInput, 1) = "." Then DecimalFlag = False
            UserInput = Left$(UserInput, Len(UserInput) - 1)
        Else
            UserInput = "0"
            Call CheckInput
        End If

    Case Chr$(13)                           ' Enter Key
        If Len(UserInput) = 0 Then
            UserInput = Format$(Register(1))
        End If
        Call CheckInput
    Case Else
        ' do nothing
   End Select
   Call Ok
   Calculator.Enter.SetFocus
End Sub

Sub SwapXY_Click ()
    Call submit("=")
End Sub

Sub Up_Click ()
    Call submit(Chr$(30))
End Sub

Sub Xby1_Click ()
    Call submit("X")
End Sub

Sub XSquare_Click ()
    Call submit("S")
End Sub