www.pudn.com > armok01131054.rar > Module1.bas, change:2006-10-04,size:16694b


Attribute VB_Name = "Module1" 
Public ZMSZ(32) As Byte 
Public ZMPrint(16, 32) As Byte 
Public ZMMatrix() As Byte 
Public XX As Variant 
Public YY As Variant 
Public 红, 黄, 绿, 洋红, 蓝, 青, 黑, 白 As Variant 
 
Public color As Variant 
Public back As Variant 
Public StrLength As Variant 
Public ChrWidth, ChrHeight As Integer 
Public Xadd, Yadd As Integer 
 
Public Function GetStrDot(MYSTR As String) As Integer '转化字符串点阵,结果存入ZMMatrix字模矩阵中 
'Dim L As Integer 
Dim CharTemp As String 
If MYSTR = "" Then              '判断输入是否正确 
MsgBox "没有正确输入!" 
Exit Function 
End If 
StrLength = Len(MYSTR)          '字符串长度 
'GetStrDot = L 
ReDim ZMMatrix(1 To StrLength, 1 To 32) As Byte 
For i = 1 To StrLength 
    GetCharDot (Mid(MYSTR, i, 1))   '调用字符字模生成程序 
    For j = 1 To 32 
    ZMMatrix(i, j) = ZMSZ(j) 
    Next j 
     
Next i 
End Function 
 
 
Public Function GetCharDot(MYCHAR As String) '字符字模生成程序 (字模源HZK16) 得到原始点阵,横向排布的 
'点阵排列 
'高位    :低位 
'第一字节:第二字节 
'第三字节:第四字节 
'................ 
'第31字节:第32字节 
 
Dim JNM As Variant, QWM As Variant '定义JNM为机内码,QWM为区位码 
Dim QM As Variant, WM As Variant    '定义QM为区码,WM为位码 
Dim ADDR As Variant                 '定义ADDR为偏移地址 
Dim i As Integer, FNUM As Integer, NUM_BYTES As Variant 
Dim BYTES() As Byte 
'If MYCHAR = "" Then MYCHAR = " " 
If Asc(MYCHAR) < 0 Then 
JNM = Hex(Asc(MYCHAR))              'MYCHAR是一个汉字字符 
QWM = Hex(Asc(MYCHAR) - &HA1A1)     '机内码-A1A1=区位码' 
ElseIf Asc(MYCHAR) >= 0 Then        '非汉字模则为ASCII码 
JNM = Hex(Asc(MYCHAR) + &HA380) 
QWM = Hex(Asc(MYCHAR) + &HA380 - &HA1A1) 
End If 
 
If Len(QWM) = 3 Then 
QM = Mid(QWM, 1, 1)                 '通过区位码得到区码 
 
WM = Mid(QWM, 2, 2)                 '通过区位码得到位码 
ElseIf Len(QWM) = 4 Then 
QM = Mid(QWM, 1, 2) 
WM = Mid(QWM, 3, 2) 
ElseIf Len(QWM) < 3 Then 
QM = "0" 
WM = QWM 
End If 
 
ADDR = 32 * ((CLng("&H" & QM)) * 94 + (CLng("&H" & WM))) '求偏移地址 
'打开字库文件文件 
'FNUM = FreeFile 
'Open App.Path + "\HZK16" For Binary As #FNUM '打开库文件KHKZ16 
'NUM_BYTES = LOF(FNUM) 
'ReDim BYTES(1 To NUM_BYTES) As Byte          '获取字库数据 
 
'Get #FNUM, , BYTES 
'For i = 1 To 32 
'ZMSZ(i) = BYTES(ADDR + i ) 'bytes(1) 从1开始复制 
'Next 
'Close FNUM                          '关闭字库文件 
 
''''''''''''''''''''''''''''''''''''''''''''''''' 
'ReDim BYTES(1 To 65536) As Byte 
'使用资源文件(RES),把汉字库打包入exe 
 
BYTES = LoadResData("hzk16", "TextFile")                                 '字符的字模点阵,存放在全局数据变量ZMDZ中 
For i = 1 To 32 
ZMSZ(i) = BYTES(ADDR + i - 1) 'bytes(0) 从0开始复制 
Next 
 
 
End Function 
Public Function ZXCharDot()     '转换为竖向点阵 
'点阵排布 
'第0位~~~第15位 
'1:3:5...31 
'----- 
'2:4:6...32字节 
Dim ZMTemp(32) As Byte 
 
k = 1 
For i = 1 To 15 Step 2                      '左上角转换 1to 15->1 to 15 step 2 
    If (ZMSZ(i) And &H80) = &H80 Then 
        ZMTemp(k) = ZMTemp(k) Or &H80 
    Else 
        ZMTemp(k) = ZMTemp(k) And &H7F 
    End If 
         
    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 = 1 To 15 Step 2                      '每次取位值都放在数据最高位,数据左移移位 准备下次取值 
    ZMTemp(j) = byteLeft(ZMTemp(j), 1) 
    Next j 
    k = 1 
Next i 
 
    k = 2                                       '左下角转换 17 to 31-> 2 to 16 step 2 
For i = 17 To 31 Step 2 
    If (ZMSZ(i) And &H80) = &H80 Then 
        ZMTemp(k) = ZMTemp(k) Or &H80 
    Else 
        ZMTemp(k) = ZMTemp(k) And &H7F 
    End If 
         
    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 = 2 To 16 Step 2                      '每次取位值都放在数据最高位,数据左移移位 准备下次取值 
    ZMTemp(j) = byteLeft(ZMTemp(j), 1) 
    Next j 
    k = 2 
Next i 
 
k = 17                                          '右上角转换,2 to 16->17 to 31 step 2 
For i = 2 To 16 Step 2 
    If (ZMSZ(i) And &H80) = &H80 Then 
        ZMTemp(k) = ZMTemp(k) Or &H80 
    Else 
        ZMTemp(k) = ZMTemp(k) And &H7F 
    End If 
         
    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 = 17 To 31 Step 2                      '每次取位值都放在数据最高位,数据左移移位 准备下次取值 
    ZMTemp(j) = byteLeft(ZMTemp(j), 1) 
    Next j 
    k = 17 
Next i 
 
k = 18                                          '右上角转换,18 to 32->18 to 32 step 2 
For i = 18 To 32 Step 2 
    If (ZMSZ(i) And &H80) = &H80 Then 
        ZMTemp(k) = ZMTemp(k) Or &H80 
    Else 
        ZMTemp(k) = ZMTemp(k) And &H7F 
    End If 
         
    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