' Forma eklenmesi gerekenler örnek dosyada bulabilirsiniz
'
' Calculator.frm
'
' By Herman Liu
'
' A calculator. It is built on a sample of VB with the following additional features/
' major enhancements:
'
' 1. Users can use both mouse and keyboard key to carry out entries for numerals,
' operating signs (Enter key is made the same as =), etc.
'
' 2. Provide memory functions.
'
' 3. Allow copying calculation result to the clipboard.
'
'----------------------------------------------------------------------------------
' Memo: frmCalculator.Operator(4).Setfocus after a numeric or operation key.
' (Because "Enter" key ASCII code cannot always be detected in a Windows
' environment, to get around, we let focus always stay on the button "=", so that
' whenever user presses Enter key, it will effectively be as if pressing "=" key).
'----------------------------------------------------------------------------------
Option Explicit
Const Maxdigits = 16 ' After this, scientific notation
Dim Op1 As Variant ' Prev input operand
Dim Op2 As Variant ' Further prev input operand
Dim DecimalFlag As Integer ' Decimal point present yet?
Dim NumOps As Integer ' Numkey of operands, 0 to 2
Dim LastInput As String ' Indicate type of last keypress event.
Dim OpFlag As String ' Indicate pending operation.
Dim PrevReadout As String ' For restore if "CE"
Dim MemoResult ' Store result for memo keys
Dim XReadout As String
Dim XOp1 As Variant
Dim XOp2 As Variant
Dim XDecimalFlag As Integer
Dim XNumOps As Integer
Dim XLastInput As String
Dim XOpFlag As String
Dim XCaption As String
Dim XMemoResult
Private Sub Form_Load()
ResetStatus
End Sub
Sub ResetStatus()
Readout = Format(0, "0.")
PrevReadout = Format(0, "0.")
Op1 = 0
Op2 = 0
DecimalFlag = False
NumOps = 0
LastInput = "NONE"
OpFlag = " "
lblMemoFlag.Caption = " "
MemoResult = 0
End Sub
Sub RestoreStatus()
Readout = XReadout
Op1 = XOp1
Op2 = XOp2
DecimalFlag = XDecimalFlag
NumOps = XNumOps
LastInput = XLastInput
OpFlag = XOpFlag
lblMemoFlag.Caption = XCaption
MemoResult = XMemoResult
End Sub
Sub MarkStatus()
XReadout = Readout
XOp1 = Op1
XOp2 = Op2
XDecimalFlag = DecimalFlag
XNumOps = NumOps
XLastInput = LastInput
XOpFlag = OpFlag
XCaption = lblMemoFlag.Caption
XMemoResult = MemoResult
End Sub
Private Function MaxReached()
MaxReached = False
If Len(Readout) >= Maxdigits Then ' Not allow further Numkey
MaxReached = True
End If
End Function
Function HasDecimal(strToRead As String)
HasDecimal = False
Dim i As Integer
For i = Len(strToRead) To 1 Step -1
If InStr(i, strToRead, ".") Then
HasDecimal = True
Exit For
End If
Next
End Function
' Copy the "Label" Caption onto the Clipboard.
Private Sub CopyButton_Click()
Clipboard.SetText Readout
End Sub
Private Sub Cancel_Click()
ResetStatus
Operator(4).SetFocus
End Sub
Private Sub CancelEntry_Click()
RestoreStatus
LastInput = "CE"
Operator(4).SetFocus
End Sub
Private Sub Decimal_Click()
If HasDecimal(Readout) Then ' One is enough
Exit Sub
End If
If LastInput = "NUMS" Or LastInput = "DIGI" Then
If Len(Readout) = Maxdigits Then
MsgBox "Maximum digits " & Str(Maxdigits - 1) + _
vbCrLf & "Cannot add another digit"
Operator(4).SetFocus
Exit Sub
End If
End If
Me.Decimal.SetFocus
MarkStatus
If LastInput = "NEG" Then
If Abs(Val(Readout)) <> 0 Then
Readout = Format(0, "-0.")
End If
ElseIf LastInput <> "NUMS" And LastInput <> "DIGI" Then
Readout = Format(0, "0.")
End If
DecimalFlag = True
LastInput = "DIGI"
If MaxReached Then
MsgBox "Maximum digits " & Str(Maxdigits - 1) + _
vbCrLf & "Result overflowed"
RestoreStatus
Exit Sub
End If
Operator(4).SetFocus
End Sub
Private Sub Numkey_Click(Index As Integer)
If LastInput = "NUMS" Or LastInput = "DIGI" Then
If MaxReached Then
MsgBox "Maximum digits " & Str(Maxdigits - 1) + _
vbCrLf & "Cannot add another digit"
Operator(4).SetFocus
Exit Sub
End If
End If
Me.NumKey(Index).SetFocus
MarkStatus
If LastInput <> "NUMS" And LastInput <> "DIGI" Then
Readout = Format(0, ".")
DecimalFlag = False
End If
If DecimalFlag Then
Readout = Readout + NumKey(Index).Caption
Else
Readout = Left(Readout, InStr(Readout, Format(0, ".")) - 1) + NumKey(Index).Caption + Format(0, ".")
End If
If LastInput = "NEG" Then
Readout = "-" & Readout
End If
LastInput = "NUMS"
Operator(4).SetFocus
End Sub
Private Sub Operator_Click(Index As Integer)
Me.Operator(Index).SetFocus
MarkStatus
Dim strTempreadout As String
strTempreadout = Readout
If LastInput = "NUMS" Or LastInput = "DIGI" Then
NumOps = NumOps + 1
End If
Select Case NumOps
Case 0
If Operator(Index).Caption = "-" And LastInput <> "NEG" Then
If Abs(Val(Readout)) <> 0 Then
Readout = "-" & Readout
LastInput = "NEG"
End If
End If
Case 1
Op1 = Readout
If Operator(Index).Caption = "-" And (LastInput <> "NUMS" _
And LastInput <> "DIGI") And OpFlag <> "=" Then
If Abs(Val(Readout)) <> 0 Then
Readout = "-"
LastInput = "NEG"
End If
End If
Case 2
Op2 = strTempreadout
Select Case OpFlag
Case "+"
Op1 = CDbl(Op1) + CDbl(Op2)
Case "-"
Op1 = CDbl(Op1) - CDbl(Op2)
Case "*"
Op1 = CDbl(Op1) * CDbl(Op2)
Case "/"
If Op2 = 0 Then
MsgBox "Can't divide by zero", 48, "Calculator"
RestoreStatus
Exit Sub
Else
Op1 = CDbl(Op1) / CDbl(Op2)
End If
Case "="
Op1 = CDbl(Op2)
End Select
Readout = Op1
NumOps = 1
End Select
If LastInput <> "NEG" Then
LastInput = "OPS"
OpFlag = Operator(Index).Caption
End If
' Be consistent, since we always show a decimal point
If Not HasDecimal(Readout) Then
If Abs(Val(Readout)) = 0 Then
Readout = "0."
Else
Readout = Readout + "."
End If
End If
Operator(4).SetFocus
End Sub
Private Sub MemoKey_Click(Index As Integer)
MarkStatus
Select Case Index
Case 0 ' Memory Plus
MemoResult = MemoResult + Val(Readout)
Case 1 ' Memory Minus
MemoResult = MemoResult - Val(Readout)
Case 2 ' Memory Recall
Dim s As String
s = Str(MemoResult)
If Not HasDecimal(Str(s)) Then
s = s + "."
End If
Readout = s
Case 3 ' Memory Clear
MemoResult = 0
End Select
' Our system is, if MemoResult is not cleared, show "M"
If MemoResult <> 0 Then
lblMemoFlag.Caption = "M"
Else
lblMemoFlag.Caption = " "
End If
LastInput = "OPS"
NumOps = 1
Op1 = Readout
Op2 = 0
Operator(4).SetFocus
End Sub
' Detect keyboard key
Private Sub Form_KeyPress(keyascii As Integer)
MarkStatus
If keyascii < Asc("0") Or keyascii > Asc("9") Then
If keyascii <> 46 And keyascii <> 43 And _
keyascii <> 45 And keyascii <> 42 And _
keyascii <> 47 And keyascii <> 61 And _
keyascii <> 13 Then
keyascii = 0
Else
Select Case keyascii
Case 46 ' "."
Decimal_Click
Case 43
Operator_Click (0) ' re Property "+"
Case 45 ' "-"
Operator_Click (1)
Case 42 ' "*"
Operator_Click (2)
Case 47 ' "/"
Operator_Click (3)
Case 61 ' "="
Operator_Click (4)
Case 13 ' As "=" (if Windows allows Enter)
Operator_Click (4)
End Select
End If
Else
Numkey_Click (Val(Chr(keyascii)))
End If
End Sub
27 Şubat 2011, 16:18
Benzer Konular 
Normal
