module1.bas

这是一个很好的字模软件

    k = k + 2
    
    If (ZMSZ(i) And &H40) = &H40 Then
        ZMTemp(k) = ZMTemp(k) Or &H80
    Else
        ZMTemp(k) = ZMTemp(k) And &H7F
    End If
    k = k + 2
    If (ZMSZ(i) And &H20) = &H20 Then
        ZMTemp(k) = ZMTemp(k) Or &H80
    Else
        ZMTemp(k) = ZMTemp(k) And &H7F
    End If
    k = k + 2
    If (ZMSZ(i) And &H10) = &H10 Then
        ZMTemp(k) = ZMTemp(k) Or &H80
    Else
        ZMTemp(k) = ZMTemp(k) And &H7F
    End If
    k = k + 2
    If (ZMSZ(i) And &H8) = &H8 Then
        ZMTemp(k) = ZMTemp(k) Or &H80
    Else
        ZMTemp(k) = ZMTemp(k) And &H7F
    End If
    k = k + 2
    If (ZMSZ(i) And &H4) = &H4 Then
        ZMTemp(k) = ZMTemp(k) Or &H80
    Else
        ZMTemp(k) = ZMTemp(k) And &H7F
    End If
    k = k + 2
    If (ZMSZ(i) And &H2) = &H2 Then
        ZMTemp(k) = ZMTemp(k) Or &H80
    Else
        ZMTemp(k) = ZMTemp(k) And &H7F
    End If
    k = k + 2
    If (ZMSZ(i) And &H1) = &H1 Then
        ZMTemp(k) = ZMTemp(k) Or &H80
    Else
        ZMTemp(k) = ZMTemp(k) And &H7F
    End If
    
    For j = 18 To 32 Step 2                      '每次取位值都放在数据最高位，数据左移移位 准备下次取值
    ZMTemp(j) = byteLeft(ZMTemp(j), 1)
    Next j
    k = 18
Next i
For i = 1 To 32
ZMSZ(i) = ZMTemp(i)
Next i
End Function
Public Function byteRight(byte1 As Byte, n As Integer) As Byte '将byte1右移n位
    Dim TemVar As Byte '临时变量
    Dim TemVar1 As Byte '临时变量
    Dim X, Y As Integer
    TemVar = byte1
    For X = 1 To n '移多少位就循环多少次
        For Y = 1 To 8 '从第一位(右边第一位)开始循环右移
        Select Case Y
            Case 1
                If (TemVar And &H1) = &H1 Then '如果临时变量TemVar的第一位是1,
                TemVar1 = &H1 '则将临时变量TemVar1置1,
                Else
                TemVar1 = &H0 '则将临时变量TemVar1置0,
                End If
            Case 2
                If (TemVar And &H2) = &H2 Then '如果临时变量TemVar的第二位是1,
                TemVar = TemVar Or &H1 '则将其第一位置1(其它位不变),
                Else
                TemVar = TemVar And &HFE '反之将第一位置0(其它位不变)
                End If
            Case 3
                If (TemVar And &H4) = &H4 Then '操作与上面相同
                TemVar = TemVar Or &H2
                Else
                TemVar = TemVar And &HFD
                End If
            Case 4
                If (TemVar And &H8) = &H8 Then
                TemVar = TemVar Or &H4
                Else
                TemVar = TemVar And &HFB
                End If
            Case 5
                If (TemVar And &H10) = &H10 Then
                TemVar = TemVar Or &H8
                Else
                TemVar = TemVar And &HF7
                End If
            Case 6
                If (TemVar And &H20) = &H20 Then
                TemVar = TemVar Or &H10
                Else
                TemVar = TemVar And &HEF
                End If
            Case 7
                If (TemVar And &H40) = &H40 Then
                TemVar = TemVar Or &H20
                Else
                TemVar = TemVar And &HDF
                End If
            Case 8
                If (TemVar And &H80) = &H80 Then
                TemVar = TemVar Or &H40
                Else
                TemVar = TemVar And &HBF
                End If
                If TemVar1 = &H1 Then '移完第八位后,如果TemVar1是1(即第一位是1)
                TemVar = TemVar Or &H80 '则将TemVar的第八位置1
                Else
                TemVar = TemVar And &H7F '反之置0
                End If
        End Select
        Next Y
    Next X
    byteRight = TemVar '将TemVar的值返回给函数名
    End Function
Public Function GetAsmDot() As String
Dim strAsm As String
Dim strTemp As String
    strAsm = "DB    "
    For i = 1 To 32
        strTemp = Hex(ZMSZ(i))
        For j = 1 To 3 - Len(strTemp)                'Asm51 HEX数据格式 0FF H 最大为3位，hex()会把0略去，所以自己要在前加0
            strTemp = "0" & strTemp            '"0"个数为3-有效字符长度
        Next j
            strTemp = strTemp + "H,"
        strAsm = strAsm + strTemp
        If i = 16 Then strAsm = strAsm + Chr(13) + Chr(10) + "DB    "     '每16个数据换行
    Next i
    strAsm = Left(strAsm, Len(strAsm) - 1)  '删去最末的一个 ","
    GetAsmDot = strAsm
End Function
Public Function GetC51Dot() As String
Dim strC51 As String
Dim strTemp As String
    strC51 = ""
    For i = 1 To 32
        strTemp = Hex(ZMSZ(i))
        For j = 1 To 2 - Len(strTemp)
            strTemp = "0" + strTemp
        Next j
        strC51 = strC51 + "0x" + strTemp + ","
        If i = 16 Then strC51 = strC51 + Chr(13) + Chr(10)
    Next i
    GetC51Dot = strC51
End Function

Public Function byteLeft(byte1 As Byte, n As Integer) As Byte '将byte1右移n位
    Dim TemVar As Byte '临时变量
    Dim TemVar1 As Byte '临时变量
    Dim X, Y As Integer
    TemVar = byte1
    For X = 1 To n '移多少位就循环多少次
        For Y = 8 To 1 Step -1 '从第一位(右边第一位)开始循环右移
        Select Case Y
            Case 8
                If (TemVar And &H80) = &H80 Then '如果临时变量TemVar的第8位是1,
                TemVar1 = &H1                   '则将临时变量TemVar1置1
                Else
                TemVar1 = &H0                   '则将临时变量TemVar1置0,
                End If

            Case 7
                If (TemVar And &H40) = &H40 Then '如果临时变量TemVar的第七位是1,
                TemVar = TemVar Or &H80         '则将其第一位置1(其它位不变),
                Else
                TemVar = TemVar And &H7F        '反之将第一位置0(其它位不变)
                End If

            Case 6
                If (TemVar And &H20) = &H20 Then
                TemVar = TemVar Or &H40
                Else
                TemVar = TemVar And &HBF
                End If

            Case 5
                If (TemVar And &H10) = &H10 Then
                TemVar = TemVar Or &H20
                Else
                TemVar = TemVar And &HDF
                End If

            Case 4
                If (TemVar And &H8) = &H8 Then
                TemVar = TemVar Or &H10
                Else
                TemVar = TemVar And &HEF
                End If
            Case 3
                If (TemVar And &H4) = &H4 Then '操作与上面相同
                TemVar = TemVar Or &H8
                Else
                TemVar = TemVar And &HF7
                End If
            Case 2
                If (TemVar And &H2) = &H2 Then
                TemVar = TemVar Or &H4
                Else
                TemVar = TemVar And &HFB
                End If
            Case 1
                If (TemVar And &H1) = &H1 Then
                TemVar = TemVar Or &H2
                Else
                TemVar = TemVar And &HFD
                End If
                If TemVar1 = &H1 Then '移完第八位后,如果TemVar1是1(即第8位是1)
                TemVar = TemVar Or &H1 '则将TemVar的第一位置1
                Else
                TemVar = TemVar And &HFE '反之置0
                End If
        End Select
        Next Y
    Next X
    byteLeft = TemVar '将TemVar的值返回给函数名
    End Function
    Public Function CLen(HzStr$) As Integer
    Static HzNum As Integer
    HzNum = 0
    L = Len(HzStr$)
    For n = 1 To L
    If Asc(Mid$(HzStr$, n, 1)) < 0 Then HzNum = HzNum + 1
    Next n
    CLen = L + HzNum
    End Function

' 用途：将十进制转化为二进制
' 输入：Dec(十进制数)
' 输入数据类型：Long
' 输出：DEC_to_BIN(二进制数)
' 输出数据类型：String
' 输入的最大数为2147483647,输出最大数为1111111111111111111111111111111(31个1)
Public Function DEC_to_BIN(Dec As Long) As String
    DEC_to_BIN = ""
    Do While Dec > 0
        DEC_to_BIN = Dec Mod 2 & DEC_to_BIN
        Dec = Dec \ 2
    Loop
End Function
' 用途：将十六进制转化为二进制
' 输入：Hex(十六进制数)
' 输入数据类型：String
' 输出：HEX_to_BIN(二进制数)
' 输出数据类型：String
' 输入的最大数为2147483647个字符
Public Function HEX_to_BIN(ByVal Hex As String) As String
    Dim i As Long
    Dim B As String
    
    Hex = UCase(Hex)
    For i = 1 To Len(Hex)
        Select Case Mid(Hex, i, 1)
            Case "0": B = B & "0000"
            Case "1": B = B & "0001"
            Case "2": B = B & "0010"
            Case "3": B = B & "0011"
            Case "4": B = B & "0100"
            Case "5": B = B & "0101"
            Case "6": B = B & "0110"
            Case "7": B = B & "0111"
            Case "8": B = B & "1000"
            Case "9": B = B & "1001"
            Case "A": B = B & "1010"
            Case "B": B = B & "1011"
            Case "C": B = B & "1100"
            Case "D": B = B & "1101"
            Case "E": B = B & "1110"
            Case "F": B = B & "1111"
        End Select
    Next i
    While Left(B, 1) = "0"
        B = Right(B, Len(B) - 1)
    Wend
    HEX_to_BIN = B
End Function