| |
 |
| - - - - - - - - - - - - - - ผู้ให้การสนับสนุน- - - - - - - - - - - - - -
|
|
|
กระทู้ #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]
|
|
|
| - - - - - - - - - - - - - - ผู้ให้การสนับสนุน- - - - - - - - - - - - - -
|
|
| |
|
|
New Article
อัตราค่าโฆษณา
