frmcalculator.frm

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

        p = Mid(str, length - i, 1)
        Mid(str, length - i + 1, 1) = p
        
    Next i
    Mid(str, 1, 1) = "0"
    Text1.Text = str
End If
If 移位.Text = "循环右移" Then
    r = Mid(str, length, 1) '把最右边一位放在r中'
    For i = 1 To length - 1  '从右起第二位开始依次右移，原来最右边的放在最左边'
        p = Mid(str, length - i, 1)
        Mid(str, length - i + 1, 1) = p
    Next i
    Mid(str, 1, 1) = r
    Text1.Text = str
End If
en:

End Sub
'二进制数按位逻辑运算'
Private Sub Command3_Click()
Dim str1 As String
Dim str2 As String
Dim r, i As Integer
Dim len1 As Integer
Dim len2 As Integer
Dim k, l, j As Integer
Dim judge1  As Boolean
Dim judge2 As Boolean
str1 = Text3.Text
str2 = Text4.Text
len1 = Len(str1)
len2 = Len(str2)
If (0 = len1) Or (0 = len2) Then
      MsgBox "输入不能为空!", 48, "计算器"
      GoTo en
      End If
 For k = 1 To Len(str1)
    If Mid(str1, k, 1) <> "0" And Mid(str1, k, 1) <> "1" Then    '检查输入是否为二进制数'
           judge1 = True
           Exit For
    End If
Next k
For l = 1 To Len(str2)
    If Mid(str2, l, 1) <> "0" And Mid(str2, l, 1) <> "1" Then
           judge2 = True
           Exit For
    End If
Next l
If judge1 Or judge2 Then
    MsgBox "输入了非二进制数！请重新输入", 16, "计算器"
    GoTo en
End If
                          
If len1 >= len2 Then
    For i = 1 To len1 - len2 '在位数少的二进制数前补零，确保两个二进制数位数相等'
        str2 = "0" + str2
    Next i
End If
If len1 < len2 Then
    For i = 1 To len2 - len1
        str1 = "0" + str1
    Next i
    len1 = len2
End If
    
If 按位逻辑位运算.Text = "与" Then
        For j = 1 To len1
             r = Mid(str1, j, 1) And Mid(str2, j, 1) '两个二进制数按位逐一求与并把结果放在第一个字符串中'
             Mid(str1, j, 1) = r
        Next j
    Text5.Text = str1
End If
If 按位逻辑位运算.Text = "或" Then                 '两个二进制数按位逐一求或并把结果放在第一个字符串中'
        For j = 1 To len1
           r = Mid(str1, j, 1) Or Mid(str2, j, 1)
           Mid(str1, j, 1) = r
        Next j
  Text5.Text = str1
End If
If 按位逻辑位运算.Text = "同或" Then              '两个二进制数按位逐一求异或后若为0，则往第一个字符串中写入1，否则，写入0'
        For j = 1 To len1
            r = Mid(str1, j, 1) Xor Mid(str2, j, 1)
            If r = 0 Then
                Mid(str1, j, 1) = 1
            ElseIf r = 1 Then
                Mid(str1, j, 1) = 0
            End If
        Next j
    Text5.Text = str1
End If
    If 按位逻辑位运算.Text = "异或" Then         '两个二进制数按位逐一求异或并把结果放在第一个字符串中'
        For j = 1 To len1
            r = Mid(str1, j, 1) Xor Mid(str2, j, 1)
            Mid(str1, j, 1) = r
        Next j
    Text5.Text = str1
End If
en:
End Sub




Private Sub Command2_Click()
    Dim B As String             '要进行转换的字符串'
    Dim pot, length, i, j As Integer  'pot代表小数点的位置'
    Dim mpot As Integer             'mpot代表小数点的个数'
    B = Text2.Text
    length = Len(B)
    If 0 = length Then
        MsgBox "输入不能为空!", 48, "计算器"   '输入为空，则不进行操作'
        GoTo en
    End If
If 进制转换.Text = "二进制换算为十进制" Then
    
    
     
    B = Text2.Text
    length = Len(B)
    If 0 = length Then
        MsgBox "输入不能为空!", 48, "计算器"
        GoTo en
    End If
    pot = 0
    mpot = 0
    
    
    For i = 1 To length
        If (Mid(B, i, 1) = ".") Then
            pot = i                        '找到小数点的位置
            mpot = mpot + 1     '小数点的个数
        End If
        If (Mid(B, i, 1) <> "1") And (Mid(B, i, 1) <> "0") And (Mid(B, i, 1) <> ".") And (Mid(B, i, 1) <> "-") Then
            MsgBox "输入错误，请重输！", 16, "计算器"      '输入只能是0，1，或.，-'
            GoTo en
        End If
    Next i
    If mpot > 1 Then         '若小数点个数大于1，则报错'
       MsgBox "输入错误，请重输！", 16, "计算器"
       GoTo en
    End If
    If mpot = 0 Then     '若是整数，则调用函数完成二进制转换成十进制'
        Text6.Text = BIN_to_DEC(Text2.Text)
    End If
    If mpot = 1 Then   '若是小数'
        Dim l As Double
        l = 0
        For j = pot + 1 To length
            l = l + Mid(B, j, 1) * (2 ^ (pot - j))
        Next j                                         '对小数部分进行转换'
          Text6.Text = BIN_to_DEC(Mid(B, 1, pot - 1)) + l   '输出为小数部分加上整数部分'
    End If
    
End If


If 进制转换.Text = "十进制换算为十六进制" Then   '只对整数部分进行转化'
    B = Text2.Text
    length = Len(B)
    pot = 0
    mpot = 0
    
    
    For i = 1 To length
        If ("." = Mid(B, i, 1)) Then
            pot = i                        '找到小数点的位置
            mpot = mpot + 1      '小数点的个数
        End If
        If (Mid(B, i, 1) <> "1") And (Mid(B, i, 1) <> "0") And (Mid(B, i, 1) <> ".") And (Mid(B, i, 1) <> "-") And (Mid(B, i, 1) <> "2") And (Mid(B, i, 1) <> "3") And (Mid(B, i, 1) <> "4") And (Mid(B, i, 1) <> "5") And (Mid(B, i, 1) <> "6") And (Mid(B, i, 1) <> "7") And (Mid(B, i, 1) <> "8") And (Mid(B, i, 1) <> "9") Then
            MsgBox "输入错误，请重输！", 16, "计算器"
            GoTo en
        End If
    Next i
    If mpot > 1 Then
       MsgBox "输入错误，请重输！", 16, "计算器"
       GoTo en
    End If
    If 0 = mpot Then
            Text6.Text = Hex(Text2.Text)
    End If
    If 1 = mpot Then
         Text6.Text = Hex(Mid(B, 1, pot - 1))
        MsgBox "仅对整数部分进行转换", 48, "计算器"
    End If
    
End If


If 进制转换.Text = "十进制换算为二进制" Then
    B = Text2.Text
    length = Len(B)
    pot = 0
    mpot = 0
    
    
    For i = 1 To length
        If ("." = Mid(B, i, 1)) Then
            pot = i                       '找到小数点的位置
            mpot = mpot + 1      '小数点的个数
        End If
        If (Mid(B, i, 1) <> "1") And (Mid(B, i, 1) <> "0") And (Mid(B, i, 1) <> ".") And (Mid(B, i, 1) <> "-") And (Mid(B, i, 1) <> "2") And (Mid(B, i, 1) <> "3") And (Mid(B, i, 1) <> "4") And (Mid(B, i, 1) <> "5") And (Mid(B, i, 1) <> "6") And (Mid(B, i, 1) <> "7") And (Mid(B, i, 1) <> "8") And (Mid(B, i, 1) <> "9") Then
             MsgBox "输入错误，请重输！", 16, "计算器"
            GoTo en
        End If
    Next i
    If mpot > 1 Then
        MsgBox "输入错误，请重输！", 16, "计算器"
       GoTo en
    End If
    If 0 = mpot Then
            Text6.Text = DEC_to_BIN(Text2.Text)
    End If
    If 1 = mpot Then
          Text6.Text = DEC_to_BIN(Mid(B, 1, pot - 1))
        MsgBox "仅对整数部分进行转换", 48, "计算器"
    End If
    
End If



If 进制转换.Text = "十六进制换算为二进制" Then
    B = Text2.Text
    length = Len(B)
    pot = 0
    mpot = 0
    
    
    For i = 1 To length
        If ("." = Mid(B, i, 1)) Then
            pot = i                        '找到小数点的位置
            mpot = mpot + 1      '小数点的个数
        End If
        If (Mid(B, i, 1) <> "1") And (Mid(B, i, 1) <> "0") And (Mid(B, i, 1) <> ".") And (Mid(B, i, 1) <> "2") And (Mid(B, i, 1) <> "3") And (Mid(B, i, 1) <> "4") And (Mid(B, i, 1) <> "5") And (Mid(B, i, 1) <> "6") And (Mid(B, i, 1) <> "7") And (Mid(B, i, 1) <> "8") And (Mid(B, i, 1) <> "9") And (Mid(B, i, 1) <> "A") And (Mid(B, i, 1) <> "B") And (Mid(B, i, 1) <> "C") And (Mid(B, i, 1) <> "D") And (Mid(B, i, 1) <> "E") And (Mid(B, i, 1) <> "F") Then
            MsgBox "仅对整数部分进行转换", 48, "计算器"
            GoTo en
        End If
    Next i
    If mpot > 1 Then
        MsgBox "仅对整数部分进行转换", 48, "计算器"
       GoTo en
    End If
    If 0 = mpot Then
            Text6.Text = HEX_to_BIN(Text2.Text)
    End If
    If 1 = mpot Then
          Text6.Text = HEX_to_BIN(Mid(B, 1, pot - 1))
        MsgBox "仅对整数部分进行转换", 48, "计算器"
    End If
    
End If

If 进制转换.Text = "二进制换算为十六进制" Then
    
  
    B = Text2.Text
    length = Len(B)
    pot = 0
    mpot = 0
    
    
    For i = 1 To length
        If ("." = Mid(B, i, 1)) Then
            pot = i                        '找到小数点的位置
            mpot = mpot + 1     '小数点的个数
        End If
        If (Mid(B, i, 1) <> "1") And (Mid(B, i, 1) <> "0") And (Mid(B, i, 1) <> ".") Then
             MsgBox "输入错误，请重输！", 16, "计算器"
            GoTo en
        End If
    Next i
    If mpot > 1 Then
        MsgBox "输入错误，请重输！", 16, "计算器"
       GoTo en
    End If
    If 0 = mpot Then
         Text6.Text = BIN_to_HEX(Text2.Text)
    End If
    If 1 = mpot Then
         Text6.Text = BIN_to_HEX(Mid(B, 1, pot - 1))
        MsgBox "仅对整数部分进行转换", 48, "计算器"
    End If
End If


If 进制转换.Text = "十六进制换算为十进制" Then
    B = Text2.Text
    length = Len(B)
    pot = 0
   mpot = 0
    
    
    For i = 1 To length
        If ("." = Mid(B, i, 1)) Then
            pot = i                        '找到小数点的位置
            mpot = mpot + 1      '小数点的个数
        End If
        If (Mid(B, i, 1) <> "1") And (Mid(B, i, 1) <> "0") And (Mid(B, i, 1) <> ".") And (Mid(B, i, 1) <> "2") And (Mid(B, i, 1) <> "3") And (Mid(B, i, 1) <> "4") And (Mid(B, i, 1) <> "5") And (Mid(B, i, 1) <> "6") And (Mid(B, i, 1) <> "7") And (Mid(B, i, 1) <> "8") And (Mid(B, i, 1) <> "9") And (Mid(B, i, 1) <> "A") And (Mid(B, i, 1) <> "B") And (Mid(B, i, 1) <> "C") And (Mid(B, i, 1) <> "D") And (Mid(B, i, 1) <> "E") And (Mid(B, i, 1) <> "F") Then
             MsgBox "输入错误，请重输！", 16, "计算器"
            GoTo en
        End If
    Next i
    If mpot > 1 Then
        MsgBox "输入错误，请重输！", 16, "计算器"
       GoTo en
    End If
    If 0 = mpot Then
            Text6.Text = HEX_to_DEC(Text2.Text)
    End If
    If 1 = mpot Then
            Text6.Text = HEX_to_DEC(Mid(B, 1, pot - 1))
        MsgBox "仅对整数部分进行转换", 48, "计算器"
    End If
    
End If


en:
End Sub


Private Sub Option1_Click()   '若选择了二进制运算，则只有0，1两个数字可用，小数点不可用'
txtdisplay = ""
 Option1.Value = True
 Option2.Value = False
 Option3.Value = False
cmdnumber(2).Enabled = False
cmdnumber(3).Enabled = False
cmdnumber(4).Enabled = False
cmdnumber(5).Enabled = False
cmdnumber(6).Enabled = False
cmdnumber(7).Enabled = False
cmdnumber(8).Enabled = False
cmdnumber(9).Enabled = False
cmdnumber(10).Enabled = False
cmdnumber(11).Enabled = False
cmdnumber(12).Enabled = False
cmdnumber(13).Enabled = False
cmdnumber(14).Enabled = False
cmdnumber(15).Enabled = False
cmdnumber(16).Enabled = False
End Sub

Private Sub Option2_Click()  '若选择了十六进制运算，则所有数字均可用，小数点不可用'
txtdisplay = ""
Option1.Value = False
Option2.Value = True
Option3.Value = False
cmdnumber(2).Enabled = True
cmdnumber(3).Enabled = True
cmdnumber(4).Enabled = True
cmdnumber(5).Enabled = True
cmdnumber(6).Enabled = True
cmdnumber(7).Enabled = True
cmdnumber(8).Enabled = True
cmdnumber(9).Enabled = True
cmdnumber(10).Enabled = True
cmdnumber(11).Enabled = True
cmdnumber(12).Enabled = True
cmdnumber(13).Enabled = True
cmdnumber(14).Enabled = True
cmdnumber(15).Enabled = True
cmdnumber(16).Enabled = False

End Sub

Private Sub Option3_Click()    '若选择了十进制运算，则0~9数字可用'
txtdisplay = ""
 Option1.Value = False
 Option2.Value = False
 Option3.Value = True
cmdnumber(2).Enabled = True
cmdnumber(3).Enabled = True
cmdnumber(4).Enabled = True
cmdnumber(5).Enabled = True
cmdnumber(6).Enabled = True
cmdnumber(7).Enabled = True
cmdnumber(8).Enabled = True
cmdnumber(9).Enabled = True
cmdnumber(10).Enabled = False
cmdnumber(11).Enabled = False
cmdnumber(12).Enabled = False
cmdnumber(13).Enabled = False
cmdnumber(14).Enabled = False
cmdnumber(15).Enabled = False
cmdnumber(16).Enabled = True
End Sub