将功能函数封装于OCX之中在VB6平台上可以简单化，在默认模板中直接考贝贴入那些函数即可。在博文【将《VB6编程IEEE浮点算法实践》中的Function封装成OCX】将《VB6编程IEEE浮点算法实践》中的Function封装成OCX_Mongnewer的博客-CSDN博客中对VB6的OCX封装做了具体实践。
下面是全部功能函数代码，便于后期调用参考。CRC16是在CDSN上参考的，找不到是在哪篇博文了，有知道告诉我，我将出处贴到代码上。
Function MKI(ByVal iData As Integer) As String'MKI 16bits &HFFFF -32768 to 32767 8000-7fffDim inData As LongDim HiByte As Long, LoByte As LonginData = Fix(iData)If inData < 0 Then inData = inData + 65536LoByte = inData And &HFFHiByte = (inData \ 2 ^ 8) And &HFFMKI = Right$(("0" + Hex$(HiByte)), 2) + Right$(("0" + Hex$(LoByte)), 2)
End Function
Function MKL(ByVal lData As Long) As String'MKL 32bits &HFFFFFFFF -2147483648 to 2147483647 80000000 to 7fffffff'Dim HiWord As Long, LoWord As Long'Dim inData As Long'LoWord = inData And &HFFFF'HiWord = (inData \ 2 ^ 4) And &HFFFF'MKL = Right$(("0000" + Hex$(HiWord)), 4) + Right$(("0000" + Hex$(LoWord)), 4)Dim Phi4 As Currency, Phi3 As Currency, Phi2 As Currency, Phi1 As Currency, inData As CurrencyinData = Fix(lData)Phi4 = inData And &HFFPhi3 = (inData \ 2 ^ 8) And &HFFPhi2 = (inData \ 2 ^ 16) And &HFFPhi1 = (inData \ 2 ^ 24) And &HFFMKL = Right$(("0" + Hex$(Phi1)), 2) + Right$(("0" + Hex$(Phi2)), 2) + Right$(("0" + Hex$(Phi3)), 2) + Right$(("0" + Hex$(Phi4)), 2)
End Function
Function MKS(ByVal sData As Single) As String'********************************************************************************'* Single singn=1bit, exp= 8bits, tail=23bits, total=32bits, offset= 7F 127 *'* Double singn=1bit, exp=11bits, tail=52bits, total=64bits, offset= 3FF 1023 *'* DblEXT singn=1bit, exp=15bits, tail=64bits, total=80bits, offset=3FFF 16383 *'********************************************************************************Dim inDataSingn As ByteDim inData As SingleDim ipart As Long, npart As Byte, fpart As SingleDim tipart As Long, tnpart As Byte, tfpart As SingleDim AcuFactor As Byte, iDataExp As Integer, MoveDotPoint As Byte, ReIndex As ByteDim TempData1(79) As Byte, TempData2(79) As Byte, TempData3(79) As Byte, TempData4(79) As Byte, TempData5(79) As ByteDim IntiStr As String, FracStr As StringDim TempData As Integer, TempString As StringDim TempByte As Byte, OffSet As Integer, OffSetBits As ByteDim CaseID As Integer, I As IntegerDim CRC16 As Long, CRC16Str As StringOffSetBits = 8AcuFactor = 32: OffSet = 127inData = sDatainDataSingn = 0If inData < 0 Then inDataSingn = 1inData = Abs(inData) 'ignore singnipart = Int(inData): fpart = (inData - ipart)If inData = 0 ThenCaseID = 0Else'Convert ipart, the integer part, into byte array TempData1 MSB to LSBtipart = ipart: TempString = ""For I = 1 To AcuFactorTempString = Right$(Str$(tipart And &H1), 1) + TempStringtipart = tipart \ 2 ^ 1Next IFor I = 1 To AcuFactorIf Mid$(TempString, I, 1) = "1" Then Exit ForMid$(TempString, I, 1) = " "Next IIntiStr = Trim(TempString)'Convert fpart, the fraction part, into byte array TempData2tfpart = fpart: TempString = ""For I = 1 To AcuFactorIf tfpart = 0 Then Exit Fortfpart = tfpart * 2tnpart = Int(tfpart): tfpart = tfpart - tnpartTempString = TempString + Right$(Str$(tnpart And &H1), 1)Next IFracStr = TempStringIf ipart > 0 Then CaseID = 1If ipart = 0 Then CaseID = 2End IfSelect Case CaseIDCase 0TempByte = 0TempString = Right$((String(AcuFactor, "0") + Hex$(TempByte)), AcuFactor / 4)MKS = TempStringCase 1 'Data with integer partFor I = 1 To Len(IntiStr)If Mid$(IntiStr, I, 1) = "1" Then Exit ForNext IMoveDotPoint = Len(IntiStr) - IiDataExp = MoveDotPoint + OffSet'Now Sign, Exp and Fracpart readyTempData = iDataExpTempString = ""For I = 1 To OffSetBitsTempString = Right$(Str$(TempData And &H1), 1) + TempStringTempData = TempData \ 2 ^ 1Next I'Sign and ExponentCRC16Str = Trim(Str$(inDataSingn)) + Right$(TempString, OffSetBits)'Make full string and omit first "1"TempString = IntiStr + FracStrTempString = Right$(TempString, Len(TempString) - 1)CRC16Str = Left$((CRC16Str + TempString + String(AcuFactor, "0")), AcuFactor)TempString = ""For I = 1 To AcuFactor Step 4TempByte = 0TempByte = TempByte \ 2TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 3, 1)))TempByte = TempByte \ 2TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 2, 1)))TempByte = TempByte \ 2TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 1, 1)))TempByte = TempByte \ 2TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 0, 1)))TempString = TempString + Hex$(TempByte)Next IMKS = TempStringCase 2 'Data without integer partFor I = 1 To Len(FracStr)If Mid$(FracStr, I, 1) = "1" Then Exit ForNext IMoveDotPoint = IiDataExp = -1 * MoveDotPoint + OffSet'Now Sign, Exp and Fracpart readyTempData = iDataExpTempString = ""For I = 1 To OffSetBitsTempString = Right$(Str$(TempData And &H1), 1) + TempStringTempData = TempData \ 2 ^ 1Next ITempString = Right$(TempString, OffSetBits)'Sign and Exponent, and FracPartCRC16Str = Trim(Str$(inDataSingn)) + Trim(TempString) + Right$(FracStr, Len(FracStr) - MoveDotPoint)TempString = ""For I = 1 To AcuFactor Step 4TempByte = 0TempByte = TempByte \ 2TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 3, 1)))TempByte = TempByte \ 2TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 2, 1)))TempByte = TempByte \ 2TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 1, 1)))TempByte = TempByte \ 2TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 0, 1)))TempString = TempString + Hex$(TempByte)Next IMKS = TempStringEnd Select
End Function
Function MKD(ByVal sData As Double) As String'********************************************************************************'* Single singn=1bit, exp= 8bits, tail=23bits, total=32bits, offset= 7F 127 *'* Double singn=1bit, exp=11bits, tail=52bits, total=64bits, offset= 3FF 1023 *'* DblEXT singn=1bit, exp=15bits, tail=64bits, total=80bits, offset=3FFF 16383 *'********************************************************************************Dim inDataSingn As ByteDim inData As DoubleDim ipart As Long, npart As Byte, fpart As DoubleDim tipart As Long, tnpart As Byte, tfpart As DoubleDim AcuFactor As Byte, iDataExp As Integer, MoveDotPoint As Byte, ReIndex As ByteDim TempData1(79) As Byte, TempData2(79) As Byte, TempData3(79) As Byte, TempData4(79) As Byte, TempData5(79) As ByteDim IntiStr As String, FracStr As StringDim TempData As Integer, TempString As StringDim TempByte As Byte, OffSet As Integer, OffSetBits As ByteDim CaseID As Integer, I As IntegerDim CRC16 As Long, CRC16Str As StringOffSetBits = 11AcuFactor = 64: OffSet = 1023inData = sDatainDataSingn = 0If inData < 0 Then inDataSingn = 1inData = Abs(inData) 'ignore singnipart = Int(inData): fpart = (inData - ipart)If inData = 0 ThenCaseID = 0Else'Convert ipart, the integer part, into byte array TempData1 MSB to LSBtipart = ipart: TempString = ""For I = 1 To AcuFactorTempString = Right$(Str$(tipart And &H1), 1) + TempStringtipart = tipart \ 2 ^ 1Next IFor I = 1 To AcuFactorIf Mid$(TempString, I, 1) = "1" Then Exit ForMid$(TempString, I, 1) = " "Next IIntiStr = Trim(TempString)'Convert fpart, the fraction part, into byte array TempData2tfpart = fpart: TempString = ""For I = 1 To AcuFactorIf tfpart = 0 Then Exit Fortfpart = tfpart * 2tnpart = Int(tfpart): tfpart = tfpart - tnpartTempString = TempString + Right$(Str$(tnpart And &H1), 1)Next IFracStr = TempStringIf ipart > 0 Then CaseID = 1If ipart = 0 Then CaseID = 2End IfSelect Case CaseIDCase 0TempByte = 0TempString = Right$((String(AcuFactor, "0") + Hex$(TempByte)), AcuFactor / 4)CRC16Str = TempStringCase 1 'Data with integer partFor I = 1 To Len(IntiStr)If Mid$(IntiStr, I, 1) = "1" Then Exit ForNext IMoveDotPoint = Len(IntiStr) - IiDataExp = MoveDotPoint + OffSet'Now Sign, Exp and Fracpart readyTempData = iDataExpTempString = ""For I = 1 To OffSetBitsTempString = Right$(Str$(TempData And &H1), 1) + TempStringTempData = TempData \ 2 ^ 1Next I'Sign and ExponentCRC16Str = Trim(Str$(inDataSingn)) + Right$(TempString, OffSetBits)'Make full string and omit first "1"TempString = IntiStr + FracStrTempString = Right$(TempString, Len(TempString) - 1)CRC16Str = Left$((CRC16Str + TempString + String(AcuFactor, "0")), AcuFactor)Case 2 'Data without integer partFor I = 1 To Len(FracStr)If Mid$(FracStr, I, 1) = "1" Then Exit ForNext IMoveDotPoint = IiDataExp = -1 * MoveDotPoint + OffSet'Now Sign, Exp and Fracpart readyTempData = iDataExpTempString = ""For I = 1 To AcuFactorTempString = Right$(Str$(TempData And &H1), 1) + TempStringTempData = TempData \ 2 ^ 1Next ITempString = Right$(TempString, OffSetBits)'Sign and Exponent, and FracPartCRC16Str = Trim(Str$(inDataSingn)) + Trim(TempString) + Right$(FracStr, Len(FracStr) - MoveDotPoint)End SelectTempString = ""For I = 1 To AcuFactor Step 4TempByte = 0TempByte = TempByte \ 2TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 3, 1)))TempByte = TempByte \ 2TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 2, 1)))TempByte = TempByte \ 2TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 1, 1)))TempByte = TempByte \ 2TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 0, 1)))TempString = TempString + Hex$(TempByte)Next IMKD = TempString
End Function
Function CVI(ByVal iData As String) As Long'CVI gives 16bits &HFFFF -32768 to 32767 8000-7fffDim iReturn As LongDim HiByte As String, LoByte As StringDim TempStr As StringTempStr = Right$(Space(4) + iData, 4)HiByte = Left$(TempStr, 2)LoByte = Right$(TempStr, 2)iReturn = Val("&H" + HiByte) * 256 + Val("&H" + LoByte)CVI = iReturn
End Function
Function CVL(ByVal lData As String) As Long'CVL gives 32bits &HFFFFFFFF -2147483648 to 2147483647 80000000 to 7fffffffDim inData As StringDim iReturn As LongDim LoWord As Integer, HiWord As IntegerinData = Right((Space(8) + lData), 8)LoWord = Val("&H" + Right$(inData, 4))HiWord = Val("&H" + Left$(inData, 4))iReturn = HiWord * (&HFFFF + 1) + LoWordCVL = iReturn
End FunctionFunction CVS(ByVal sData As String) As SingleDim inData As StringDim TempStr As String, TempChar As String, TempCharVal As ByteDim SignBit As Integer, iExp As Integer, tiExp As IntegerDim I As Integer, J As IntegerDim IntiPart As String, FracPart As StringDim IntiData As Double, FracData As DoubleinData = Right$((String(8, "0") + sData), 8)TempStr = ""For I = 1 To 8TempChar = Mid$(inData, 9 - I, 1)TempCharVal = Val("&H" + Right$(TempChar, 1))For J = 1 To 4TempStr = Trim$(Str$(TempCharVal And &H1)) + TempStrTempCharVal = TempCharVal \ 2 ^ 1Next JNext ISignBit = 1If Left$(TempStr, 1) = "1" Then SignBit = -1iExp = 0For I = 2 To 9iExp = iExp * 2 ^ 1iExp = iExp Or Val(Mid$(TempStr, I, 1))Next I'positive for data greater than 1, or negtive for data with only fraction partIf iExp >= 127 Then 'IntiPart existtiExp = iExp - 127If tiExp > 0 ThenIntiPart = "1" + Left$(Mid$(TempStr, 10, 23), tiExp)FracPart = Right$((Mid$(TempStr, 10, 23)), 23 - tiExp)End IfIf tiExp = 0 ThenIntiPart = "1" + Left$(Mid$(TempStr, 10, 23), tiExp)FracPart = Right$((Mid$(TempStr, 10, 23)), 23)End IfElsetiExp = iExp - 127IntiPart = "0"FracPart = String(Abs(tiExp + 1), "0") + "1" + Mid$(TempStr, 10, 23)FracData = 0For I = 1 To Len(FracPart)If Mid$(FracPart, I, 1) = "1" ThenFracData = FracData + 2 ^ (-I)End IfNext IEnd IfIntiData = 0For I = 1 To Len(IntiPart)IntiData = IntiData * 2 ^ 1IntiData = IntiData Or Val(Mid$(IntiPart, I, 1))Next IFracData = 0For I = 1 To Len(FracPart)If Mid$(FracPart, I, 1) = "1" ThenFracData = FracData + 2 ^ (-I)End IfNext ICVS = SignBit * (IntiData + Val(Format$(FracData, "#.###############0")))
End Function
Function CVD(ByVal sData As String) As DoubleDim inData As StringDim TempStr As String, TempChar As String, TempCharVal As ByteDim SignBit As Integer, iExp As Integer, tiExp As IntegerDim I As Integer, J As IntegerDim IntiPart As String, FracPart As StringDim IntiData As Double, FracData As DoubleinData = Right$((String(16, "0") + sData), 16)TempStr = ""For I = 1 To 16TempChar = Mid$(inData, 17 - I, 1)TempCharVal = Val("&H" + Right$(TempChar, 1))For J = 1 To 4TempStr = Trim$(Str$(TempCharVal And &H1)) + TempStrTempCharVal = TempCharVal \ 2 ^ 1Next JNext ISignBit = 1If Left$(TempStr, 1) = "1" Then SignBit = -1iExp = 0For I = 2 To 12iExp = iExp * 2 ^ 1iExp = iExp Or Val(Mid$(TempStr, I, 1))Next I'positive for data greater than 1, or negtive for data with only fraction partIf iExp >= 1023 Then 'IntiPart existtiExp = iExp - 1023If tiExp > 0 ThenIntiPart = "1" + Left$(Mid$(TempStr, 13, 52), tiExp)FracPart = Right$((Mid$(TempStr, 13, 52)), 52 - tiExp)End IfIf tiExp = 0 ThenIntiPart = "1" + Left$(Mid$(TempStr, 13, 52), tiExp)FracPart = Right$((Mid$(TempStr, 13, 52)), 52)End IfElsetiExp = iExp - 1023IntiPart = "0"FracPart = String(Abs(tiExp + 1), "0") + "1" + Mid$(TempStr, 13, 52)FracData = 0For I = 1 To Len(FracPart)If Mid$(FracPart, I, 1) = "1" ThenFracData = FracData + 2 ^ (-I)End IfNext IEnd IfIntiData = 0For I = 1 To Len(IntiPart)IntiData = IntiData * 2 ^ 1IntiData = IntiData Or Val(Mid$(IntiPart, I, 1))Next IFracData = 0For I = 1 To Len(FracPart)If Mid$(FracPart, I, 1) = "1" ThenFracData = FracData + 2 ^ (-I)End IfNext ICVD = SignBit * (IntiData + Val(Format$(FracData, "#.###############0")))
End FunctionFunction CRC16(ByVal inData As String) As String
Dim TestString As String
Dim I As Integer, Temp As Integer
Dim PP As Integer
Dim CRCLo As Byte, CRCHi As Byte, TCRC As ByteDim LTable()
LTable() = Array( _"&H0000", "&HCC01", "&HD801", "&H1400", "&HF001", "&H3C00", "&H2800", "&HE401", _"&HA001", "&H6C00", "&H7800", "&HB401", "&H5000", "&H9C01", "&H8801", "&H4400")TestString = inData
'TestString = "010303E80002"CRCHi = &HFF: CRCLo = &HFFFor I = 1 To Len(TestString) / 2PP = Val("&H" + Mid$(TestString, I * 2 - 1, 2))Temp = (CRCLo And &HF) Xor (PP And &HF)CRCLo = CRCLo \ 2 ^ 4TCRC = (CRCHi And &HF)TCRC = TCRC * 2 ^ 4: CRCLo = CRCLo Or TCRCCRCHi = CRCHi \ 2 ^ 4CRCLo = CRCLo Xor (Val("&H" + (Right$(LTable(Temp), 2))))CRCHi = CRCHi Xor (Val("&H" + (Mid$(LTable(Temp), 3, 2))))Temp = (CRCLo And &HF) Xor (PP \ 2 ^ 4)CRCLo = CRCLo \ 2 ^ 4TCRC = (CRCHi And &HF)TCRC = TCRC * 2 ^ 4: CRCLo = CRCLo Or TCRCCRCHi = CRCHi \ 2 ^ 4CRCLo = CRCLo Xor (Val("&H" + (Right$(LTable(Temp), 2))))CRCHi = CRCHi Xor (Val("&H" + (Mid$(LTable(Temp), 3, 2))))
Next I
CRC16 = Hex$(CRCLo) + Hex$(CRCHi)
End FunctionFunction MbusVer() As IntegerMbusVer = 12
End Function改一下工程名然后编译，这个OCX名字叫 Mbus.ocx，然后用regsvr32注册这个ocx，并打开VS2022建VB.NET新工程。在工程中引入Mbus这个ocx方式的COM
老套路，还是Imports进程序
工程中填加模块
Module Module1Declare Function DllRegisterServer Lib "Mbus.ocx" Alias "DllRegisterServer" () As LongDeclare Function DllUnregisterServer Lib "Mbus.ocx" Alias "DllUnregisterServer" () As Long
End Module在Application启动时自动注册ocx控件
在主窗体关闭时自动注销ocx控件
Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles MyBase.FormClosedDim dReturn As DoubledReturn = DllUnregisterServer()dReturn = DllUnregisterServer()dReturn = DllUnregisterServer()End Sub在窗体上的Command钮下，写调用代码。
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.ClickDim s As New Mbus.UserControl1TextBox1.Text = Microsoft.VisualBasic.Str(s.MbusVer() / 10)TextBox10.Text = "CRC16 = " & s.CRC16("010303E80002")TextBox2.Text = s.MKI(1123.21) 'MKITextBox9.Text = s.CVI(TextBox2.Text) 'CVITextBox3.Text = s.MKL(1123.21) 'MKLTextBox8.Text = s.CVL(TextBox3.Text) 'CVLTextBox4.Text = s.MKS(1123.21) 'MKSTextBox7.Text = s.CVS(TextBox4.Text) 'CVSTextBox5.Text = s.MKD(1123.21) 'MKDTextBox6.Text = s.CVD(TextBox5.Text) 'CVDEnd Sub在x86模拟下调试并编译，测试通过。
![java八股文面试[Spring]——如何实现一个IOC容器](https://img-blog.csdnimg.cn/img_convert/f021207ca7c074ef3cc030ca5c3691f9.png)
