ページを更新する

MX Component Excel VBA で 実数値の読み書き 2020/10/13

Option Explicit

'' -----------------------------------------------------------
'' 情報元：「よく見かけるVBサンプル集」
'' 57「Single型をHex値(16進数)へ変換」、58「Double型をHex値(16進数)へ変換」
'' http://www.suvaru.com/pg/sampl/Sample100_50.html
'' Win32API
Declare Sub CopyValtoVal Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)

Function SingleToHex(ByVal s As Single, _
             Optional ByVal direction As Boolean = False) As String
  Dim i As Integer
  Dim b(3) As Byte
  Dim st, st2 As String

  Call CopyValtoVal(b(0), s, 4)
  If direction = False Then
    For i = 0 To 3
      st = Hex(b(i))
      st2 = st2 + String(2 - Len(st), "0") + st
    Next i
  Else
    For i = 3 To 0 Step -1
      st = Hex(b(i))
      st2 = st2 + String(2 - Len(st), "0") + st
    Next i
  End If
  SingleToHex = st2
End Function

''
Function DoubleToHex(ByVal d As Double, _
              Optional ByVal direction As Boolean = False) As String
  Dim i As Integer
  Dim b(7) As Byte
  Dim st, st2 As String

  Call CopyValtoVal(b(0), d, 8) '' 7->8
  If direction = False Then
    For i = 0 To 7
      st = Hex(b(i))
      st2 = st2 + String(2 - Len(st), "0") + st
    Next i
  Else
    For i = 7 To 0 Step -1
      st = Hex(b(i))
      st2 = st2 + String(2 - Len(st), "0") + st
    Next i
  End If
  DoubleToHex = st2
End Function
'' -------------------------------------------------

'' 32 ビット実数（単精度）変換
'' Ex : HexToSingle("C2F6E666") result = -123.45
Public Function HexToSingle(sHex As String) As Single
  Dim sTemp As String
  Dim iSign, iExponent As Integer
  Dim fTemp, fFraction As Single
 
  ' 符号 1ビット
  sTemp = Mid(sHex, 1, 1)
  fTemp = Val("&H" & sTemp) And &H8
  iSign = IIf(fTemp = 8, -1, 1)
 
  ' 指数部 8ビット
  sTemp = Mid(sHex, 1, 3)
  fTemp = Val("&H" & sTemp) And &H7F8
  iExponent = fTemp / 2 ^ 3 - 127  '32ビット形式のバイアス=127
 
  ' 仮数部 23ビット
  sTemp = Mid(sHex, 3, 6)
  fTemp = Val("&H" & sTemp) And &H7FFFFF
  fFraction = 1# + (fTemp / 2 ^ 23)
 
  HexToSingle = iSign * fFraction * 2 ^ iExponent
 
End Function

'' 64 ビット実数（倍精度）変換
'' Ex : HexToDouble("C05EDD2F1A9FBE77") Result = -123.456
Public Function HexToDouble(sHex As String) As Double
  Dim sTemp As String
  Dim iSign, iExponent As Integer
  Dim fTemp, fFraction As Double
 
  ' 符号 1ビット
  sTemp = Mid(sHex, 1, 1)
  fTemp = Val("&H" & sTemp) And &H8
  iSign = IIf(fTemp = 8, -1, 1)
   
  ' 指数部 11ビット
  sTemp = Mid(sHex, 1, 3)
  fTemp = Val("&H" & sTemp) And &H7FF
  iExponent = fTemp - 1023  '64ビット形式のバイアス=1023
 
  ' 仮数部 52ビット
  sTemp = Mid(sHex, 4, 13)
  fTemp = CDbl("&H" & sTemp)
  fFraction = 1 + (fTemp / 2 ^ 52)
   
  HexToDouble = iSign * fFraction * 2 ^ iExponent
 
End Function


Sub ボタン2_Click()
  '' 単精度実数書き込み、読み出し
  Dim iData(1) As Integer
  Dim sData As String
  Dim i As Integer
  Dim st, st2 As String
  Dim f As Single
  
  f = -123.456
  sData = SingleToHex(f, True) '' "C2F6E666"
  
  '' 下位から格納（D0 = E666, D1 = C2F6 と格納すれば良い）
  For i = 0 To 1
    iData(i) = CInt("&H" & Mid(sData, (1 - i) * 4 + 1, 4))
  Next i
  
  With Worksheets("Sheet1").ActUtlType1
    .ActLogicalStationNumber = 6 ''通信設定ユーティリティーでの論理局番
    .Open
    '' 書き込み
    Call .WriteDeviceBlock2("D0", 2, iData(0))
    '' 読み出し
    Call .ReadDeviceBlock2("D0", 2, iData(0))
    For i = 1 To 0 Step -1
      st = Hex(iData(i))
      st2 = st2 + String(4 - Len(st), "0") + st
    Next i
    '' Debug.Print st2
    f = HexToSingle(st2)
    With Worksheets("Sheet1")
      .Cells(1, 1).Value = st2
      .Cells(1, 2).Value = f
    End With
    .Close
  End With
End Sub

Sub ボタン3_Click()
  '' 倍精度実数書き込み、読み出し
  Dim iData(3) As Integer
  Dim sData As String
  Dim i As Integer
  Dim st, st2 As String
  Dim d As Double
  
  d = -123.456
  sData = DoubleToHex(d, True) '' "C05EDD2F1A9FBE77"
  For i = 0 To 3
    iData(i) = CInt("&H" & Mid(sData, (3 - i) * 4 + 1, 4))
  Next i
  
  With Worksheets("Sheet1").ActUtlType1
    .ActLogicalStationNumber = 6 ''通信設定ユーティリティーでの論理局番
    .Open
    
    '' 書き込み
    Call .WriteDeviceBlock2("D0", 4, iData(0))
    '' 表示形式 : ワード、16bit、16 進表示の場合
    '' D3=C05E, D2=DD2F, D1=1A9F, D0=BE77
    
    '' 読み出し
    Call .ReadDeviceBlock2("D0", 4, iData(0))
    
    For i = 3 To 0 Step -1
      st = Hex(iData(i))
      st2 = st2 + String(4 - Len(st), "0") + st
    Next i
    '' Debug.Print st2
    d = HexToDouble(st2)
    With Worksheets("Sheet1")
      .Cells(1, 1).Value = st2
      .Cells(1, 2).Value = d
    End With
    .Close
  End With
End Sub