PC World Komputer 1997 February/PCWK0297.iso/envelop/envelop.5/Tools/Arsenal/apps/calc/calc.eto

Text File | 1996-07-08 | 19KB | 716 lines

Type CalcMasterForm From SampleMasterForm
  Type CalcConstants From Globals
    Dim pi As String
    Dim radians As String
  End Type
  Dim CalcMenuBar As New MenuBar
  Dim CalcUnitsMenu As New PopupMenu
  Type btn0 From Button
    Dim NumberValue As String

    ' METHODS for object: CalcMasterForm.btn0
    Sub Click
      Parent.AppendNumber(NumberValue)
    End Sub

  End Type
  Dim lblResults As New Label
  Dim btn7 As New CalcMasterForm.btn0
  Dim btn8 As New CalcMasterForm.btn0
  Dim btn9 As New CalcMasterForm.btn0
  Dim btn4 As New CalcMasterForm.btn0
  Dim btn5 As New CalcMasterForm.btn0
  Dim btn6 As New CalcMasterForm.btn0
  Dim btn1 As New CalcMasterForm.btn0
  Dim btn2 As New CalcMasterForm.btn0
  Dim btn3 As New CalcMasterForm.btn0
  Dim btnDecimal As New Button
  Dim btnC As New Button
  Dim btnCE As New Button
  Dim btnAdd As New Button
  Dim btnSubtract As New Button
  Dim btnMultiply As New Button
  Dim btnDivide As New Button
  Dim btnEquals As New Button
  Dim btnPercentage As New Button
  Dim ComputeStack As Double
  Dim InputStack As String
  Dim Operation As String
  Dim CalcFont As New Font
  Dim DisplayFont As New Font
  Type btnSin From Button

    ' METHODS for object: CalcMasterForm.btnSin
    Sub Click
      With Parent
        Operate(Val(.InputStack))
        .UpdateDisplay
        .ClearFlag = 1
      End With
    End Sub

    Sub Operate(o as double)
      With Parent
        If .UNITS = "Degrees" Then
          .InputStack = sin(o * radians)
        Else
          .InputStack = sin(o)
        End If
      End With
    End Sub

  End Type
  Type btnCos From CalcMasterForm.btnSin

    ' METHODS for object: CalcMasterForm.btnCos
    Sub Operate(o as double)
      With Parent
        If .UNITS = "Degrees" Then
          .InputStack = cos(o * radians)
        Else
          .InputStack = cos(o)
        End If
      End With
    End Sub

  End Type
  Type btnTan From CalcMasterForm.btnSin

    ' METHODS for object: CalcMasterForm.btnTan
    Sub Operate(o as double)
      With Parent
        If .UNITS = "Degrees" Then
          .InputStack = tan(o * radians)
        Else
          .InputStack = tan(o)
        End If
      End With
    End Sub

  End Type
  Type btnATan From CalcMasterForm.btnSin

    ' METHODS for object: CalcMasterForm.btnATan
    Sub Operate(o as double)
      With Parent
        If .UNITS = "Degrees" Then
          .InputStack = .Radian2Degree(atn(o))
        Else
          .InputStack = atn(o)
        End If
      End With
    End Sub

  End Type
  Dim btne As New Button
  Type btnLnx From CalcMasterForm.btnSin

    ' METHODS for object: CalcMasterForm.btnLnx
    Sub Operate(o as double)
      If Val(o) < 0 Then
        InfoBox.Message("", "Logarithm is undefined for a negative value!")
      Else
        Parent.InputStack = log(o)
      End If
    End Sub

  End Type
  Dim btnPi As New Button
  Type btnReciprocal From CalcMasterForm.btnSin

    ' METHODS for object: CalcMasterForm.btnReciprocal
    Sub Operate(o as double)
      If o = 0 Then
        InfoBox.Message("", "Can't take the Reciprocal of 0")
      Else
        Parent.InputStack = 1 / o
      End If
    End Sub

  End Type
  Type btnSquared From CalcMasterForm.btnSin

    ' METHODS for object: CalcMasterForm.btnSquared
    Sub Operate(o as double)
      Parent.InputStack = o * o
    End Sub

  End Type
  Type btnSquareRoot From CalcMasterForm.btnSin

    ' METHODS for object: CalcMasterForm.btnSquareRoot
    Sub Operate(o as double)
      If o < 0 Then
        MessageBox.Message("Domain Error", "Can't take the square root of negative numbers")
      Else
        Parent.InputStack = sqr(o)
      End If
    End Sub

  End Type
  Dim btnStore As New Button
  Dim btnRecall As New Button
  Dim StoreBuffer As String
  Dim ClearFlag As Integer
  Dim UNITS As String
  Dim btnBackSpace As New Button

  ' METHODS for object: CalcMasterForm
  Sub AppendNumber(input As String)

    If ClearFlag = 1 Then
      InputStack = "0"
      ClearFlag = 0
    End If

    ' This guy receives input from the numberpad 0-9
    ' and must save the input into the InputStack and update
    ' the display. Input value of 10 indicates a decimal point

    If input = "10" Then
      input = "."
    End If

    ' Determine how to insert the input into the InputStack String
    Select Case InputStack
      Case "0"
        InputStack = input
      Case "-0"
        InputStack = "-" & input
      Case Else
        InputStack = InputStack & input
    End Select

    ' Update the display with the contents of the InputStack String
    UpdateDisplay

  End Sub

  Sub btnAdd_Click()
    If InputStack = "-0" Then
      InputStack = "0"
      UpdateDisplay
    Else
      Operation = "Add"
      InputStack2ComputeStack
    End If
  End Sub

  Sub btnBackSpace_Click()
    Dim size As Integer

    ' Take number from InputStack and update the display
    If InputStack <> "0" Then
      size = Len(InputStack)
      InputStack = Left(InputStack, size - 1)
      If InputStack = "" Then
        InputStack = "0"
      End If
      UpdateDisplay
    End If

  End Sub

  Sub btnCE_Click()
    ' Clear the input stack string
    InputStack = 0

    ' update the display
    UpdateDisplay
  End Sub

  Sub btnC_Click()
    ' Clear the input stack string
    InputStack = "0"

    ' Update the display
    UpdateDisplay

    ' Clear the compute stack double
    ComputeStack = 0

    ' Clear the Operation string
    Operation = ""

    ClearFlag = 0

  End Sub

  Sub btnDecimal_Click()

    ' The ClearFlag means that the previous operation left the results
    ' of a calculation on the display.  Our next step is to add new
    ' input, not to append to existing information
    If ClearFlag = 1 Then
      InputStack = "0"
      UpdateDisplay
      ClearFlag = 0
    End If

    ' If there is a decimal in the InputStack, we don't enter another
    ' decimal point
    If IsDecimal(InputStack) Then
      ' Do nothing
    Else
      AppendNumber(10)
    End If

  End Sub

  Sub btnDivide_Click()
    ' Setup for a division calculation
    Operation = "Divide"
    InputStack2ComputeStack
  End Sub

  Sub btnEquals_Click()
    If Operation = "" Then Exit Sub
    ' We will comment out the following line for now since it chokes
    ' if you step over it in debug mode
    If ComputeStack = 0 Then Exit Sub

    ' This guys is suppose to carry out the desire function
    Select Case Operation
      Case "Add"
        lblResults.Caption = ComputeStack + Val(InputStack)
      Case "Subtract"
        lblResults.Caption = ComputeStack - Val(InputStack)
      Case "Multiply"
        lblResults.Caption = ComputeStack * Val(InputStack)
      Case "Divide"
        If Val(InputStack) = 0 Then
          InfoBox.Message("Calculation Error", "Can't divide by zero!")
          Exit Sub
        Else
          lblResults.Caption = ComputeStack / Val(InputStack)
        End If
    End Select

    InputStack = lblResults.Caption

    ' Reset the compute stack
    ComputeStack = 0

    ' Set the clear display flag
    ClearFlag = 1

  End Sub

  Sub btne_Click()
    InputStack = exp(1)
    UpdateDisplay
    ClearFlag = 1
  End Sub

  Sub btnMultiply_Click()
    Operation = "Multiply"
    InputStack2ComputeStack
  End Sub

  Sub btnPercentage_Click()
    InputStack = Val(InputStack) / 100
    UpdateDisplay
  End Sub

  Sub btnPi_Click()

    InputStack = 4 * atn(1)
    UpdateDisplay
    ClearFlag = 1
  End Sub

  Sub btnRecall_Click()
    If StoreBuffer = "" Then Exit Sub

    InputStack = StoreBuffer
    UpdateDisplay
    ClearFlag = 1
  End Sub

  Sub btnStore_Click()
    StoreBuffer = InputStack
    ClearFlag = 1
  End Sub

  Sub btnSubtract_Click()
    If InputStack = "0" Then
      InputStack = "-0"
      UpdateDisplay
    Else
      Operation = "Subtract"
      InputStack2ComputeStack
    End If
  End Sub

  Function Degree2Radian(degree As String) As String
    Dim pi As String
    Dim radians_per_degree As String

    pi = 4 * atn(1)
    radians_per_degree = (2 * pi) / 360
    Degree2Radian = degree * radians_per_degree
  End Function

  Sub InputStack2ComputeStack()
    ' This guy moves the data in the input stack to the compute stack
    ComputeStack = Val(InputStack)
    InputStack = "0"
    ClearFlag = 1
  End Sub

  Function IsDecimal(number As String) As Integer
    Dim counter As Integer
    Dim length As Integer
    Dim char As String

    If number = "" Then
      IsDecimal = 0
      Exit Sub
    End If

    length = Len(number)
    For counter = 1 To length
      char = Mid(number, counter, 1)
      If char = "." Then
        IsDecimal = 1
        Exit For
      Else
        IsDecimal = 0
      End If
    Next counter

  End Function

  Sub KeyPress(keyAscii As Integer)
    Select Case keyAscii
      Case 48 To 57 ' Number Key
        AppendNumber(keyAscii - 48)
      Case 43 ' +
        btnAdd_Click
      Case 45 ' -
        btnSubtract_Click
      Case 42 ' *
        btnMultiply_Click
      Case 47 ' /
        btnDivide_Click
      Case 46 ' .
        btnDecimal_Click
      Case Else
    End Select
  End Sub

  Function Radian2Degree (radian As String) As String
    Dim pi As String
    Dim degrees_per_radian As String

    pi = 4 * atn(1)
    degrees_per_radian = 1 / ((2 * pi) / 360)
    Radian2Degree = radian * degrees_per_radian

  End Function

  Sub ResetApplication_Click()
    ' Set the default units
    UNITS = "Degrees"

    ' Set default checkmarks
    CalcUnitsMenu.CheckItem("UnitDegrees", 1)
    CalcUnitsMenu.CheckItem("UnitRadians", 0)

    ' Run the clear button
    btnC_Click
  End Sub

  Sub UnitDegrees_Click()
    ' Avoid trying to convert from degrees to degrees
    If CalcUnitsMenu.ItemIsChecked("UnitDegrees") Then Exit Sub

    ' Toggle the unit mode to degrees
    CalcUnitsMenu.CheckItem("UnitDegrees", 1)
    CalcUnitsMenu.CheckItem("UnitRadians", 0)
    CalcMasterForm.UNITS = "Degrees"

    ' If nothing in the InputStack, exit
    If InputStack = "" Or InputStack = "0" Then Exit Sub

    ' Convert the value of the InputStack to degrees
    InputStack = Radian2Degree(InputStack)

    UpdateDisplay
    ClearFlag = 1
  End Sub

  Sub UnitRadians_Click()
    ' Avoid trying to convert from radians to radians
    If CalcUnitsMenu.ItemIsChecked("UnitRadians") Then Exit Sub

    ' Toggle the unit mode to radians
    CalcUnitsMenu.CheckItem("UnitDegrees", 0)
    CalcUnitsMenu.CheckItem("UnitRadians", 1)
    CalcMasterForm.UNITS = "Radians"

    ' If nothing in the InputStack, exit
    If InputStack = "" Or InputStack = "0" Then Exit Sub

    ' Convert the value of the InputStack to degrees
    InputStack = Degree2Radian(InputStack)

    UpdateDisplay
    ClearFlag = 1
  End Sub

  Sub UpdateDisplay()

    ' Take number from InputStack and update the display
    If InputStack = "0" Then
      lblResults.Caption = InputStack & "."
    Else
      lblResults.Caption = InputStack
    End If

  End Sub

End Type

Begin Code
' Reconstruction commands for object: CalcMasterForm
'
  With CalcMasterForm
    .Caption := "BOOT CAMP Calculator Application"
    .Move(1755, 5310, 6105, 4260)
    .KeyPreview := True
    .DefaultButton := CalcMasterForm.btnEquals
    .CancelButton := CalcMasterForm.btnC
    .MenuBar := CalcMasterForm.CalcMenuBar
    .SampleDir := "W:\arsenal\apps\calc\"
    .SampleName := "calc"
    .ComputeStack := 0
    .InputStack := "0"
    .Operation := ""
    .StoreBuffer := "46"
    .ClearFlag := 0
    .UNITS := "Degrees"
    With .CalcConstants
      .pi := "3.141592653589793116"
      .radians := "0.01745329251994329547"
    End With  'CalcMasterForm.CalcConstants
    With .CalcMenuBar

      .InsertPopup(SampleMasterFormFileMenu, "&File", -1)
      .InsertPopup(CalcMasterForm.CalcUnitsMenu, "&Units", -1)
      .InsertPopup(SampleMasterFormHelpMenu, "&Help", -1)
    End With  'CalcMasterForm.CalcMenuBar
    With .CalcUnitsMenu

      .InsertItem("UnitDegrees", "&Degrees", -1)
      .InsertItem("UnitRadians", "&Radians", -1)
    End With  'CalcMasterForm.CalcUnitsMenu
    With .btn0
      .Caption := "0"
      .Font := CalcMasterForm.CalcFont
      .ZOrder := 11
      .Move(300, 2850, 450, 450)
      .NumberValue := "0"
    End With  'CalcMasterForm.btn0
    With .lblResults
      .Caption := "0."
      .BackColor := 0
      .ForeColor := 16777215
      .Font := CalcMasterForm.DisplayFont
      .ZOrder := 1
      .Move(300, 300, 5400, 450)
      .Alignment := "Right"
    End With  'CalcMasterForm.lblResults
    With .btn7
      .Caption := "7"
      .ZOrder := 2
      .Move(300, 1050, 450, 450)
      .NumberValue := "7"
    End With  'CalcMasterForm.btn7
    With .btn8
      .Caption := "8"
      .ZOrder := 3
      .Move(915, 1050, 450, 450)
      .NumberValue := "8"
    End With  'CalcMasterForm.btn8
    With .btn9
      .Caption := "9"
      .ZOrder := 4
      .Move(1500, 1050, 450, 450)
      .NumberValue := "9"
    End With  'CalcMasterForm.btn9
    With .btn4
      .Caption := "4"
      .ZOrder := 5
      .Move(300, 1650, 450, 450)
      .NumberValue := "4"
    End With  'CalcMasterForm.btn4
    With .btn5
      .Caption := "5"
      .ZOrder := 6
      .Move(900, 1650, 450, 450)
      .NumberValue := "5"
    End With  'CalcMasterForm.btn5
    With .btn6
      .Caption := "6"
      .ZOrder := 7
      .Move(1500, 1650, 450, 450)
      .NumberValue := "6"
    End With  'CalcMasterForm.btn6
    With .btn1
      .Caption := "1"
      .ZOrder := 8
      .Move(300, 2250, 450, 450)
      .NumberValue := "1"
    End With  'CalcMasterForm.btn1
    With .btn2
      .Caption := "2"
      .ZOrder := 9
      .Move(915, 2235, 450, 450)
      .NumberValue := "2"
    End With  'CalcMasterForm.btn2
    With .btn3
      .Caption := "3"
      .ZOrder := 10
      .Move(1500, 2250, 450, 450)
      .NumberValue := "3"
    End With  'CalcMasterForm.btn3
    With .btnDecimal
      .Caption := "."
      .Font := CalcMasterForm.CalcFont
      .ZOrder := 12
      .Move(900, 2850, 450, 450)
    End With  'CalcMasterForm.btnDecimal
    With .btnC
      .Caption := "C"
      .Font := CalcMasterForm.CalcFont
      .ZOrder := 13
      .Move(2250, 1050, 450, 450)
    End With  'CalcMasterForm.btnC
    With .btnCE
      .Caption := "CE"
      .Font := CalcMasterForm.CalcFont
      .ZOrder := 14
      .Move(2850, 1050, 450, 450)
    End With  'CalcMasterForm.btnCE
    With .btnAdd
      .Caption := "+"
      .Font := CalcMasterForm.CalcFont
      .ZOrder := 15
      .Move(2250, 1650, 450, 450)
    End With  'CalcMasterForm.btnAdd
    With .btnSubtract
      .Caption := "-"
      .Font := CalcMasterForm.CalcFont
      .ZOrder := 16
      .Move(2850, 1650, 450, 450)
    End With  'CalcMasterForm.btnSubtract
    With .btnMultiply
      .Caption := "x"
      .Font := CalcMasterForm.CalcFont
      .ZOrder := 17
      .Move(2250, 2250, 450, 450)
    End With  'CalcMasterForm.btnMultiply
    With .btnDivide
      .Caption := "/"
      .Font := CalcMasterForm.CalcFont
      .ZOrder := 18
      .Move(2850, 2250, 450, 450)
    End With  'CalcMasterForm.btnDivide
    With .btnEquals
      .Caption := "="
      .Font := CalcMasterForm.CalcFont
      .ZOrder := 19
      .Move(2250, 2865, 450, 450)
    End With  'CalcMasterForm.btnEquals
    With .btnPercentage
      .Caption := "%"
      .Font := CalcMasterForm.CalcFont
      .ZOrder := 20
      .Move(2850, 2850, 450, 450)
    End With  'CalcMasterForm.btnPercentage
    With .CalcFont
      .FaceName := "Arial"
      .Size := 12.000000
      .Bold := True
      .Italic := False
      .Strikethru := False
    End With  'CalcMasterForm.CalcFont
    With .DisplayFont
      .FaceName := "Arial"
      .Size := 20.000000
      .Bold := True
      .Italic := False
      .Strikethru := False
    End With  'CalcMasterForm.DisplayFont
    With .btnSin
      .Caption := "Sin"
      .ZOrder := 21
      .Move(3600, 2850, 600, 450)
    End With  'CalcMasterForm.btnSin
    With .btnCos
      .Caption := "Cos"
      .ZOrder := 22
      .Move(4350, 2850, 600, 450)
    End With  'CalcMasterForm.btnCos
    With .btnTan
      .Caption := "Tan"
      .ZOrder := 23
      .Move(5100, 2850, 600, 450)
    End With  'CalcMasterForm.btnTan
    With .btnATan
      .Caption := "aTan"
      .ZOrder := 24
      .Move(3600, 2250, 600, 450)
    End With  'CalcMasterForm.btnATan
    With .btne
      .Caption := "e"
      .ZOrder := 25
      .Move(4350, 1650, 600, 450)
    End With  'CalcMasterForm.btne
    With .btnLnx
      .Caption := "Ln x"
      .ZOrder := 26
      .Move(4350, 1050, 600, 450)
    End With  'CalcMasterForm.btnLnx
    With .btnPi
      .Caption := "Pi"
      .ZOrder := 27
      .Move(4350, 2250, 600, 450)
    End With  'CalcMasterForm.btnPi
    With .btnReciprocal
      .Caption := "1/X"
      .ZOrder := 28
      .Move(5100, 1050, 600, 450)
    End With  'CalcMasterForm.btnReciprocal
    With .btnSquared
      .Caption := "x2"
      .ZOrder := 29
      .Move(5100, 1650, 600, 450)
    End With  'CalcMasterForm.btnSquared
    With .btnSquareRoot
      .Caption := "Sqrt"
      .ZOrder := 30
      .Move(5100, 2250, 600, 450)
    End With  'CalcMasterForm.btnSquareRoot
    With .btnStore
      .Caption := "STO"
      .ZOrder := 31
      .Move(3600, 1050, 600, 450)
    End With  'CalcMasterForm.btnStore
    With .btnRecall
      .Caption := "RCL"
      .ZOrder := 32
      .Move(3600, 1650, 600, 450)
    End With  'CalcMasterForm.btnRecall
    With .btnBackSpace
      .Caption := "BS"
      .ZOrder := 33
      .Move(1500, 2850, 450, 450)
    End With  'CalcMasterForm.btnBackSpace
    With .helpfile
      .FileName := "W:\arsenal\apps\calc\calc.hlp"
    End With  'CalcMasterForm.helpfile
  End With  'CalcMasterForm
End Code