module1.bas

这是一个很好的字模软件

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