VB.NET调用VB6封装在OCX控件中的函数

Mongnewer

已于 2023-08-24 09:53:29 修改

阅读量313

点赞数

文章标签： VB6 OCX VB.NET调用OCX IEEE浮点计算 CRC16计算

于 2023-08-24 09:52:31 首次发布

本文链接：https://blog.csdn.net/weixin_45707491/article/details/132466707

版权

将功能函数封装于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-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 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 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 (&H8 * Val(Mid$(CRC16Str, I + 3, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 2, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 1, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or (&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 (&H8 * Val(Mid$(CRC16Str, I + 3, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 2, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 1, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or (&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 (&H8 * Val(Mid$(CRC16Str, I + 3, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 2, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or (&H8 * Val(Mid$(CRC16Str, I + 1, 1)))
                    TempByte = TempByte \ 2
                    TempByte = TempByte Or (&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("&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 7fffffff
    Dim inData As String
    Dim iReturn As Long
    Dim LoWord As Integer, HiWord As Integer
    
    inData = Right((Space(8) + lData), 8)
    LoWord = Val("&H" + Right$(inData, 4))
    HiWord = Val("&H" + Left$(inData, 4))
    
    iReturn = HiWord * (&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("&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 negtive for data with only fraction part
    If iExp >= 127 Then     'IntiPart exist
        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("&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 negtive 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

Dim 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 = &HFF

For I = 1 To Len(TestString) / 2
    PP = Val("&H" + Mid$(TestString, I * 2 - 1, 2))
    Temp = (CRCLo And &HF) Xor (PP And &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("&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 ^ 4
    TCRC = (CRCHi And &HF)
    TCRC = TCRC * 2 ^ 4: CRCLo = CRCLo Or TCRC
    CRCHi = CRCHi \ 2 ^ 4

    CRCLo = 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 Function

Function MbusVer() As Integer
    MbusVer = 12
End Function

改一下工程名然后编译，这个OCX名字叫 Mbus.ocx，然后用regsvr32注册这个ocx，并打开VS2022建VB.NET新工程。在工程中引入Mbus这个ocx方式的COM

老套路，还是Imports进程序

工程中填加模块

Module Module1
    Declare Function DllRegisterServer Lib "Mbus.ocx" Alias "DllRegisterServer" () As Long
    Declare 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.FormClosed
        Dim dReturn As Double
        dReturn = DllUnregisterServer()
        dReturn = DllUnregisterServer()
        dReturn = DllUnregisterServer()
    End Sub

在窗体上的Command钮下，写调用代码。

    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

在x86模拟下调试并编译，测试通过。

Mongnewer

关注

0
点赞
踩
0

收藏

觉得还不错? 一键收藏
0
评论
VB.NET调用VB6封装在OCX控件中的函数

在VS2022的VB.NET项目中使用VB6封装的OCX控件，如同在VB.NET项目中使用VB6封装的DLL控件，它们都在相同进程，因此只能编译为 x86 模式，而VB6写Activex EXE则可同时编译生成x64和x86代码。
复制链接

扫一扫