please send me VB Code of Simple calculator its urgent before 21 july2006..?

Answer 1

Search on

http://www.vbcode.com/
http://www.a1vbcode.com/

Answer 2

This is a calculator I have in Microsoft Access, compiled using VBA... With a little imagination and editing, you can turn it into a VB Code.

---------- ------------ ---------- ------------ ---------- ------------ ------------

Option Explicit

Private Const GHND = &H42
Private Const MAXSIZE = 4096
Private Const CF_TEXT = 1

Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal _
dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _
As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) _
As Long
Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
ByVal lpString2 As Any) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _
As Long

Private Declare Function OpenClipboard Lib "User32" (ByVal Hwnd As Long) _
As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
Private Declare Function GetClipboardData Lib "User32" (ByVal wFormat As _
Long) As Long
Private Declare Function EmptyClipboard Lib "User32" () As Long
Private Declare Function SetClipboardData Lib "User32" (ByVal wFormat _
As Long, ByVal hMem As Long) As Long

Const opNone = 0
Const opDivide = 1
Const opMultiply = 2
Const opSubtract = 3
Const opAdd = 4
Const opClear = 5

Dim byteOpHolder As Byte
Dim frmCallingForm As Form, strCallingControl As String
Private Function checkproperty(strPropName As String) As Variant
'****** Error Handler ******
On Error GoTo MyProc_Err
'****** ErrorHandler End ******

'Returns the database property value
Dim dbMdb As Database, prp As Property
Set dbMdb = CurrentDb

checkproperty = dbMdb.Properties(strPropName)
MyProc_Err:
Exit Function
End Function
Private Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Boolean
'Changes the database property passed to the datatype and value passed.
'If the property does not exist an error is generated and the property is created.

Dim dbMdb As Database, prp As Property
Const conPropNotFoundError = 3270
Set dbMdb = CurrentDb
On Error GoTo Change_Err
dbMdb.Properties(strPropName) = varPropValue
ChangeProperty = True
Change_Bye:
Exit Function
Change_Err:
If Err = conPropNotFoundError Then 'prop not found
Set prp = dbMdb.CreateProperty(strPropName, varPropType, varPropValue)
dbMdb.Properties.Append prp
Resume Next
Else
'unknown error
ChangeProperty = False
Resume Change_Bye
End If
End Function

Private Function HandleCalc(strNum As String)
Dim loctrl As Label
Set loctrl = Me!txtDisplay

With loctrl
If byteOpHolder = opClear Then
.Caption = 0
byteOpHolder = opNone
End If
Select Case .Caption
Case 0
.Caption = strNum
Case Else
.Caption = .Caption & strNum
End Select
End With
HandleCalc = True
End Function

Private Function HandleMem(memAction As Byte) As Boolean
Dim dblTxt As Double, dblMem As Double

dblMem = Val(lblMem.Caption)
dblTxt = Val(txtDisplay.Caption)
Select Case memAction
Case 0 'Memory plus
lblMem.Caption = dblMem + dblTxt
Case 1 'Memory Minus
lblMem.Caption = dblMem - dblTxt
Case 2 'Recall memory
txtDisplay.Caption = dblMem
' byteOpHolder = opClear
Case 3 'Clear Memory
lblMem.Caption = 0
End Select
lblMemInd.Visible = lblMem.Caption
HandleMem = True
End Function

Private Function HandleOperator(byteOperation As Byte) As Boolean
cmdEquals_Click
With txtDisplay
lblTempStore.Caption = .Caption
.Caption = 0
End With
byteOpHolder = byteOperation
HandleOperator = True
End Function

Private Sub cmdCopy_Click()
Call ClipBoard_SetData(txtDisplay.Caption)
End Sub

Private Sub cmdEquals_Click()
Dim dblLblTempStore As Double, dbltxtDisplay As Double, dblResult As Double
dblLblTempStore = lblTempStore.Caption
dbltxtDisplay = txtDisplay.Caption
Select Case byteOpHolder
Case opDivide
If dbltxtDisplay <> 0 Then
dblResult = dblLblTempStore / dbltxtDisplay
Else
dblResult = 0
End If
Case opMultiply
dblResult = dblLblTempStore * dbltxtDisplay
Case opSubtract
dblResult = dblLblTempStore - dbltxtDisplay
Case opAdd
dblResult = dblLblTempStore + dbltxtDisplay
End Select
If byteOpHolder <> opNone And byteOpHolder <> opClear Then
txtDisplay.Caption = dblResult
lblTempStore.Caption = dblResult
End If
byteOpHolder = opClear
End Sub

Private Sub CmdCa_Click()
lblTempStore.Caption = 0
lblMem.Caption = 0
txtDisplay.Caption = 0
lblMemInd.Visible = lblMem.Caption
End Sub

Private Sub cmdClear_Click()
txtDisplay.Caption = 0
End Sub

Private Sub cmdClose_Click()
Dim boolRet As Boolean
boolRet = ChangeProperty("calcDisplay", dbDouble, Val(txtDisplay.Caption))
boolRet = ChangeProperty("calcMem", dbDouble, Val(lblMem.Caption))
boolRet = ChangeProperty("calcTempStore", dbDouble, Val(lblTempStore.Caption))
DoCmd.Close acForm, Me.Name
End Sub

Private Sub cmdHelp_Click()
Dim strMsg As String, intButt As Integer, strTitle As String
Dim strTab As String
strTab = Chr$(9)
strMsg = "Calculator Help@"
strMsg = strMsg & "Use the mouse or keyboard for numbers and" & vbCrLf
strMsg = strMsg & "arithmetical operators." & vbCrLf & vbCrLf
strMsg = strMsg & "Use the mouse or the listed keys for the" & vbCrLf
strMsg = strMsg & "following operations:" & vbCrLf & vbCrLf
strMsg = strMsg & strTab & "[Esc]" & strTab & strTab & "Cl" & vbCrLf
strMsg = strMsg & strTab & "Shift[Esc]" & strTab & "Ca" & vbCrLf
strMsg = strMsg & strTab & "[BackSpace]" & strTab & "Remove last character" & vbCrLf
strMsg = strMsg & strTab & "[Enter]" & strTab & strTab & "=" & vbCrLf
strMsg = strMsg & strTab & "[F1]" & strTab & strTab & "This Help" & vbCrLf
strMsg = strMsg & strTab & "[F2]" & strTab & strTab & "M+" & vbCrLf
strMsg = strMsg & strTab & "[F3]" & strTab & strTab & "M-" & vbCrLf
strMsg = strMsg & strTab & "[F4]" & strTab & strTab & "Rm" & vbCrLf
strMsg = strMsg & strTab & "[F5]" & strTab & strTab & "Cm" & vbCrLf
strMsg = strMsg & strTab & "Ctrl[F4]" & strTab & strTab & "Close@"
strTitle = "Access Calculator"
intButt = vbOKOnly
MsgBox strMsg, intButt, strTitle
End Sub

Private Sub cmdPaste_Click()
txtDisplay.Caption = Val(ClipBoard_GetData)
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim boolRet As Boolean, lenTxtDisplay As Integer
Select Case Shift
Case 1 'Shift Key Down
Select Case KeyCode
Case 27 'Shift Esc (Ca)
CmdCa_Click
Case 56 'Multiply
boolRet = HandleOperator(opMultiply)
Case 187 'Addition
boolRet = HandleOperator(opAdd)
End Select
Case 2 'Ctrl Key Down
Select Case KeyCode
Case vbKeyF4 'Ctrl[F4]
cmdClose_Click
Case vbKeyC
Call ClipBoard_SetData(txtDisplay.Caption)
Case vbKeyV
txtDisplay.Caption = Val(ClipBoard_GetData)
End Select
Case 4 'Alt Key Down
Select Case KeyCode
Case 67 'Alt C
cmdClose_Click
Case 80 'Alt P
cmdPaste_Click
End Select
Case Else
Select Case KeyCode
Case 8 'backspace (Ca)
lenTxtDisplay = Len(txtDisplay.Caption)
If lenTxtDisplay > 1 Then
txtDisplay.Caption = Left(txtDisplay.Caption, lenTxtDisplay - 1)
Else
txtDisplay.Caption = 0
End If
Case 13, 187 'Enter or =
cmdEquals_Click
Case 27 'Esc (Cl)
cmdClear_Click
Case 48 To 57 '0 to 9
boolRet = HandleCalc(KeyCode - 48)
Case 95 To 105 '0 to 9
boolRet = HandleCalc(KeyCode - 96)
Case 106 'Multiply
boolRet = HandleOperator(opMultiply)
Case 107 'Addition
boolRet = HandleOperator(opAdd)
Case 109, 189 'Minus
boolRet = HandleOperator(opSubtract)
Case 111, 191 'Divide
boolRet = HandleOperator(opDivide)
Case 110, 190 'Decimal Point
boolRet = HandleCalc(".") 'Decimal Point
Case vbKeyF1 'F1 (help)
cmdHelp_Click
Case vbKeyF2 'F2 (M+)
boolRet = HandleMem(0)
Case vbKeyF3 'F3 (M-)
boolRet = HandleMem(1)
Case vbKeyF4 'F4 (Rm)
boolRet = HandleMem(2)
Case vbKeyF5 'F5 (Cm)
boolRet = HandleMem(3)
End Select
End Select
KeyCode = 0
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub

Private Sub Form_Open(Cancel As Integer)
On Error Resume Next
Me.SetFocus
DoCmd.Restore
lblMem.Caption = Val(checkproperty("calcMem"))
lblTempStore.Caption = Val(checkproperty("calcTempStore"))
txtDisplay.Caption = Val(checkproperty("calcDisplay"))
lblMemInd.Visible = CBool(lblMem.Caption)
End Sub

Private Function ClipBoard_SetData(MyString As String)
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, X As Long

' Allocate moveable global memory.
'-------------------------------------------
hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)

' Lock the block to get a far pointer
' to this memory.
lpGlobalMemory = GlobalLock(hGlobalMemory)

' Copy the string to this global memory.
lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

' Unlock the memory.
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
GoTo OutOfHere2
End If

' Open the Clipboard to copy data to.
If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Function
End If

' Clear the Clipboard.
X = EmptyClipboard()

' Copy the data to the Clipboard.
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:
If CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard."
End If
End Function

Private Function ClipBoard_GetData()
Dim hClipMemory As Long
Dim lpClipMemory As Long
Dim MyString As String
Dim RetVal As Long

If OpenClipboard(0&) = 0 Then
MsgBox "Cannot open Clipboard. Another app. may have it open"
Exit Function
End If

' Obtain the handle to the global memory
' block that is referencing the text.
hClipMemory = GetClipboardData(CF_TEXT)
If IsNull(hClipMemory) Then
MsgBox "Could not allocate memory"
GoTo OutOfHere
End If

' Lock Clipboard memory so we can reference
' the actual data string.
lpClipMemory = GlobalLock(hClipMemory)

If Not IsNull(lpClipMemory) Then
MyString = Space$(MAXSIZE)
RetVal = lstrcpy(MyString, lpClipMemory)
RetVal = GlobalUnlock(hClipMemory)

' Peel off the null terminating character.
MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
Else
MsgBox "Could not lock memory to copy string from."
End If
OutOfHere:
RetVal = CloseClipboard()
ClipBoard_GetData = MyString
End Function

Answer 3

No idea what a VB code is but I found a site where they are code breakers maybe they can help you.