home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / RPN_Demo192022822005.psc / FrmMain.frm < prev    next >
Text File  |  2005-08-02  |  5KB  |  159 lines
  1. VERSION 5.00
  2. Begin VB.Form FrmMain 
  3.    Caption         =   "RPN"
  4.    ClientHeight    =   3345
  5.    ClientLeft      =   60
  6.    ClientTop       =   450
  7.    ClientWidth     =   9600
  8.    Icon            =   "FrmMain.frx":0000
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   3345
  11.    ScaleWidth      =   9600
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin VB.CommandButton CmdExit 
  14.       Caption         =   "Exit"
  15.       Height          =   375
  16.       Left            =   2160
  17.       TabIndex        =   4
  18.       Top             =   120
  19.       Width           =   1215
  20.    End
  21.    Begin VB.CommandButton CmdExecute 
  22.       Caption         =   "Execute"
  23.       Height          =   375
  24.       Left            =   360
  25.       TabIndex        =   0
  26.       Top             =   120
  27.       Width           =   1335
  28.    End
  29.    Begin VB.TextBox TxtAnswr 
  30.       Height          =   2655
  31.       Left            =   6600
  32.       MultiLine       =   -1  'True
  33.       ScrollBars      =   3  'Both
  34.       TabIndex        =   3
  35.       Text            =   "FrmMain.frx":0ECA
  36.       Top             =   600
  37.       Width           =   2775
  38.    End
  39.    Begin VB.TextBox TxtRPNequation 
  40.       Height          =   2655
  41.       Left            =   3600
  42.       MultiLine       =   -1  'True
  43.       ScrollBars      =   3  'Both
  44.       TabIndex        =   2
  45.       Text            =   "FrmMain.frx":0ECC
  46.       Top             =   600
  47.       Width           =   2895
  48.    End
  49.    Begin VB.TextBox TxtEquation 
  50.       Height          =   2655
  51.       Left            =   360
  52.       MultiLine       =   -1  'True
  53.       ScrollBars      =   3  'Both
  54.       TabIndex        =   1
  55.       Text            =   "FrmMain.frx":0ECE
  56.       Top             =   600
  57.       Width           =   3135
  58.    End
  59. End
  60. Attribute VB_Name = "FrmMain"
  61. Attribute VB_GlobalNameSpace = False
  62. Attribute VB_Creatable = False
  63. Attribute VB_PredeclaredId = True
  64. Attribute VB_Exposed = False
  65. Option Explicit
  66.  
  67. Private Sub CmdExecute_Click()
  68.   Dim strTmp     As String
  69.   Dim strRPN()   As String
  70.   Dim strEqSrc() As String
  71.   Dim lRPNpntr   As Long
  72.   Dim lX         As Long
  73.   Dim lEqPntr    As Long
  74.   Dim lLast      As Long
  75.  
  76.   lRPNpntr = 2
  77.   lEqPntr = 1
  78.   TxtAnswr.Text = vbNullString
  79.   TxtRPNequation.Text = vbNullString
  80.   strTmp = TxtEquation.Text
  81.   lX = Len(strTmp)
  82.   lLast = lX + 1
  83.   Do While lX < lLast
  84.     lLast = lX
  85.     strTmp = Replace$(strTmp, vbNewLine, vbCr)
  86.     strTmp = Replace$(strTmp, vbTab, " ")
  87.     strTmp = Replace$(strTmp, "  ", " ")
  88.     strTmp = Replace$(strTmp, vbNewLine, vbCr)
  89.     strTmp = Replace$(strTmp, vbLf, vbNullString)
  90.     lX = Len(strTmp)
  91.   Loop
  92.   strEqSrc = Split(strTmp, vbCr)
  93.   For lEqPntr = LBound(strEqSrc) To UBound(strEqSrc)
  94.     If LenB(Trim$(strEqSrc(lEqPntr))) > 0 Then
  95.       Call Parser(strEqSrc(lEqPntr))
  96. '      strTmp = vbNullString
  97. '      For lX = LBound(gstrParsed) To glParsedSize
  98. '        strTmp = strTmp & gstrParsed(lX) & " "
  99. '      Next lX
  100. '      Debug.Print strTmp
  101.       Call ParsedEqn2RPNorder(strRPN(), lRPNpntr)
  102.       strTmp = vbNullString
  103.       For lX = LBound(strRPN()) To lRPNpntr
  104.         strTmp = strTmp & strRPN(lX) & " "
  105.       Next lX
  106.       TxtRPNequation.Text = TxtRPNequation.Text & strTmp & vbNewLine
  107.       TxtAnswr.Text = TxtAnswr.Text & CalcRPN(strRPN()) & vbNewLine
  108.     End If
  109.   Next lEqPntr
  110.   CmdExit.SetFocus
  111. End Sub
  112.  
  113. Private Sub CmdExit_Click()
  114.   Unload Me
  115. End Sub
  116.  
  117. Private Sub Form_Load()
  118.   gstrTokens(1) = "-=+*/|();'><^\" '"-=+*/|();'><[]"
  119.   gstrTokens(2) = "AND"
  120.   gstrTokens(3) = "OR"
  121.   gstrTokens(4) = "XOR"
  122.   gstrTokens(5) = "MOD"
  123.   gstrTokens(6) = "<>"
  124.   gstrTokens(7) = "><"
  125.   gstrDoubleQuote = Chr$(34)      '...double quote character..
  126.   'sample equations
  127.   With TxtEquation
  128.     .Text = "y= 1 + 5 - 1"
  129.     .Text = .Text & vbNewLine & "y=25 * 5 + 2" & vbNewLine
  130.     .Text = .Text & "y=((4+2)-(3+2))" & vbNewLine
  131.     .Text = .Text & "y=10* .5" & vbNewLine
  132.     .Text = .Text & "y = 2 ^ 8" & vbNewLine
  133.     .Text = .Text & "y = -1 * 2" & vbNewLine
  134.     .Text = .Text & "z=(((2+3)/(1-0.5))-((-1*2)*(2*3)))"
  135.     .Text = .Text & "y = ( ( 4 * 3 + 6 ) * ( 3 - 4 ) )" & vbNewLine
  136.     .Text = .Text & "y = ( 2 + 4 * 6 - ( 2 - 4 * ( 10 + 20 ) * 2 ) )" & vbNewLine
  137.     .Text = .Text & "y = ( - 1 * 5 ) * ( - 1 )" & vbNewLine
  138.     .Text = .Text & "y = ( - 1 - 5 )" & vbNewLine
  139.     .Text = .Text & "y = - 1 - 5" & vbNewLine
  140.     .Text = .Text & "y = ( - 1 * 5 )" & vbNewLine
  141.     .Text = .Text & "y = 1 + 2 + 3 + 4 + 5" & vbNewLine
  142.     .Text = .Text & "y = 1 - 2 + 3 + 4 - 5" & vbNewLine
  143.     .Text = .Text & "y = 1 * 2 + 3 + 4 * 5" & vbNewLine
  144.     .Text = .Text & "y = 2.5 / .5 * 10" & vbNewLine
  145.     .Text = .Text & "y = 5 mod 2" & vbNewLine
  146.     .Text = .Text & "5 + 7 mod 3" & vbNewLine
  147.     .Text = .Text & "y = ( 5 + 7 + 1 ) mod 3" & vbNewLine
  148.     .Text = .Text & "y = 5 and 8" & vbNewLine
  149.     .Text = .Text & "y = 5 or 8" & vbNewLine
  150.     .Text = .Text & "y = 1 * 2 + 3 + 5 or 8" & vbNewLine
  151.     .Text = .Text & "y = ( 1 * 2 + 3 + 5 ) or 5" & vbNewLine
  152.     .Text = .Text & "Y = &HFFFF AND 2 "
  153.   End With 'TxtEquation
  154.   FrmMain.Caption = FrmMain.Caption & "Execute All Rev. " & (Format$(App.Major, "00") & _
  155.                     "." & Format$(App.Minor, "00") & "." & Format$(App.Revision, "0000"))
  156. End Sub
  157.  
  158. ':)Code Fixer V3.0.9 (8/2/2005 5:15:22 AM) 1 + 91 = 92 Lines Thanks Ulli for inspiration and lots of code.
  159.