VB.NET calls VB6 functions encapsulated in OCX controls

Encapsulating functional functions in OCX can be simplified on the VB6 platform. Just paste those functions directly into the default template. In the blog post [Encapsulating the Function in “VB6 Programming IEEE Floating Point Algorithm Practice” into OCX] Encapsulating the Function in “VB6 Programming IEEE Floating Point Algorithm Practice” into OCX_Mongnewer’s blog-CSDN blog has detailed the OCX encapsulation of VB6 practice.

Below is the code of all functional functions for easy reference in later calls. CRC16 is referenced on CDSN. I can’t find which blog post it is in. If anyone knows, please tell me and I will post the source on the code.

Function MKI(ByVal iData As Integer) As String
    'MKI 16bits &HFFFF -32768 to 32767 8000-7fff
    Dim inData As Long
    Dim HiByte As Long, LoByte As Long
    
    inData = Fix(iData)
    If inData < 0 Then inData = inData + 65536
    
    LoByte = inData And &HFF
    HiByte = (inData \ 2 ^ 8) And &HFF
    
    MKI = 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 7ffffffff
    '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 Currency
    inData = Fix(lData)
    Phi4 = inData And &HFF
    Phi3 = (inData \ 2 ^ 8) And &HFF
    Phi2 = (inData \ 2 ^ 16) And &HFF
    Phi1 = (inData \ 2 ^ 24) And &HFF
    MKL = 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 Byte
    Dim inData As Single
    Dim ipart As Long, npart As Byte, fpart As Single
    Dim tipart As Long, tnpart As Byte, tfpart As Single
    Dim AcuFactor As Byte, iDataExp As Integer, MoveDotPoint As Byte, ReIndex As Byte
    Dim TempData1(79) As Byte, TempData2(79) As Byte, TempData3(79) As Byte, TempData4(79) As Byte, TempData5(79) As Byte
    Dim IntiStr As String, FracStr As String
    Dim TempData As Integer, TempString As String
    Dim TempByte As Byte, OffSet As Integer, OffSetBits As Byte
    Dim CaseID As Integer, I As Integer
    Dim CRC16 As Long, CRC16Str As String
    
    OffSetBits = 8
    AcuFactor = 32: OffSet = 127

    inData = sData
    
    inDataSingn = 0
    If inData < 0 Then inDataSingn = 1
    
    inData = Abs(inData) 'ignore singn
    ipart = Int(inData): fpart = (inData - ipart)
    
    If inData = 0 Then
        CaseID = 0
    Else
        'Convert ipart, the integer part, into byte array TempData1 MSB to LSB
        tipart = ipart: TempString = ""
        For I = 1 To AcuFactor
            TempString = Right$(Str$(tipart And &H1), 1) + TempString
            tipart = tipart \ 2 ^ 1
        Next I
        For I = 1 To AcuFactor
            If Mid$(TempString, I, 1) = "1" Then Exit For
            Mid$(TempString, I, 1) = " "
        Next I
            IntiStr = Trim(TempString)
    
        'Convert fpart, the fraction part, into byte array TempData2
        tfpart = fpart: TempString = ""
        For I = 1 To AcuFactor
            If tfpart = 0 Then Exit For
            tfpart = tfpart * 2
            tnpart = Int(tfpart): tfpart = tfpart - tnpart
            TempString = TempString + Right$(Str$(tnpart And &H1), 1)
        Next I
            FracStr = TempString
            
        If ipart > 0 Then CaseID = 1
        If ipart = 0 Then CaseID = 2
    End If
    
    Select Case CaseID
        Case 0
            TempByte = 0
            TempString = Right$((String(AcuFactor, "0") + Hex$(TempByte)), AcuFactor / 4)
            MKS = TempString
        Case 1 'Data with integer part
            For I = 1 To Len(IntiStr)
                If Mid$(IntiStr, I, 1) = "1" Then Exit For
            Next I
            
            MoveDotPoint = Len(IntiStr) - I
            iDataExp = MoveDotPoint + OffSet
            
            'Now Sign, Exp and Fracpart ready
            TempData = iDataExp
            TempString = ""

            For I = 1 To OffSetBits
                TempString = Right$(Str$(TempData And &H1), 1) + TempString
                TempData = TempData \ 2 ^ 1
            Next I
            
                'Sign and Exponent
                CRC16Str = Trim(Str$(inDataSingn)) + Right$(TempString, OffSetBits)
                
                'Make full string and omit first "1"
                TempString = IntiStr + FracStr
                TempString = Right$(TempString, Len(TempString) - 1)
            
                CRC16Str = Left$((CRC16Str + TempString + String(AcuFactor, "0")), AcuFactor)
                
                TempString = ""
                For I = 1 To AcuFactor Step 4
                    TempByte = 0
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or ( & amp;H8 * Val(Mid$(CRC16Str, I + 3, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or ( & amp;H8 * Val(Mid$(CRC16Str, I + 2, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or ( & amp;H8 * Val(Mid$(CRC16Str, I + 1, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or ( & amp;H8 * Val(Mid$(CRC16Str, I + 0, 1)))
                    TempString = TempString + Hex$(TempByte)
                Next I
                    MKS = TempString
                    
        Case 2 'Data without integer part
            For I = 1 To Len(FracStr)
                If Mid$(FracStr, I, 1) = "1" Then Exit For
            Next I
            
            MoveDotPoint = I
            iDataExp = -1 * MoveDotPoint + OffSet
            
            'Now Sign, Exp and Fracpart ready
            TempData = iDataExp
            TempString = ""
            For I = 1 To OffSetBits
                TempString = Right$(Str$(TempData And &H1), 1) + TempString
                TempData = TempData \ 2 ^ 1
            Next I
            
            TempString = Right$(TempString, OffSetBits)
            
                'Sign and Exponent, and FracPart
                CRC16Str = Trim(Str$(inDataSingn)) + Trim(TempString) + Right$(FracStr, Len(FracStr) - MoveDotPoint)
                
                TempString = ""
                For I = 1 To AcuFactor Step 4
                    TempByte = 0
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or ( & amp;H8 * Val(Mid$(CRC16Str, I + 3, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or ( & amp;H8 * Val(Mid$(CRC16Str, I + 2, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or ( & amp;H8 * Val(Mid$(CRC16Str, I + 1, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or ( & amp;H8 * Val(Mid$(CRC16Str, I + 0, 1)))
                    TempString = TempString + Hex$(TempByte)
                Next I
                    MKS = TempString
    End 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 Byte
    Dim inData As Double
    Dim ipart As Long, npart As Byte, fpart As Double
    Dim tipart As Long, tnpart As Byte, tfpart As Double
    Dim AcuFactor As Byte, iDataExp As Integer, MoveDotPoint As Byte, ReIndex As Byte
    Dim TempData1(79) As Byte, TempData2(79) As Byte, TempData3(79) As Byte, TempData4(79) As Byte, TempData5(79) As Byte
    Dim IntiStr As String, FracStr As String
    Dim TempData As Integer, TempString As String
    Dim TempByte As Byte, OffSet As Integer, OffSetBits As Byte
    Dim CaseID As Integer, I As Integer
    Dim CRC16 As Long, CRC16Str As String
    
    OffSetBits = 11
    AcuFactor = 64: OffSet = 1023

    inData = sData
    
    inDataSingn = 0
    If inData < 0 Then inDataSingn = 1
    
    inData = Abs(inData) 'ignore singn
    ipart = Int(inData): fpart = (inData - ipart)
    
    If inData = 0 Then
        CaseID = 0
    Else
        'Convert ipart, the integer part, into byte array TempData1 MSB to LSB
        tipart = ipart: TempString = ""
        For I = 1 To AcuFactor
            TempString = Right$(Str$(tipart And &H1), 1) + TempString
            tipart = tipart \ 2 ^ 1
        Next I
        For I = 1 To AcuFactor
            If Mid$(TempString, I, 1) = "1" Then Exit For
            Mid$(TempString, I, 1) = " "
        Next I
            IntiStr = Trim(TempString)
    
        'Convert fpart, the fraction part, into byte array TempData2
        tfpart = fpart: TempString = ""
        For I = 1 To AcuFactor
            If tfpart = 0 Then Exit For
            tfpart = tfpart * 2
            tnpart = Int(tfpart): tfpart = tfpart - tnpart
            TempString = TempString + Right$(Str$(tnpart And &H1), 1)
        Next I
            FracStr = TempString
            
        If ipart > 0 Then CaseID = 1
        If ipart = 0 Then CaseID = 2
    End If
    
    Select Case CaseID
        Case 0
            TempByte = 0
            TempString = Right$((String(AcuFactor, "0") + Hex$(TempByte)), AcuFactor / 4)
            CRC16Str = TempString
        Case 1 'Data with integer part
            For I = 1 To Len(IntiStr)
                If Mid$(IntiStr, I, 1) = "1" Then Exit For
            Next I
            
            MoveDotPoint = Len(IntiStr) - I
            iDataExp = MoveDotPoint + OffSet
            
            'Now Sign, Exp and Fracpart ready
            TempData = iDataExp
            TempString = ""
            For I = 1 To OffSetBits
                TempString = Right$(Str$(TempData And &H1), 1) + TempString
                TempData = TempData \ 2 ^ 1
            Next I
            
                'Sign and Exponent
                CRC16Str = Trim(Str$(inDataSingn)) + Right$(TempString, OffSetBits)
                
                'Make full string and omit first "1"
                TempString = IntiStr + FracStr
                TempString = Right$(TempString, Len(TempString) - 1)
            
                CRC16Str = Left$((CRC16Str + TempString + String(AcuFactor, "0")), AcuFactor)
        Case 2 'Data without integer part
            For I = 1 To Len(FracStr)
                If Mid$(FracStr, I, 1) = "1" Then Exit For
            Next I
            
            MoveDotPoint = I
            iDataExp = -1 * MoveDotPoint + OffSet
            
            'Now Sign, Exp and Fracpart ready
            TempData = iDataExp
            TempString = ""
            For I = 1 To AcuFactor
                TempString = Right$(Str$(TempData And &H1), 1) + TempString
                TempData = TempData \ 2 ^ 1
            Next I
            
            TempString = Right$(TempString, OffSetBits)
            'Sign and Exponent, and FracPart
            CRC16Str = Trim(Str$(inDataSingn)) + Trim(TempString) + Right$(FracStr, Len(FracStr) - MoveDotPoint)
            
    End Select
                TempString = ""
                For I = 1 To AcuFactor Step 4
                    TempByte = 0
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or ( & amp;H8 * Val(Mid$(CRC16Str, I + 3, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or ( & amp;H8 * Val(Mid$(CRC16Str, I + 2, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or ( & amp;H8 * Val(Mid$(CRC16Str, I + 1, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or ( & amp;H8 * Val(Mid$(CRC16Str, I + 0, 1)))

                    TempString = TempString + Hex$(TempByte)
                Next I
                    MKD = TempString
End Function
Function CVI(ByVal iData As String) As Long
    'CVI gives 16bits &HFFFF -32768 to 32767 8000-7fff
    Dim iReturn As Long
    Dim HiByte As String, LoByte As String
    Dim TempStr As String
    
    TempStr = Right$(Space(4) + iData, 4)
    
    HiByte = Left$(TempStr, 2)
    LoByte = Right$(TempStr, 2)
    
    iReturn = Val(" & amp;H" + HiByte) * 256 + Val(" & amp;H" + LoByte)
    
    CVI = iReturn
End Function
Function CVL(ByVal lData As String) As Long
    'CVL gives 32bits &HFFFFFFFF -2147483648 to 2147483647 80000000 to 7ffffffff
    Dim inData As String
    Dim iReturn As Long
    Dim LoWord As Integer, HiWord As Integer
    
    inData = Right((Space(8) + lData), 8)
    LoWord = Val(" & amp;H" + Right$(inData, 4))
    HiWord = Val(" & amp;H" + Left$(inData, 4))
    
    iReturn = HiWord * ( & amp;HFFFF + 1) + LoWord
    CVL = iReturn
End Function

Function CVS(ByVal sData As String) As Single
    Dim inData As String
    Dim TempStr As String, TempChar As String, TempCharVal As Byte
    Dim SignBit As Integer, iExp As Integer, tiExp As Integer
    Dim I As Integer, J As Integer
    Dim IntiPart As String, FracPart As String
    Dim IntiData As Double, FracData As Double
    
    inData = Right$((String(8, "0") + sData), 8)
    
    TempStr = ""
    For I = 1 to 8
        TempChar = Mid$(inData, 9 - I, 1)
        TempCharVal = Val(" & amp;H" + Right$(TempChar, 1))
        For J = 1 To 4
            TempStr = Trim$(Str$(TempCharVal And &H1)) + TempStr
            TempCharVal = TempCharVal \ 2 ^ 1
        Next J
    Next I
    
    SignBit=1
    If Left$(TempStr, 1) = "1" Then SignBit = -1
    
    iExp = 0
    For I = 2 To 9
        iExp = iExp * 2^1
        iExp = iExp Or Val(Mid$(TempStr, I, 1))
    Next I
    
    'positive for data greater than 1, or negative for data with only fraction part
    If iExp >= 127 Then 'IntiPart exists
        tiExp = iExp - 127
        If tiExp > 0 Then
            IntiPart = "1" + Left$(Mid$(TempStr, 10, 23), tiExp)
            FracPart = Right$((Mid$(TempStr, 10, 23)), 23 - tiExp)
        End If
        If tiExp = 0 Then
            IntiPart = "1" + Left$(Mid$(TempStr, 10, 23), tiExp)
            FracPart = Right$((Mid$(TempStr, 10, 23)), 23)
        End If
    Else
        tiExp = iExp - 127
        IntiPart = "0"
        FracPart = String(Abs(tiExp + 1), "0") + "1" + Mid$(TempStr, 10, 23)
        FracData = 0
        For I = 1 To Len(FracPart)
            If Mid$(FracPart, I, 1) = "1" Then
                FracData = FracData + 2 ^ (-I)
            End If
        Next I
    End If
        
        IntiData = 0
        For I = 1 To Len(IntiPart)
            IntiData = IntiData * 2^1
            IntiData = IntiData Or Val(Mid$(IntiPart, I, 1))
        Next I
        FracData = 0
        For I = 1 To Len(FracPart)
            If Mid$(FracPart, I, 1) = "1" Then
                FracData = FracData + 2 ^ (-I)
            End If
        Next I
        
        CVS = SignBit * (IntiData + Val(Format$(FracData, "#.###############0")))
End Function
Function CVD(ByVal sData As String) As Double
    Dim inData As String
    Dim TempStr As String, TempChar As String, TempCharVal As Byte
    Dim SignBit As Integer, iExp As Integer, tiExp As Integer
    Dim I As Integer, J As Integer
    Dim IntiPart As String, FracPart As String
    Dim IntiData As Double, FracData As Double
    
    inData = Right$((String(16, "0") + sData), 16)
    
    TempStr = ""
    For I = 1 To 16
        TempChar = Mid$(inData, 17 - I, 1)
        TempCharVal = Val(" & amp;H" + Right$(TempChar, 1))
        For J = 1 To 4
            TempStr = Trim$(Str$(TempCharVal And &H1)) + TempStr
            TempCharVal = TempCharVal \ 2 ^ 1
        Next J
    Next I
    
    SignBit=1
    If Left$(TempStr, 1) = "1" Then SignBit = -1
    
    iExp = 0
    For I = 2 To 12
        iExp = iExp * 2^1
        iExp = iExp Or Val(Mid$(TempStr, I, 1))
    Next I
    
    'positive for data greater than 1, or negative for data with only fraction part
    If iExp >= 1023 Then 'IntiPart exist
        tiExp = iExp - 1023
        If tiExp > 0 Then
            IntiPart = "1" + Left$(Mid$(TempStr, 13, 52), tiExp)
            FracPart = Right$((Mid$(TempStr, 13, 52)), 52 - tiExp)
        End If
        If tiExp = 0 Then
            IntiPart = "1" + Left$(Mid$(TempStr, 13, 52), tiExp)
            FracPart = Right$((Mid$(TempStr, 13, 52)), 52)
        End If
    Else
        tiExp = iExp - 1023
        IntiPart = "0"
        FracPart = String(Abs(tiExp + 1), "0") + "1" + Mid$(TempStr, 13, 52)
        FracData = 0
        For I = 1 To Len(FracPart)
            If Mid$(FracPart, I, 1) = "1" Then
                FracData = FracData + 2 ^ (-I)
            End If
        Next I
    End If
        
        IntiData = 0
        For I = 1 To Len(IntiPart)
            IntiData = IntiData * 2^1
            IntiData = IntiData Or Val(Mid$(IntiPart, I, 1))
        Next I
        FracData = 0
        For I = 1 To Len(FracPart)
            If Mid$(FracPart, I, 1) = "1" Then
                FracData = FracData + 2 ^ (-I)
            End If
        Next I
        
        CVD = SignBit * (IntiData + Val(Format$(FracData, "#.###############0")))
End Function

Function 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 Byte

DimLTable()
LTable() = Array( _
  " & amp;H0000", " & amp;HCC01", " & amp;HD801", " & amp;H1400", " & amp;HF001", " & amp; H3C00", " &H2800", " &HE401", _
  " & amp;HA001", " & amp;H6C00", " & amp;H7800", " & amp;HB401", " & amp;H5000", " & amp; H9C01", " & amp;H8801", " & amp;H4400")

TestString = inData
'TestString = "010303E80002"

CRCHi = & amp;HFF: CRCLo = & amp;HFF

For I = 1 To Len(TestString) / 2
    PP = Val(" & amp;H" + Mid$(TestString, I * 2 - 1, 2))
    Temp = (CRCLo And & amp;HF) Xor (PP And & amp;HF)
    
    CRCLo = CRCLo\ 2^4
    TCRC = (CRCHi And &HF)
    TCRC = TCRC * 2^4: CRCLo = CRCLo Or TCRC
    CRCHi = CRCHi \ 2^4
    
    CRCLo = CRCLo Xor (Val(" & amp;H" + (Right$(LTable(Temp), 2))))
    CRCHi = CRCHi Xor (Val(" & amp;H" + (Mid$(LTable(Temp), 3, 2))))
    
    Temp = (CRCLo And &HF) Xor (PP \ 2 ^ 4)
    
    CRCLo = CRCLo\ 2^4
    TCRC = (CRCHi And &HF)
    TCRC = TCRC * 2^4: CRCLo = CRCLo Or TCRC
    CRCHi = CRCHi \ 2^4

    CRCLo = CRCLo Xor (Val(" & amp;H" + (Right$(LTable(Temp), 2))))
    CRCHi = CRCHi Xor (Val(" & amp;H" + (Mid$(LTable(Temp), 3, 2))))
Next I
CRC16 = Hex$(CRCLo) + Hex$(CRCHi)
End Function

Function MbusVer() As Integer
    MbusVer=12
End Function

Change the project name and compile it. The name of this OCX is Mbus.ocx. Then use regsvr32 to register this ocx, and open VS2022 to build a new VB.NET project. Introduce Mbus, an ocx-based COM, into the project

The old routine is still Import into the program.

Add modules to the project

Module Module1
    Declare Function DllRegisterServer Lib "Mbus.ocx" Alias "DllRegisterServer" () As Long
    Declare Function DllUnregisterServer Lib "Mbus.ocx" Alias "DllUnregisterServer" () As Long
End Module

Automatically register the ocx control when the Application starts

Automatically log out the ocx control when the main form is closed

 Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles MyBase.FormClosed
        Dim dReturn As Double
        dReturn = DllUnregisterServer()
        dReturn = DllUnregisterServer()
        dReturn = DllUnregisterServer()
    End Sub

Under the Command button on the form, write the calling code.

 Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim s As New Mbus.UserControl1
        TextBox1.Text = Microsoft.VisualBasic.Str(s.MbusVer() / 10)
        TextBox10.Text = "CRC16 = " & s.CRC16("010303E80002")

        TextBox2.Text = s.MKI(1123.21) 'MKI
        TextBox9.Text = s.CVI(TextBox2.Text) 'CVI

        TextBox3.Text = s.MKL(1123.21) 'MKL
        TextBox8.Text = s.CVL(TextBox3.Text) 'CVL

        TextBox4.Text = s.MKS(1123.21) 'MKS
        TextBox7.Text = s.CVS(TextBox4.Text) 'CVS

        TextBox5.Text = s.MKD(1123.21) 'MKD
        TextBox6.Text = s.CVD(TextBox5.Text) 'CVD
    End Sub

Debugged and compiled under x86 simulation, and the test passed.