|
|
- - - - - - - - - - - - - - ผู้ให้การสนับสนุน- - - - - - - - - - - - - -
|
|
|
กระทู้ #2798 [Vb] (จาก IP: 124.120.247.43)
ขอโค๊ด VB แปลงเลขทศนิยมเป็นเลขฐานสอง
อยากได้ code VB ที่สามารถแปลงเลขฐานสิบทศนิยมเป็นเลขฐานสองทศนิยมอะครับ คือต้องใช้ในโปรเจ็คที่จะจบครับ ต้องการด่วนมากเลย ช่วยทีครับ
|
จากคุณ
:
paper / modtanoy_poo@hotmail.com [2010-02-04 16:13:58]
|
|
ความคิดเห็น #27776 (จาก IP: 125.24.172.51)
แค่ยกกำลังเป็นเลขลบเองครับ ลองกลับไปพยายามใหม่อีกรอบ |
จากคุณ
:
sup98 [2010-02-08 00:00:32]
|
|
ความคิดเห็น #27777 (จาก IP: 125.24.172.51)
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 |
จากคุณ
:
sup98 [2010-02-08 08:22:34]
|
|
|
- - - - - - - - - - - - - - ผู้ให้การสนับสนุน- - - - - - - - - - - - - -
|
|
|
|
|