frmcalculator.frm

二进制、十进制、十六进制数字的四则运算及转换

   End
   Begin VB.Label Label3 
      Caption         =   "按位逻辑运算"
      Height          =   495
      Left            =   120
      TabIndex        =   24
      Top             =   7440
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "进制转换"
      Height          =   495
      Left            =   240
      TabIndex        =   23
      Top             =   5880
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "移位"
      Height          =   495
      Left            =   360
      TabIndex        =   20
      Top             =   4560
      Width           =   1215
   End
End
Attribute VB_Name = "frmcalculator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit         '定义模块级变量'
Dim t As String '存放临时字符串'
Dim s1, s2 As String
Dim B As Boolean        '为flase 时，输入第一个操作数；为true时，输入第二个操作数'

Dim p As Integer       '存放运算类型：0为加；1为减；2为乘；3为除'
'去掉最右边的一个字符'
Private Sub cmdback_Click()

If Not B Then t = s1 Else t = s2 'b为false时，t存放第一个操作数；b为true时，t存放第二个操作数'
If Len(t) > 0 Then t = Left(t, Len(t) - 1) '若t中字符串长度大于0，则去掉最右边的一个字符'
txtdisplay = t      '在txtdisplay中显示t'

If Not B Then s1 = t Else s2 = t

End Sub
'控件数组的事件过程'
Private Sub cmdcalc_Click(Index As Integer)
s2 = " "                '按下运算符时，把第二个字符串清空'
txtdisplay.Text = " "
B = True                '为输入第二个字符串做准备'
p = Index

End Sub
Private Sub cmdequal_Click()

'单击“=”时进行的运算'

Dim d1 As Long
Dim d2 As Long
Dim d As Long
Dim m As String
If Len(Trim(s1)) = 0 Or Len(Trim(s2)) = 0 Then  '若输入的任一个字符串为空，则不进行计算'
B = False
Exit Sub
End If
If Option1.Value = True Then  '如果选中的是二进制'
d1 = CDbl(BIN_to_DEC(s1))     '把二进制转换成十进制数的函数返回值强制转化为Double型'

d2 = CDbl(BIN_to_DEC(s2))
Else
    If Option2.Value = True Then  '如果选中的是十六进制''
    d1 = HEX_to_DEC(s1)      '把十六进制转换成十进制数的函数返回值强制转化为Double型'

    d2 = HEX_to_DEC(s2)
    Else
        d1 = Val(s1)              '若是十进制数则把字符串转化成数值'
        d2 = Val(s2)
    End If
End If
Select Case p
Case 0                                       '进行不同的运算'
    d = d1 + d2
Case 1


    d = d1 - d2
Case 2

    
    d = d1 * d2
 Case 3
    If d2 = 0 Then                      '除数为零时，报错'
    MsgBox "除数不能为零!", 16, "计算器"
    Exit Sub
    End If
    
    d = d1 / d2
End Select

If Option1.Value = True Then

    m = DEC_to_BIN(d)  '选中的是二进制运算，输出时把十进制转化成二进制'
Else
    If Option2.Value = True Then
        m = DEC_to_HEX(d)   '选中的是十六进制运算，输出时把十进制转化成十六进制'
    Else
    m = CStr(d)
    End If
End If

If Left(Trim(m), 1) = "." Then   '左边第一位是小数点则加零'
m = "0" & Right(m, Len(m))
Else
   If Left(Trim(m), 2) = "-." Then   '左边第一位是“-.”，则变为“-0.”'
   m = "-0" & Right(m, Len(m) - 1)
   End If
End If
txtdisplay = m
B = False                       '为输入第一个操作数做准备'
s1 = " "                        '清空两个字符串'
s2 = " "

    
End Sub

Private Sub cmdnumber_click(Index As Integer)

If Not B Then t = s1 Else t = s2

Select Case Index
Case Is <= 9  '输入的是数字0~9'

    t = t + CStr(Index)         '把数字转换成相应的字符串'
Case 10 To 15                      '输入的是数字A~F'
t = t + DEC_to_HEX(CLng(Index))

Case Else          '输入的是小数点'
    If InStr(t, ".") = 0 Then t = t + "."  '若t中无小数点，则加入小数点（防止出现两个小数点）'
End Select
If Len(t) > 1 And Left(t, 1) = "0" And Mid(t, 2, 1) <> "." Then
t = Right(t, Len(t) - 1) '若t中字符串长度大于1，左边第一个为0，并且第二个不是小数点，则删除多余的0'
End If
txtdisplay.Text = t
If Not B Then s1 = t Else s2 = t



End Sub
'单击时清空'
Private Sub clear_Click()
txtdisplay.Text = ""
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
B = False         '为输入第一个操作数做准备'

s1 = " "                        '清空字符串'
s2 = " "
End Sub

'改变正负号'
Private Sub cmdpn_Click()
If Not B Then t = s1 Else t = s2
If Len(t) > 0 And Left(t, 1) = "-" Then '若t不为空，并且最左边是“-”单击时去掉负号'
t = Right(t, Len(t) - 1)
Else
t = "-" & t    '否则，单击时加上负号'
End If
txtdisplay.Text = t
If Not B Then s1 = t Else s2 = t

End Sub

Private Sub Command4_Click() '默认为十进制'
 Option1.Value = False
 Option2.Value = False
 Option3.Value = True
End Sub

Private Sub Command5_Click()  '结束四则运算'
 Option1.Value = False
 Option2.Value = False
 Option3.Value = False
 txtdisplay = ""
End Sub

Private Sub Form_Load()   '用AddItem方法向组合框控件中添加新条目'
进制转换.AddItem "二进制换算为十进制"
进制转换.AddItem "十六进制换算为十进制"
进制转换.AddItem "十进制换算为二进制"
进制转换.AddItem "十进制换算为十六进制"
进制转换.AddItem "二进制换算为十六进制"
进制转换.AddItem "十六进制换算为二进制"
进制转换.Text = "十进制换算为二进制"
移位.AddItem "左移"
移位.AddItem "右移"
移位.AddItem "循环左移"
移位.AddItem "循环右移"
移位.Text = "左移"
按位逻辑位运算.AddItem "与"
按位逻辑位运算.AddItem "或"
按位逻辑位运算.AddItem "同或"
按位逻辑位运算.AddItem "异或"
按位逻辑位运算.Text = "与"
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""

End Sub

' 将二进制转化为十进制
Public Function BIN_to_DEC(ByVal Bin As String) As Long
Dim i As Long
For i = 1 To Len(Bin)
BIN_to_DEC = BIN_to_DEC * 2 + Val(Mid(Bin, i, 1))
Next i
End Function

' 将十进制转化为二进制
Public Function DEC_to_BIN(Dec As Long) As String
DEC_to_BIN = ""
Do While Dec > 0
DEC_to_BIN = Dec Mod 2 & DEC_to_BIN
Dec = Dec \ 2
Loop
End Function

Public Function HEX_to_BIN(ByVal Hex As String) As String         '十六进制转为二进制
Dim i As Long
Dim B As String

Hex = UCase(Hex)
For i = 1 To Len(Hex)
Select Case Mid(Hex, i, 1) '从左边第一位十六进制数开始逐一转化为二进制数'
Case "0": B = B & "0000"
Case "1": B = B & "0001"
Case "2": B = B & "0010"
Case "3": B = B & "0011"
Case "4": B = B & "0100"
Case "5": B = B & "0101"
Case "6": B = B & "0110"
Case "7": B = B & "0111"
Case "8": B = B & "1000"
Case "9": B = B & "1001"
Case "A": B = B & "1010"
Case "B": B = B & "1011"
Case "C": B = B & "1100"
Case "D": B = B & "1101"
Case "E": B = B & "1110"
Case "F": B = B & "1111"
End Select
Next i
While Left(B, 1) = "0"  '去掉二进制数左边的0'
B = Right(B, Len(B) - 1)
Wend
HEX_to_BIN = B
End Function
Public Function BIN_to_HEX(ByVal Bin As String) As String  '二进制转为十六进制
Dim i As Long
Dim H As String
If Len(Bin) Mod 4 <> 0 Then
Bin = String(4 - Len(Bin) Mod 4, "0") & Bin   '如果二进制的位数不是4的倍数，则在二进制数左边补0，使之是4的倍数'
End If

For i = 1 To Len(Bin) Step 4  '步长为4'
Select Case Mid(Bin, i, 4) '从第一位二进制数开始，每四位转换成一位十六进制数'
Case "0000": H = H & "0"
Case "0001": H = H & "1"
Case "0010": H = H & "2"
Case "0011": H = H & "3"
Case "0100": H = H & "4"
Case "0101": H = H & "5"
Case "0110": H = H & "6"
Case "0111": H = H & "7"
Case "1000": H = H & "8"
Case "1001": H = H & "9"
Case "1010": H = H & "A"
Case "1011": H = H & "B"
Case "1100": H = H & "C"
Case "1101": H = H & "D"
Case "1110": H = H & "E"
Case "1111": H = H & "F"
End Select
Next i
While Left(H, 1) = "0"   '去掉十六进制数左边的0'
H = Right(H, Len(H) - 1)
Wend
BIN_to_HEX = H
End Function
Public Function HEX_to_DEC(ByVal Hex As String) As Long        '十六进制转为十进制，只支持整数部分'
Dim i As Long
Dim B As Long

Hex = UCase(Hex)
For i = 1 To Len(Hex)
Select Case Mid(Hex, Len(Hex) - i + 1, 1)  '从十六进制数的最右面一位开始，每一位数字乘以权值并相加'
Case "0": B = B + 16 ^ (i - 1) * 0
Case "1": B = B + 16 ^ (i - 1) * 1
Case "2": B = B + 16 ^ (i - 1) * 2
Case "3": B = B + 16 ^ (i - 1) * 3
Case "4": B = B + 16 ^ (i - 1) * 4
Case "5": B = B + 16 ^ (i - 1) * 5
Case "6": B = B + 16 ^ (i - 1) * 6
Case "7": B = B + 16 ^ (i - 1) * 7
Case "8": B = B + 16 ^ (i - 1) * 8
Case "9": B = B + 16 ^ (i - 1) * 9
Case "A": B = B + 16 ^ (i - 1) * 10
Case "B": B = B + 16 ^ (i - 1) * 11
Case "C": B = B + 16 ^ (i - 1) * 12
Case "D": B = B + 16 ^ (i - 1) * 13
Case "E": B = B + 16 ^ (i - 1) * 14
Case "F": B = B + 16 ^ (i - 1) * 15
End Select
Next i
HEX_to_DEC = B
End Function

'十进制转化为十六进制'


Public Function DEC_to_HEX(Dec As Long) As String
Dim a As String
DEC_to_HEX = ""
Do While Dec > 0
a = CStr(Dec Mod 16)  '把十进制数与16的余数转化成字符串'
Select Case a
Case "10": a = "A"
Case "11": a = "B"
Case "12": a = "C"
Case "13": a = "D"
Case "14": a = "E"
Case "15": a = "F"
End Select
DEC_to_HEX = a & DEC_to_HEX
Dec = Dec \ 16
Loop
End Function

Private Sub Command1_Click()  '二进制的移位运算'

    Dim str As String
    Dim length As Integer
    str = Text1.Text
    length = Len(str)
    Dim p As Variant
    Dim q As Variant
    Dim r As Variant
    Dim i, j As Integer
    Dim jud As Boolean
    If 0 = length Then
    MsgBox "输入为空!", 48, "计算器" '输入为空时不进行移位操作'
        GoTo en
    End If
     For j = 1 To Len(str)
    If Mid(str, j, 1) <> "0" And Mid(str, j, 1) <> "1" Then    '检查输入是否为二进制数'
           jud = True
           Exit For
    End If
    Next j
If jud Then
    MsgBox "输入了非二进制数！请重新输入", 16, "计算器"
    GoTo en
End If
    
If 移位.Text = "左移" Then
    For i = 2 To length       '从左边第二个开始依次向左移一位，最右边补0'
        p = Mid(str, i, 1)
        
        Mid(str, i - 1, 1) = p
    Next i
    Mid(str, length, 1) = "0"
    Text1.Text = str
End If
If 移位.Text = "循环左移" Then
    q = Mid(str, 1, 1)    '把最左边一位放在p中'
    For i = 2 To length       '从左边第二个开始依次向左移一位，原来最左边的放在最右边'
        p = Mid(str, i, 1)
        Mid(str, i - 1, 1) = p
        
    Next i
    Mid(str, length, 1) = q
    Text1.Text = str
End If
If 移位.Text = "右移" Then
    
    For i = 1 To length - 1  '从右起第二位开始依次右移，最左边补0'