Happy Codings - Programming Code Examples
Html Css Web Design Sample Codes CPlusPlus Programming Sample Codes JavaScript Programming Sample Codes C Programming Sample Codes CSharp Programming Sample Codes Java Programming Sample Codes Php Programming Sample Codes Visual Basic Programming Sample Codes


Visual Basic Programming Code Examples

Visual Basic > Applications VBA Code Examples

Binary Conversions

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186
Binary Conversions 'The Functions in this module are designed to aid in working with BINARY 'numbers. Visual Basic does not include nor allow any representation of a 'number in binary format. Therefore, all of these functions work strictly on 'strings. All of the parameters passed into them and returned from them are 'strings. ' ' CONVERSION NEEDED FUNCTION ' ------------------------------------------------------ ' Binary to Hex BinToHex(BinNum As String) ' Binary to Octal BinToOct(BinNum As String) ' Binary to Decimal BinToDec(BinNum As String) ' Hex to Binary HexToBin(HexNum As String) ' Octal to Binary OctToBin(OctNum As String) ' Decimal to Binary DecToBin(DecNum As String) ' ' Option Explicit Function BinToHex(BinNum As String) As String Dim BinLen As Integer, i As Integer Dim HexNum As Variant On Error GoTo ErrorHandler BinLen = Len(BinNum) For i = BinLen To 1 Step -1 ' Check the string for invalid characters If Asc(Mid(BinNum, i, 1)) < 48 Or _ Asc(Mid(BinNum, i, 1)) > 49 Then HexNum = "" Err.Raise 1002, "BinToHex", "Invalid Input" End If ' Calculate HEX value of BinNum If Mid(BinNum, i, 1) And 1 Then HexNum = HexNum + 2 ^ Abs(i - BinLen) End If Next i ' Return HexNum as String BinToHex = Hex(HexNum) ErrorHandler: End Function Function BinToOct(BinNum As String) As String Dim BinLen As Integer, i As Integer Dim OctNum As Variant On Error GoTo ErrorHandler BinLen = Len(BinNum) For i = BinLen To 1 Step -1 ' Check the string for invalid characters If Asc(Mid(BinNum, i, 1)) < 48 Or _ Asc(Mid(BinNum, i, 1)) > 49 Then OctNum = "" Err.Raise 1002, "BinToOct", "Invalid Input" End If ' Calculate Octal value of BinNum If Mid(BinNum, i, 1) And 1 Then OctNum = OctNum + 2 ^ Abs(i - BinLen) End If Next i ' Return OctNum as String BinToOct = Oct(OctNum) ErrorHandler: End Function Public Function BinToDec(BinNum As String) As String Dim i As Integer Dim DecNum As Long On Error GoTo ErrorHandler ' Loop thru BinString For i = Len(BinNum) To 1 Step -1 ' Check the string for invalid characters If Asc(Mid(BinNum, i, 1)) < 48 Or _ Asc(Mid(BinNum, i, 1)) > 49 Then DecNum = "" Err.Raise 1002, "BinToDec", "Invalid Input" End If ' If bit is 1 then raise 2^LoopCount and add it to DecNum If Mid(BinNum, i, 1) And 1 Then DecNum = DecNum + 2 ^ (Len(BinNum) - i) End If Next i ' Return DecNum as a String BinToDec = DecNum ErrorHandler: End Function Public Function OctToBin(OctNum As String) As String Dim BinNum As String Dim lOctNum As Long Dim i As Integer On Error GoTo ErrorHandler ' Check the string for invalid characters For i = 1 To Len(OctNum) If (Asc(Mid(OctNum, i, 1)) < 48 Or Asc(Mid(OctNum, i, 1)) > 55) Then BinNum = "" Err.Raise 1008, "OctToBin", "Invalid Input" End If Next i i = 0 lOctNum = Val("&O" & OctNum) Do If lOctNum And 2 ^ i Then BinNum = "1" & BinNum Else BinNum = "0" & BinNum End If i = i + 1 Loop Until 2 ^ i > lOctNum ' Return BinNum as a String OctToBin = BinNum ErrorHandler: End Function Public Function DecToBin(DecNum As String) As String Dim BinNum As String Dim lDecNum As Long Dim i As Integer On Error GoTo ErrorHandler ' Check the string for invalid characters For i = 1 To Len(DecNum) If Asc(Mid(DecNum, i, 1)) < 48 Or _ Asc(Mid(DecNum, i, 1)) > 57 Then BinNum = "" Err.Raise 1010, "DecToBin", "Invalid Input" End If Next i i = 0 lDecNum = Val(DecNum) Do If lDecNum And 2 ^ i Then BinNum = "1" & BinNum Else BinNum = "0" & BinNum End If i = i + 1 Loop Until 2 ^ i > lDecNum ' Return BinNum as a String DecToBin = BinNum ErrorHandler: End Function Public Function HexToBin(HexNum As String) As String Dim BinNum As String Dim lHexNum As Long Dim i As Integer On Error GoTo ErrorHandler ' Check the string for invalid characters For i = 1 To Len(HexNum) If ((Asc(Mid(HexNum, i, 1)) < 48) Or _ (Asc(Mid(HexNum, i, 1)) > 57 And _ Asc(UCase(Mid(HexNum, i, 1))) < 65) Or _ (Asc(UCase(Mid(HexNum, i, 1))) > 70)) Then BinNum = "" Err.Raise 1016, "HexToBin", "Invalid Input" End If Next i i = 0 lHexNum = Val("&h" & HexNum) Do If lHexNum And 2 ^ i Then BinNum = "1" & BinNum Else BinNum = "0" & BinNum End If i = i + 1 Loop Until 2 ^ i > lHexNum ' Return BinNum as a String HexToBin = BinNum ErrorHandler: End Function