VB中怎么求补码?

1========================================
我的代码如下，但感觉到很原始、很笨。 有没有好的精练的代码啊？
Public Function BM(a As String) As String  Dim tempa(16)  Dim I As Integer
   For I = 1 To Len(a)
       tempa(I) = Left(Mid(a, I), 1)
   Next I
' =======================================
'取反
   If tempa(16) = 0 Then
      tempa(16) = 1
   Else
      tempa(16) = 0
   End If
   
   If tempa(15) = 0 Then
      tempa(15) = 1
   Else
      tempa(15) = 0
   End If
   
   If tempa(14) = 0 Then
      tempa(14) = 1
   Else
      tempa(14) = 0
   End If
   
   If tempa(13) = 0 Then
      tempa(13) = 1
   Else
      tempa(13) = 0
   End If
   
   If tempa(12) = 0 Then
      tempa(12) = 1
   Else
      tempa(12) = 0
   End If
   
   If tempa(11) = 0 Then
      tempa(11) = 1
   Else
      tempa(11) = 0
   End If
   
   If tempa(10) = 0 Then
      tempa(10) = 1
   Else
      tempa(10) = 0
   End If
   
   If tempa(9) = 0 Then
      tempa(9) = 1
   Else
      tempa(9) = 0
   End If
   
   If tempa(8) = 0 Then
      tempa(8) = 1
   Else
      tempa(8) = 0
   End If
   
   If tempa(7) = 0 Then
      tempa(7) = 1
   Else
      tempa(7) = 0
   End If
   
   If tempa(6) = 0 Then
      tempa(6) = 1
   Else
      tempa(6) = 0
   End If
   
   If tempa(5) = 0 Then
      tempa(5) = 1
   Else
      tempa(5) = 0
   End If
   
   If tempa(4) = 0 Then
      tempa(4) = 1
   Else
      tempa(4) = 0
   End If
   
      If tempa(3) = 0 Then
      tempa(3) = 1
   Else
      tempa(3) = 0
   End If
   
   If tempa(2) = 0 Then
      tempa(2) = 1
   Else
      tempa(2) = 0
   End If
    
   If tempa(1) = 0 Then
      tempa(1) = 1
   Else
      tempa(1) = 0
   End If
'====================================
'Add 1
   If tempa(16) = 1 Then
      tempa(16) = 0
      If tempa(15) = 1 Then
         tempa(15) = 0
         If tempa(14) = 1 Then
            tempa(14) = 0
            If tempa(13) = 1 Then
               tempa(13) = 0
               If tempa(12) = 1 Then
                  tempa(12) = 0
                  If tempa(11) = 1 Then
                    tempa(11) = 0
                    If tempa(10) = 1 Then
                        tempa(10) = 0
                        If tempa(9) = 1 Then
                            tempa(9) = 0
                            If tempa(8) = 1 Then
                             tempa(8) = 0
                             If tempa(7) = 1 Then
                                tempa(7) = 0
                                If tempa(6) = 1 Then
                                  tempa(6) = 0
                                  If tempa(5) = 1 Then
                                    tempa(5) = 0
                                    If tempa(4) = 1 Then
                                       tempa(4) = 0
                                       If tempa(3) = 1 Then
                                          tempa(3) = 0
                                          If tempa(2) = 1 Then
                                             tempa(2) = 0
                                           Else
                                             tempa(2) = 1
                                           End If
                                       Else
                                          tempa(3) = 1
                                        End If
                                    Else
                                      tempa(4) = 1
                                    End If
                                  Else
                                    tempa(5) = 1
                                  End If
                                Else
                                 tempa(6) = 1
                                End If
                            Else
                                tempa(7) = 1
                            End If
                          Else
                             tempa(8) = 1
                          End If
                        Else
                            tempa(9) = 1
                        End If
                     Else
                        tempa(10) = 1
                     End If
                 Else
                    tempa(11) = 1
                 End If
               Else
                  tempa(12) = 1
              End If
            Else
               tempa(13) = 1
            End If
         Else
            tempa(14) = 1
         End If
       Else
         tempa(15) = 1
      End If
  Else
    tempa(16) = 1
  End If
  
  
  For I = 1 To 16
     BM = BM & tempa(I)
  Next
  
End Function2========================
字符替换
 把十进制转化为D15 --- D0的二进制
 D1、D0为校验位  “00”，“01”，“11”
 D2也是可变的
 比如 a=“0000000000001011”
 要把a转变为 “0000000000001000” 或“0000000000000000”
 是否有函数直接可替换？
 手上没有MSDN很是苦恼！
 
 dim a as intger
 dim b as byte
  TempJN = DToB(a, 16)  '数据转换 十进制 ---> 16位的二进制
  TempJNa = Right$(TempJN, 2)
  b=0
  TempJNa=tempJNa and b
  D(5) = BToD(Left$(TempJN, 14) & TempJNa) '数据转换 二进制 ---> 十进制

解决方案 »

  1.   

    太长了，没太看，虽然VB的位运算能力比不上C，但VB中也有位运算符，如NOT按位取反，AND 按位与，OR 按位或，XOR 按位异或。
      

  2.   

    '进制转换
    Option ExplicitPublic Function D_To_B(ByVal Dec As Long) As String
        Do
            D_To_B = Dec Mod 2 & D_To_B
            Dec = Dec \ 2
        Loop While Dec
    End FunctionPublic Function B_To_D(ByVal Bin As String) As Currency
        Dim i As Long
        For i = 1 To Len(Bin)
            B_To_D = B_To_D * 2 + Val(Mid(Bin, i, 1))
        Next i
    End FunctionPublic Function H_To_B(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"
            B = Right(B, Len(B) - 1)
        Wend
        H_To_B = B
    End FunctionPublic Function B_To_H(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
        End If
        
        For i = 1 To Len(Bin) Step 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
        B_To_H = H
    End Function
      

  3.   

    楼主要善用and,or,xor,not,mod等运算符,有时可以精简你很多冗余代码.
      

  4.   

    http://search.csdn.net/Expert/topic/1015/1015691.xml?temp=.3597223
      

  5.   

    ' =======================================
    '取反
       If tempa(16) = 0 Then
          tempa(16) = 1
       Else
          tempa(16) = 0
       End If
       
       If tempa(15) = 0 Then
          tempa(15) = 1
       Else
          tempa(15) = 0
       End If
       
       If tempa(14) = 0 Then
          tempa(14) = 1
       Else
          tempa(14) = 0
       End If
       
       If tempa(13) = 0 Then
          tempa(13) = 1
       Else
          tempa(13) = 0
       End If
       
       If tempa(12) = 0 Then
          tempa(12) = 1
       Else
          tempa(12) = 0
       End If
       
       If tempa(11) = 0 Then
          tempa(11) = 1
       Else
          tempa(11) = 0
       End If
       
       If tempa(10) = 0 Then
          tempa(10) = 1
       Else
          tempa(10) = 0
       End If
       
       If tempa(9) = 0 Then
          tempa(9) = 1
       Else
          tempa(9) = 0
       End If
       
       If tempa(8) = 0 Then
          tempa(8) = 1
       Else
          tempa(8) = 0
       End If
       
       If tempa(7) = 0 Then
          tempa(7) = 1
       Else
          tempa(7) = 0
       End If
       
       If tempa(6) = 0 Then
          tempa(6) = 1
       Else
          tempa(6) = 0
       End If
       
       If tempa(5) = 0 Then
          tempa(5) = 1
       Else
          tempa(5) = 0
       End If
       
       If tempa(4) = 0 Then
          tempa(4) = 1
       Else
          tempa(4) = 0
       End If
       
          If tempa(3) = 0 Then
          tempa(3) = 1
       Else
          tempa(3) = 0
       End If
       
       If tempa(2) = 0 Then
          tempa(2) = 1
       Else
          tempa(2) = 0
       End If
        
       If tempa(1) = 0 Then
          tempa(1) = 1
       Else
          tempa(1) = 0
       End If
    '====================================
    你上面的代码可以改成这样
    dim tempI AS LONG FOR tempI=1 TO 16
        IF tempa(tempI)=0 then
            tempa(tempI)=1
        else
            tempa(tempI)=0
        end if
    next tempI
      

  6.   

    看了暴风雨的回复我想起来了，我写的是BCD码。@_@
      

  7.   

    我写了一个求补码的函数如下：
    实现的算法是“按位取反，并在最低位＋1”Private Function funcBM(strInput As String) As String
    '*****************************************************'函数名:    funcBM(strInput As String) As String
    '作者:      Carl.lee
    '时间:      2004-9-110
    '输入:      strInput    string
    '输出:      funcBM      string
    '过程:      将输入的字符串读入temparr数组中并取反，并
    '           从最低位+1,如果没有进位则完成。
    '*****************************************************
    Dim lngStringLenth As Long
    Dim TempArr() As Long
    Dim lngTemp As Long
    Dim strTemp As StringlngStringLenth = Len(strInput)
    ReDim TempArr(lngStringLenth)For lngTemp = 1 To lngStringLenth
        If Mid(strInput, lngTemp, 1) = 1 Then
            TempArr(lngTemp) = 0
        Else
            TempArr(lngTemp) = 1
        End If
    Next lngTempTempArr(lngStringLenth) = TempArr(lngStringLenth) + 1For lngTemp = 0 To lngStringLenth - 1
        If TempArr(lngStringLenth - lngTemp) = 2 Then
            TempArr(lngStringLenth - lngTemp) = 0
            TempArr(lngStringLenth - lngTemp - 1) = TempArr(lngStringLenth - lngTemp - 1) + 1
        Else
            Exit For
        End If
    Next lngTempstrTemp = ""For lngTemp = 1 To lngStringLenth
        strTemp = strTemp & TempArr(lngTemp)
    Next lngTempfuncBM = strTempEnd Function写完大概试了试，好像没什么大问题
      

  8.   

    不过not运算怎么用的？
    not 1 的值竟然是－2
    这个就让我比较郁闷了，最后只能把求反的过程写成了if...else
      

  9.   

    你定义好变量的的类型没有？应该定义为Long
      

  10.   

    原来我用的是not val(Mid(strInput, lngTemp, 1))
    然后结果是－2，于是我只有放弃了。
      

  11.   

    not是取反，不计符号位的
    所以not 1＝－2
      

  12.   

    是，这样一般负整数补码很容易了
    x-y=x+((not y)+1)  'xy为正整数
      

  13.   

    To : dongge2000(秋日私语：非[版务].灌！) 
         谢谢 To : flyingscv(zlj) 
         "x-y=x+((not y)+1)  'xy为正整数" 看不懂啊
          如果求-10的补码 则令x=0 ,y=10
          0-10=0-((not 10)+1)  是否这样?To : littlefishli(凉水塞牙～)  
         看了你的函数
         求补的算法和我一样的 代码比我精练多了To : tztz520(午夜逛街)   谢谢 你的改进   
    最迟明天晚上结分