投稿日 | : 2005/05/25(Wed) 04:22 |
投稿者 | : いな |
Eメール | : |
URL | : |
タイトル | : Re^3: 16進→2進変換での0処理 |
...納品前の生き抜きにです。
バグっていたらすまぬ。
Option Explicit
Public Const strHexPreFix As String = "&H"
Public Function Change_16to2(TenNo As String) As String
Change_16to2 = Change_10to2(Val(strHexPreFix & TenNo))
End Function
Public Function Change_2to16(TenNo As String) As String
Change_2to16 = strHexPreFix & Right("00" & Change_2to10(TenNo), 2)
End Function
Public Function Change_10to2(TenNo As Double) As String
Dim Work As String
Dim Kazu As Long
Dim kazu2 As Double
Dim Cnt As Integer
Work = ""
Cnt = 0
If InStr(TenNo, ".") > 0 Then
'小数点有り
Kazu = Int(TenNo)
Do
Work = CStr(Kazu Mod 2) & Work
Kazu = Kazu \ 2
Loop While Kazu > 0
kazu2 = TenNo - Int(TenNo)
Work = Work & "."
Do While kazu2 <> 0
Work = Work & CStr(Int(kazu2 * 2))
kazu2 = kazu2 * 2
If kazu2 >= 1 Then
kazu2 = kazu2 - 1
End If
Cnt = Cnt + 1
If Cnt = 100 Then 'ストッパー
Exit Do
End If
Loop
Else
'小数点無し
Kazu = Int(TenNo)
Do
Work = CStr(Kazu Mod 2) & Work
Kazu = Kazu \ 2
Loop While Kazu > 0
End If
If Len(Work) = 0 Then
Work = "0"
End If
Change_10to2 = Work
End Function
Public Function Change_2to10(TwoNo As String) As Double
Dim Work As Double
Dim i As Integer
Dim kake As Double
Work = 0
kake = 1
If InStr(TwoNo, ".") > 0 Then
'小数点有り
For i = InStr(TwoNo, ".") - 1 To 1 Step -1
If Mid$(TwoNo, i, 1) = "1" Then
Work = Work + kake
End If
kake = kake * 2
Next i
kake = 0.5
For i = InStr(TwoNo, ".") + 1 To Len(TwoNo)
If Mid$(TwoNo, i, 1) = "1" Then
Work = Work + kake
End If
kake = kake / 2
Next i
Else
'小数点無し
For i = Len(TwoNo) To 1 Step -1
If Mid$(TwoNo, i, 1) = "1" Then
Work = Work + kake
End If
kake = kake * 2
Next i
End If
Change_2to10 = Work
End Function