Friday, August 21, 2009

Calculator




Private Sub cmdclear_Click()

Open "c:\try.txt" For Output As #1

Print #1, a

Close #1

End Sub

Private Sub cmdcos_Click()

If (txtip.Text <> "") Then

Dim res As Double

res = Val(txtip.Text)

res = Cos(res)

txtip.Text = ""

txtip.Text = res

End If

End Sub

Private Sub cmdd_Click()

txtip.Text = txtip.Text & "D"

End Sub

Private Sub cmddel_Click()

If (txtip.Text <> "") Then

Dim str As String

Dim j As Integer

Dim k As Integer

k = 1

str = txtip.Text

j = Len(str)

j = j - 1

str = Mid(str, 1, j)

txtip.Text = " "

txtip.Text = str

End If

End Sub

Private Sub cmdclr_Click()

txtip.Text = ""

End Sub

Private Sub cmddiv_Click()

If (txtip.Text <> "") Then

a = Val(txtip.Text)

txtip.Text = " "

i = 4

End If

End Sub

Private Sub cmde_Click()

txtip.Text = txtip.Text & "E"

End Sub

Private Sub cmdeql_Click()

b = Val(txtip.Text)

txtip.Text = " "

If (i = 1) Then

txtip.Text = a + b

ElseIf (i = 2) Then

txtip.Text = a - b

ElseIf (i = 3) Then

txtip.Text = a * b

ElseIf (i = 4) Then

txtip.Text = a / b

ElseIf (i = 5) Then

txtip.Text = a Mod b

ElseIf (i = 6) Then

txtip.Text = a And b

ElseIf (i = 7) Then

txtip.Text = a Or b

ElseIf (i = 8) Then

txtip.Text = a Xor b

ElseIf (i = 9) Then

txtip.Text = a ^ b

End If

End Sub

Private Sub cmdexit_Click()

Unload Me

End Sub

Private Sub cmdf_Click()

txtip.Text = txtip.Text & "F"

End Sub

Private Sub cmdmod_Click()

If (txtip.Text <> "") Then

a = Val(txtip.Text)

txtip.Text = " "

i = 5

End If

End Sub

Private Sub cmdmul_Click()

If (txtip.Text <> "") Then

a = txtip.Text

txtip.Text = " "

i = 3

End If

End Sub

Private Sub cmdnot_Click()

If (txtip.Text <> "") Then

Dim a As Integer

Dim u, j As Integer

Dim str As String

If (opthex.Value = True) Then

flag = 0

txtip.Text = dec(txtip.Text, 1)

pqr:

bin (Val(txtip.Text))

mno:

str = txtip.Text

j = Len(txtip.Text)

txtip.Text = ""

u = 1

While (j >= u)

a = Mid(str, u, 1)

u = u + 1

If (a = "1") Then

txtip.Text = txtip.Text & "0"

Else

txtip.Text = txtip.Text & "1"

End If

Wend

u = 1

str = ""

j = 16 - Len(txtip.Text)

While (j >= u)

str = str & "1"

u = u + 1

Wend

txtip.Text = str & txtip.Text

If (flag = 0) Then

txtip = abc(txtip.Text)

ElseIf (flag = 2) Then

txtip = cde(txtip.Text)

End If

ElseIf (optdec.Value = True) Then

txtip.Text = Not (Val(txtip.Text))

ElseIf (otpbin.Value = True) Then

flag = 1

GoTo mno

ElseIf (optoct.Value = True) Then

txtip.Text = dec(txtip.Text, 0)

flag = 2

GoTo pqr

End If

End If

End Sub

Private Sub cmdor_Click()

If (txtip.Text <> "") Then

a = Val(txtip.Text)

txtip.Text = " "

i = 7

End If

End Sub

Private Sub cmdpnt_Click()

txtip.Text = txtip.Text & "."

End Sub

Private Sub cmdpow_Click()

If (txtip.Text <> "") Then

a = Val(txtip.Text)

txtip.Text = " "

i = 9

End If

End Sub

Private Sub cmdread_Click()

Open "c:\try.txt" For Input As #1

txtip.Text = Val(Input$(LOF(1), #1))

Close #1

End Sub

Private Sub cmdsin_Click()

If (txtip.Text <> "") Then

Dim res As Double

res = Val(txtip.Text)

res = Sin(res)

txtip.Text = ""

txtip.Text = res

End If

End Sub

Private Sub cmdsqrt_Click()

If (txtip.Text <> "") Then

a = txtip.Text

txtip.Text = " "

txtip.Text = Sqr(a)

End If

End Sub

Private Sub cmdsub_Click()

If (txtip.Text <> "") Then

a = txtip.Text

txtip.Text = " "

i = 2

End If

End Sub

Private Sub cmdtan_Click()

If (txtip.Text <> "") Then

Dim res As Double

res = Val(txtip.Text)

res = Tan(res)

txtip.Text = ""

txtip.Text = res

End If

End Sub

Private Sub cmdwrite_Click()

Open "c:\try.txt" For Output As #1

Print #1, Val(txtip.Text)

Close #1

End Sub

Private Sub cmdxor_Click()

If (txtip.Text <> "") Then

a = Val(txtip.Text)

txtip.Text = " "

i = 8

End If

End Sub

Private Sub Form_Load()

con = 1

flag = 1

optdec.Value = True

endec

End Sub

Private Sub optdec_Click()

endec

If (con = 2 And txtip.Text <> "") Then

txtip.Text = bintodec(txtip.Text)

End If

If (con = 3 And txtip.Text <> "") Then

txtip.Text = octtodec(txtip.Text)

End If

If (con = 4 And txtip.Text <> "") Then

txtip.Text = hextodec(txtip.Text)

End If

con = 1

End Sub

Private Sub opthex_Click()

enhex

If (con = 1 And txtip.Text <> "") Then

txtip.Text = dectohex(txtip.Text)

End If

If (con = 2 And txtip.Text <> "") Then

txtip.Text = bintohex(txtip.Text)

End If

If (con = 3 And txtip.Text <> "") Then

txtip.Text = octtohex(txtip.Text)

End If

con = 4

txtip.SetFocus

End Sub

Private Sub optoct_Click()

enoct

If (con = 1 And txtip.Text <> "") Then

txtip.Text = dectooct(txtip.Text)

End If

If (con = 2 And txtip.Text <> "") Then

txtip.Text = bintooct(txtip.Text)

End If

If (con = 4 And txtip.Text <> "") Then

txtip.Text = hextooct(txtip.Text)

End If

con = 3

txtip.SetFocus

End Sub

Private Sub otpbin_Click()

enbin

If (con = 1 And txtip.Text <> "") Then

txtip.Text = dectobin(txtip.Text)

End If

If (con = 3 And txtip.Text <> "") Then

txtip.Text = octtobin(txtip.Text)

End If

If (con = 4 And txtip.Text <> "") Then

txtip.Text = hextobin(txtip.Text)

End If

con = 2

txtip.SetFocus

End Sub

Public Function endec()

cmd0.Enabled = True

cmd1.Enabled = True

cmd2.Enabled = True

cmd3.Enabled = True

cmd4.Enabled = True

cmd5.Enabled = True

cmd6.Enabled = True

cmd7.Enabled = True

cmd8.Enabled = True

cmd9.Enabled = True

cmda.Enabled = False

cmdb.Enabled = False

cmdc.Enabled = False

cmdd.Enabled = False

cmde.Enabled = False

cmdf.Enabled = False

End Function

Public Function enbin()

cmd0.Enabled = True

cmd1.Enabled = True

cmd2.Enabled = False

cmd3.Enabled = False

cmd4.Enabled = False

cmd5.Enabled = False

cmd6.Enabled = False

cmd7.Enabled = False

cmd8.Enabled = False

cmd9.Enabled = False

cmda.Enabled = False

cmdb.Enabled = False

cmdc.Enabled = False

cmdd.Enabled = False

cmde.Enabled = False

cmdf.Enabled = False

End Function

Public Function enoct()

cmd0.Enabled = True

cmd1.Enabled = True

cmd2.Enabled = True

cmd3.Enabled = True

cmd4.Enabled = True

cmd5.Enabled = True

cmd6.Enabled = True

cmd7.Enabled = True

cmd8.Enabled = False

cmd9.Enabled = False

cmda.Enabled = False

cmdb.Enabled = False

cmdc.Enabled = False

cmdd.Enabled = False

cmde.Enabled = False

cmdf.Enabled = False

End Function

Public Function enhex()

cmd0.Enabled = True

cmd1.Enabled = True

cmd2.Enabled = True

cmd3.Enabled = True

cmd4.Enabled = True

cmd5.Enabled = True

cmd6.Enabled = True

cmd7.Enabled = True

cmd8.Enabled = True

cmd9.Enabled = True

cmda.Enabled = True

cmdb.Enabled = True

cmdc.Enabled = True

cmdd.Enabled = True

cmde.Enabled = True

cmdf.Enabled = True

End Function

Public Function bin(a As Integer)

Dim j As Integer

txtip.Text = ""

While (a > 0)

j = a Mod 2

a = a \ 2

txtip.Text = txtip.Text & j

Wend

txtip.Text = StrReverse(txtip.Text)

End Function

Public Function dec(a As String, f As Integer) As String

Dim k, j, u, temp As Integer

Dim X As String

j = Len(a)

temp = 0

u = 0

If (f = 0) Then

k = 8

Else

k = 16

End If

While (j > 0)

X = Mid(a, j, 1)

j = j - 1

If ((Asc(X) >= 65 And Asc(X) <= 70) Or (Asc(X) >= 97 And Asc(X) <= 102)) Then

X = gethex(X)

End If

temp = temp + Val(X) * (k ^ u)

u = u + 1

Wend

dec = temp

End Function


No comments:

Post a Comment