BOOLEAN Expression CALCULATOR program

index.html   bcom.html 

Download VB5.0 Source Code + EXE


VISUAL BASIC 6.0 (5.0) SOURCE CODE (BOOLCALC.FRM) :


VERSION 5.00
Begin VB.Form frmBoolCalc 
   Caption         =   " BOOLEAN CALCULATOR v1.0"
   ClientHeight    =   2400
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6600
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   ScaleHeight     =   2400
   ScaleWidth      =   6600
   StartUpPosition =   1  'CenterOwner
   Begin VB.Frame Frame6 
      Caption         =   "Result"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   162
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   4920
      TabIndex        =   21
      Top             =   1560
      Width           =   1455
      Begin VB.Label Label6 
         BackColor       =   &H00FFFFFF&
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   162
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   120
         TabIndex        =   22
         Top             =   240
         Width           =   1095
      End
   End
   Begin VB.Frame Frame5 
      Caption         =   "Expression"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   162
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1335
      Left            =   2040
      TabIndex        =   19
      Top             =   120
      Width           =   4335
      Begin VB.TextBox Text1 
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   162
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   240
         TabIndex        =   0
         Top             =   360
         Width           =   3855
      End
      Begin VB.Label Label5 
         Caption         =   "F1= Calculate, F10= Info, ESC= End"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   162
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   240
         TabIndex        =   20
         Top             =   840
         Width           =   3855
      End
   End
   Begin VB.Frame Frame4 
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   0
      TabIndex        =   17
      Top             =   1560
      Width           =   1935
      Begin VB.OptionButton Option7 
         Caption         =   "1"
         Height          =   375
         Left            =   720
         TabIndex        =   9
         Top             =   120
         Value           =   -1  'True
         Width           =   375
      End
      Begin VB.OptionButton Option8 
         Caption         =   "0"
         Height          =   375
         Left            =   1200
         TabIndex        =   10
         Top             =   120
         Width           =   495
      End
      Begin VB.Label Label4 
         Caption         =   "D ="
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   162
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   240
         TabIndex        =   18
         Top             =   120
         Width           =   375
      End
   End
   Begin VB.Frame Frame3 
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   0
      TabIndex        =   15
      Top             =   1080
      Width           =   1935
      Begin VB.OptionButton Option5 
         Caption         =   "1"
         Height          =   375
         Left            =   720
         TabIndex        =   7
         Top             =   120
         Value           =   -1  'True
         Width           =   375
      End
      Begin VB.OptionButton Option6 
         Caption         =   "0"
         Height          =   375
         Left            =   1200
         TabIndex        =   8
         Top             =   120
         Width           =   495
      End
      Begin VB.Label Label3 
         Caption         =   "C ="
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   162
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   240
         TabIndex        =   16
         Top             =   120
         Width           =   375
      End
   End
   Begin VB.Frame Frame2 
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   0
      TabIndex        =   13
      Top             =   600
      Width           =   1935
      Begin VB.OptionButton Option3 
         Caption         =   "1"
         Height          =   375
         Left            =   720
         TabIndex        =   5
         Top             =   120
         Value           =   -1  'True
         Width           =   375
      End
      Begin VB.OptionButton Option4 
         Caption         =   "0"
         Height          =   375
         Left            =   1200
         TabIndex        =   6
         Top             =   120
         Width           =   495
      End
      Begin VB.Label Label2 
         Caption         =   "B ="
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   162
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   240
         TabIndex        =   14
         Top             =   120
         Width           =   375
      End
   End
   Begin VB.Frame Frame1 
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   0
      TabIndex        =   11
      Top             =   120
      Width           =   1935
      Begin VB.OptionButton Option2 
         Caption         =   "0"
         Height          =   375
         Left            =   1200
         TabIndex        =   4
         Top             =   120
         Width           =   495
      End
      Begin VB.OptionButton Option1 
         Caption         =   "1"
         Height          =   375
         Left            =   720
         TabIndex        =   3
         Top             =   120
         Value           =   -1  'True
         Width           =   375
      End
      Begin VB.Label Label1 
         Caption         =   "A ="
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   162
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   240
         TabIndex        =   12
         Top             =   120
         Width           =   495
      End
   End
   Begin VB.CommandButton Command2 
      Caption         =   "END"
      Height          =   375
      Left            =   3600
      TabIndex        =   2
      Top             =   1800
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "CALCULATE"
      Height          =   375
      Left            =   2040
      TabIndex        =   1
      Top             =   1800
      Width           =   1335
   End
End
Attribute VB_Name = "frmBoolCalc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim x As Integer
Dim Hata As Integer
Dim Parantez1 As Integer
Dim Parantez2 As Integer
Dim Karakter1 As Integer
Dim Karakter2 As Integer
Dim ExpLenght As Integer
Dim A, B, C, D, NA, NB, NC, ND As Integer
Dim Expression As String
Dim Expression1 As String
Dim Expression2 As String

Private Sub Parser()
RemoveSpaces:
ExpLenght = Len(Expression)
Karakter1 = InStr(Expression, " ")
If Karakter1 > 0 Then
   If Karakter1 > 1 Then
      Expression1 = Left$(Expression, Karakter1 - 1)
   Else
      Expression1 = ""
   End If
   If Karakter1 < ExpLenght Then
      Expression2 = Right$(Expression, ExpLenght - Karakter1)
   Else
      Expression2 = ""
   End If
   Expression = Expression1 + Expression2
   Text1.Text = Expression
   GoTo RemoveSpaces
End If
Call ConvertExpression
ParseParantez:
Parantez1 = InStr(Expression, "(")
If Parantez1 > 0 Then
   Parantez2 = InStr(Parantez1, Expression, ")")
   If Parantez2 = 0 Or Parantez2 < Parantez1 + 2 Then
      Beep
      MsgBox ("Syntax error in the Boolean Expression !"), 48, " BOOLEAN CALCULATOR"
      Hata = True
      Exit Sub
   End If
   Expression1 = Mid$(Expression, Parantez1 + 1, Parantez2 - Parantez1 - 1)
   x = CalcExpression(Expression1)
   If Hata = True Then Exit Sub
   If Parantez1 > 1 Then
      Expression1 = Left$(Expression, Parantez1 - 1) + Trim$(x)
   Else
      Expression1 = Trim$(x)
   End If
   If Parantez2 < ExpLenght Then
      Expression2 = Right$(Expression, ExpLenght - Parantez2)
   Else
      Expression2 = ""
   End If
   Expression = Expression1 + Expression2
   ExpLenght = Len(Expression)
   GoTo ParseParantez
End If
End Sub

Private Sub ConvertExpression()
ParseKarakterNA:
   Karakter1 = InStr(Expression, "A'")
   If Karakter1 > 0 Then
      Karakter2 = Karakter1 + 1
      If Karakter1 > 1 Then
         Expression1 = Left$(Expression, Karakter1 - 1) + Trim$(NA)
      Else
         Expression1 = Trim$(NA)
      End If
      If Karakter2 < ExpLenght Then
         Expression2 = Right$(Expression, ExpLenght - Karakter2)
      Else
         Expression2 = ""
      End If
      Expression = Expression1 + Expression2
      ExpLenght = Len(Expression)
      GoTo ParseKarakterNA
   End If
ParseKarakterNB:
   Karakter1 = InStr(Expression, "B'")
   If Karakter1 > 0 Then
      Karakter2 = Karakter1 + 1
      If Karakter1 > 1 Then
         Expression1 = Left$(Expression, Karakter1 - 1) + Trim$(NB)
      Else
         Expression1 = Trim$(NB)
      End If
      If Karakter2 < ExpLenght Then
         Expression2 = Right$(Expression, ExpLenght - Karakter2)
      Else
         Expression2 = ""
      End If
      Expression = Expression1 + Expression2
      ExpLenght = Len(Expression)
      GoTo ParseKarakterNB
   End If
ParseKarakterNC:
   Karakter1 = InStr(Expression, "C'")
   If Karakter1 > 0 Then
      Karakter2 = Karakter1 + 1
      If Karakter1 > 1 Then
         Expression1 = Left$(Expression, Karakter1 - 1) + Trim$(NC)
      Else
         Expression1 = Trim$(NC)
      End If
      If Karakter2 < ExpLenght Then
         Expression2 = Right$(Expression, ExpLenght - Karakter2)
      Else
         Expression2 = ""
      End If
      Expression = Expression1 + Expression2
      ExpLenght = Len(Expression)
      GoTo ParseKarakterNC
   End If
ParseKarakterND:
   Karakter1 = InStr(Expression, "D'")
   If Karakter1 > 0 Then
      Karakter2 = Karakter1 + 1
      If Karakter1 > 1 Then
         Expression1 = Left$(Expression, Karakter1 - 1) + Trim$(ND)
      Else
         Expression1 = Trim$(ND)
      End If
      If Karakter2 < ExpLenght Then
         Expression2 = Right$(Expression, ExpLenght - Karakter2)
      Else
         Expression2 = ""
      End If
      Expression = Expression1 + Expression2
      ExpLenght = Len(Expression)
      GoTo ParseKarakterND
   End If
ParseKarakterA:
   Karakter1 = InStr(Expression, "A")
   If Karakter1 > 0 Then
      If Karakter1 > 1 Then
         Expression1 = Left$(Expression, Karakter1 - 1) + Trim$(A)
      Else
         Expression1 = Trim$(A)
      End If
      If Karakter1 < ExpLenght Then
         Expression2 = Right$(Expression, ExpLenght - Karakter1)
      Else
         Expression2 = ""
      End If
      Expression = Expression1 + Expression2
      GoTo ParseKarakterA
   End If
ParseKarakterB:
   Karakter1 = InStr(Expression, "B")
   If Karakter1 > 0 Then
      If Karakter1 > 1 Then
         Expression1 = Left$(Expression, Karakter1 - 1) + Trim$(B)
      Else
         Expression1 = Trim$(B)
      End If
      If Karakter1 < ExpLenght Then
         Expression2 = Right$(Expression, ExpLenght - Karakter1)
      Else
         Expression2 = ""
      End If
      Expression = Expression1 + Expression2
      GoTo ParseKarakterB
   End If
ParseKarakterC:
   Karakter1 = InStr(Expression, "C")
   If Karakter1 > 0 Then
      If Karakter1 > 1 Then
         Expression1 = Left$(Expression, Karakter1 - 1) + Trim$(C)
      Else
         Expression1 = Trim$(C)
      End If
      If Karakter1 < ExpLenght Then
         Expression2 = Right$(Expression, ExpLenght - Karakter1)
      Else
         Expression2 = ""
      End If
      Expression = Expression1 + Expression2
      GoTo ParseKarakterC
   End If
ParseKarakterD:
   Karakter1 = InStr(Expression, "D")
   If Karakter1 > 0 Then
      If Karakter1 > 1 Then
         Expression1 = Left$(Expression, Karakter1 - 1) + Trim$(D)
      Else
         Expression1 = Trim$(D)
      End If
      If Karakter1 < ExpLenght Then
         Expression2 = Right$(Expression, ExpLenght - Karakter1)
      Else
         Expression2 = ""
      End If
      Expression = Expression1 + Expression2
      GoTo ParseKarakterD
   End If
   Label5.Caption = Expression
End Sub

Private Function CalcExpression(EqStr As String) As Integer
Dim R As Integer
Dim L As Integer
Dim Y As Integer
Dim S1 As Integer
Dim S2 As Integer
Dim ARTI As Integer
Dim K As String * 1
Dim Kprev As String * 1
Dim Str1 As String
Dim Str2 As String
Parse10:
L = Len(EqStr)
S1 = InStr(EqStr, "10")
If S1 > 0 Then
   S2 = S1 + 1
   If S1 > 1 Then
      Str1 = Left$(EqStr, S1 - 1) + "0"
   Else
      Str1 = "0"
   End If
   If S1 < L Then
      Str2 = Right$(EqStr, L - S2)
   Else
      Str2 = ""
   End If
   EqStr = Str1 + Str2
   GoTo Parse10
End If
Parse11:
S1 = InStr(EqStr, "11")
If S1 > 0 Then
   S2 = S1 + 1
   If S1 > 1 Then
      Str1 = Left$(EqStr, S1 - 1) + "1"
   Else
      Str1 = "1"
   End If
   If S1 < L Then
      Str2 = Right$(EqStr, L - S2)
   Else
      Str2 = ""
   End If
   EqStr = Str1 + Str2
   GoTo Parse10
End If
Parse00:
S1 = InStr(EqStr, "00")
If S1 > 0 Then
   S2 = S1 + 1
   If S1 > 1 Then
      Str1 = Left$(EqStr, S1 - 1) + "0"
   Else
      Str1 = "0"
   End If
   If S1 < L Then
      Str2 = Right$(EqStr, L - S2)
   Else
      Str2 = ""
   End If
   EqStr = Str1 + Str2
   GoTo Parse10
End If
Parse01:
S1 = InStr(EqStr, "01")
If S1 > 0 Then
   S2 = S1 + 1
   If S1 > 1 Then
      Str1 = Left$(EqStr, S1 - 1) + "0"
   Else
      Str1 = "0"
   End If
   If S1 < L Then
      Str2 = Right$(EqStr, L - S2)
   Else
      Str2 = ""
   End If
   EqStr = Str1 + Str2
   GoTo Parse10
End If
For Y = 1 To L
    K = Mid$(EqStr, Y, 1)
    If K <> "1" And K <> "0" And K <> "+" Then
SyntaxError:
       Beep
       MsgBox ("Syntax error in the Boolean Expression !"), 48, " BOOLEAN CALCULATOR"
       Hata = True
       Exit Function
    Else
       If K = "+" Then
          If Y <= 1 or (Kprev <> "1" And Kprev <> "0") Then
             GoTo SyntaxError
          Else
             Str1 = Left$(EqStr, Y - 1)
             R = R + Val(Str1)
             If Y < L Then
                Str2 = Right$(EqStr, L - Y)
                R = R + Val(Str2)
             End If
          End If
          ARTI = True
       End If
    End If
    Kprev = K
Next Y
If ARTI = False Then
   For Y = 1 To L
       K = Mid$(EqStr, Y, 1)
       If K = "0" Then
          R = 0
          Exit For
       Else
          If K = "1" Then R = 1
       End If
   Next Y
End If
If R > 0 Then
   CalcExpression = 1
Else
   CalcExpression = 0
End If
End Function

Private Sub Command1_Click()
Label6.Caption = ""
Label5.Caption = ""
Expression = Trim$(Text1.Text)
If Expression = "" Then
   Beep
   Text1.SetFocus
   Exit Sub
End If
If Option1.Value = True Then
   A = 1
   NA = 0
Else
   A = 0
   NA = 1
End If
If Option3.Value = True Then
   B = 1
   NB = 0
Else
   B = 0
   NB = 1
End If
If Option5.Value = True Then
   C = 1
   NC = 0
Else
   C = 0
   NC = 1
End If
If Option7.Value = True Then
   D = 1
   ND = 0
Else
   D = 0
   ND = 1
End If
Hata = False
Call Parser
x = CalcExpression(Expression)
If Hata = False Then
   Beep
   If x > 0 Then
      Label6.Caption = "True"
   Else
      Label6.Caption = "False"
   End If
End If
Text1.SetFocus
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = &H70 Then
   Command1_Click
Else
   If KeyCode = &H79 Then
      Beep
      MsgBox ("This program is a simple BOOLEAN EXPRESSION CALCULATOR." + Chr$(13) + Chr$(13) + "EXPRESSION ELEMENTS:" + Chr$(13) + "A, B, C, D are inputs (variables)" + Chr$(13) + "A', B', C', D' are inverses of A,B,C,D" + Chr$(13) + "+ is OR operand" + Chr$(13) + Chr$(34) + "(" + Chr$(34) + " and " + Chr$(34) + ")" + Chr$(34) + " are valid parenthesis characters" + Chr$(13) + Chr$(13) + "EXAMPLE:" + Chr$(13) + "A'+BC'D(A+C')+AB(C'+D') is a valid expression" + Chr$(13) + Chr$(13) + "NOTE:" + Chr$(13) + "Invalid expression characters cause a SYNTAX ERROR message."), 0, " © Erdogan Tan [ September 23, 2001 ]"
   End If
End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 27 Then End
End Sub

Private Sub Option1_Click()
Text1.SetFocus
End Sub

Private Sub Option2_Click()
Text1.SetFocus
End Sub

Private Sub Option3_Click()
Text1.SetFocus
End Sub

Private Sub Option4_Click()
Text1.SetFocus
End Sub

Private Sub Option5_Click()
Text1.SetFocus
End Sub

Private Sub Option6_Click()
Text1.SetFocus
End Sub

Private Sub Option7_Click()
Text1.SetFocus
End Sub

Private Sub Option8_Click()
Text1.SetFocus
End Sub

Last Update: 28/10/2001