- 日時： 2010/01/07 13:46
- 名前： 花ちゃん
- ***********************************************************************************
* カテゴリー：[文字列処理][アルゴリズム][] *
* キーワード：進数変換,自作関数,Ｍ進数の数値をＮ進数に変換,8進,36進, *
***********************************************************************************
旧のわいわいがやがや広場に投稿頂いた分です。これで３度目の引っ越しになります。
-----------------------------------------------------------------------------------
2進、10進、16進...の基数変換(VB6.0) 投稿者：ささ 投稿日：2005/08/04(Thu) 20:20 No.140
------------------------------------------------------------------------------------
基数変換関数です。
ちょっと作ってみました。8進作らなきゃ・・・。 #------ 長い夏休みのようです。（影の声）
Option Explicit
Public Const strHexPreFix As String = "&H"
Public Function Change_16to2(TenNo As String) As String
Dim IntTenNo_Len As Integer
Dim strGetHex As String
Dim strTmpTenNo As String
Change_16to2 = ""
strTmpTenNo = TenNo
If Len(TenNo) = 0 Then
Exit Function
End If
If (Len(TenNo) Mod 2) = 1 Then
TenNo = "0" & TenNo
End If
IntTenNo_Len = Len(TenNo)
Do While Not (Len(TenNo) = 0)
strGetHex = Left(TenNo, 2)
TenNo = Right(TenNo, Len(TenNo) - 2)
If strGetHex <> "00" Then
Change_16to2 = Change_16to2 & Right("00000000" & _
Change_10to2(Val(strHexPreFix & strGetHex)), 8)
End If
Loop
TenNo = strTmpTenNo
End Function
Public Function Change_2to16(TenNo As String) As String
Dim IntTenNo_Len As Integer
Dim strGetHex As String
Dim strTmpTenNo As String
Change_2to16 = ""
strTmpTenNo = TenNo
If Len(TenNo) = 0 Then
Exit Function
End If
If (Len(TenNo) Mod 8) = 1 Then
TenNo = "0000000" & TenNo
ElseIf (Len(TenNo) Mod 8) = 2 Then
TenNo = "000000" & TenNo
ElseIf (Len(TenNo) Mod 8) = 3 Then
TenNo = "00000" & TenNo
ElseIf (Len(TenNo) Mod 8) = 4 Then
TenNo = "0000" & TenNo
ElseIf (Len(TenNo) Mod 8) = 5 Then
TenNo = "000" & TenNo
ElseIf (Len(TenNo) Mod 8) = 6 Then
TenNo = "00" & TenNo
ElseIf (Len(TenNo) Mod 8) = 7 Then
TenNo = "0" & TenNo
End If
IntTenNo_Len = Len(TenNo)
Do While Not (Len(TenNo) = 0)
strGetHex = Left(TenNo, 8)
TenNo = Right(TenNo, Len(TenNo) - 8)
If strGetHex <> "00000000" Then
Change_2to16 = Change_2to16 & Right("00" & Hex(Change_2to10(strGetHex)), 2)
End If
Loop
TenNo = strTmpTenNo
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
|
2進、10進、16進...の基数変換(VB6.0)