汉字处理.frm

这是一个很好的字模软件

Next i
    Call DrawHX
End If



HSc1.Enabled = True
'For i = 1 To 32 Step 2
''Print CStr(Hex(ZMSZ(i))); CStr(Hex(ZMSZ(i + 1)))
'Next i
'XX = RGB(255, 255, 0)
'Pic.Line (10, 10)-Step(1, 5), Red, B

'Print CByte(TxtInput.Text); byteLeft(CByte(TxtInput.Text), 1)
'TxtInput.Text = CStr(byteLeft(CByte(TxtInput.Text), 1))
'For i = 1 To 32 Step 2
'Print CLen(TxtInput.Text)
'P.PSet (i + 100, ZMSZ(i) + 100), RGB(255, 0, 0)
'Next i

'For i = 2 To 32 Step 2
'P.PSet (i + 100 + 255, ZMSZ(i) + 100), RGB(255, 0, 0)
'Next i
End Sub
Public Sub DrawZX()
Dim TemZM(1 To 32) As Byte
Dim X, Y, Xtemp, Ytemp As Integer


'Pic.Width = ((ChrWidth + Xadd) * 16 + Xadd) * 16
'Pic.Height = ((ChrHeight + Yadd) * 16 + Yadd) * (CInt(StrLength / 16) + 1)
X = 0: Y = 0


Xtemp = 0 - (16 * (ChrWidth + Xadd) + ChrWidth + Xadd): Ytemp = 0
For j = 1 To 16

    For i = 1 To 32
        TemZM(i) = ZMPrint(j, i)
    Next i
    
    If (Xtemp + 32 * (ChrWidth + Xadd)) > Pic.ScaleWidth Then      '判断是否在图片区域内
    Ytemp = Ytemp + 16 * (ChrHeight + Yadd) + Yadd: Xtemp = Xadd           '列超出区域则换行
    Else
    
    Xtemp = Xtemp + 16 * (ChrWidth + Xadd)                      '在区域内则列加一单位宽度
    End If
    
    'If (Ytemp + 16 * (ChrHeight + 2)) > Pic.ScaleHeigth Then
    X = Xtemp: Y = Ytemp
    
    For i = 1 To 32
        If (i And &H1) = &H1 Then
             X = X + ChrWidth + Xadd: Y = Ytemp                                     '为第偶数个则列不变
        Else
                      '为奇数个则提列 ,行  初始出开始
        End If
        
        
    If (TemZM(i) And &H80) = 0 Then
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), back, BF  '对应位为0则画空心矩形
    Else
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), color, BF  '对应位为1则画实心矩形,颜色color
    End If
    Y = Y + ChrHeight + Yadd
    
    If (TemZM(i) And &H40) = 0 Then
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), back, BF
    Else
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), color, BF
    End If
    Y = Y + ChrHeight + Yadd
    
    If (TemZM(i) And &H20) = 0 Then
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), back, BF
    Else
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), color, BF
    End If
    Y = Y + ChrHeight + Yadd

    If (TemZM(i) And &H10) = 0 Then
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), back, BF
    Else
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), color, BF
    End If
    Y = Y + ChrHeight + Yadd

    If (TemZM(i) And &H8) = 0 Then
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), back, BF
    Else
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), color, BF
    End If
    Y = Y + ChrHeight + Yadd

    If (TemZM(i) And &H4) = 0 Then
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), back, BF
    Else
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), color, BF
    End If
    Y = Y + ChrHeight + Yadd

    If (TemZM(i) And &H2) = 0 Then
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), back, BF
    Else
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), color, BF
    End If
    Y = Y + ChrHeight + Yadd

    If (TemZM(i) And &H1) = 0 Then
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), back, BF
    Else
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), color, BF
    End If
    Y = Y + ChrHeight + Yadd

Next i
Next j
End Sub
Public Sub DrawHX()
Dim TemZM(1 To 32) As Byte
Dim X, Y, Xtemp, Ytemp As Integer


'Pic.Width = ((ChrWidth + Xadd) * 16 + Xadd) * 16
'Pic.Height = ((ChrHeight + Yadd) * 16 + Yadd) * (CInt(StrLength / 16) + 1)
X = 0: Y = 0

Xtemp = Xadd - 16 * (ChrWidth + Xadd): Ytemp = 0 - (ChrHeight + Yadd)
For j = 1 To 16

    For i = 1 To 32
        TemZM(i) = ZMPrint(j, i)
    Next i
    
    If (Xtemp + 32 * (ChrWidth + Xadd)) > Pic.ScaleWidth Then      '判断是否在图片区域内
    Ytemp = Ytemp + 16 * (ChrHeight + Yadd) + Yadd: Xtemp = Xadd           '列超出区域则换行
    Else
    Xtemp = Xtemp + 16 * (ChrWidth + Xadd)                      '在区域内则列加一单位宽度
    End If
    
    'If (Ytemp + 16 * (ChrHeight + 2)) > Pic.ScaleHeigth Then
    X = Xtemp: Y = Ytemp
    
    For i = 1 To 32
        If (i And &H1) = 0 Then
                                                '为第偶数个则行列不变
        Else
             Y = Y + ChrHeight + Yadd: X = Xtemp           '为奇数个则提 行,列 初始出开始
        End If
        
        
    If (TemZM(i) And &H80) = 0 Then
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), back, BF  '对应位为0则画空心矩形
    Else
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), color, BF  '对应位为1则画实心矩形,颜色color
    End If
    X = X + ChrWidth + Xadd
    
    If (TemZM(i) And &H40) = 0 Then
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), back, BF
    Else
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), color, BF
    End If
    X = X + ChrWidth + Xadd
    
    If (TemZM(i) And &H20) = 0 Then
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), back, BF
    Else
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), color, BF
    End If
    X = X + ChrWidth + Xadd

    If (TemZM(i) And &H10) = 0 Then
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), back, BF
    Else
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), color, BF
    End If
    X = X + ChrWidth + Xadd

    If (TemZM(i) And &H8) = 0 Then
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), back, BF
    Else
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), color, BF
    End If
    X = X + ChrWidth + Xadd

    If (TemZM(i) And &H4) = 0 Then
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), back, BF
    Else
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), color, BF
    End If
    X = X + ChrWidth + Xadd

    If (TemZM(i) And &H2) = 0 Then
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), back, BF
    Else
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), color, BF
    End If
    X = X + ChrWidth + Xadd

    If (TemZM(i) And &H1) = 0 Then
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), back, BF
    Else
        FrmHZZM.Pic.Line (X, Y)-Step(ChrWidth, ChrHeight), color, BF
    End If
    X = X + ChrWidth + Xadd

Next i
Next j
End Sub








Private Sub Command1_Click()
Cls
End Sub

Private Sub Form_Load()
Pic.ScaleWidth = 1000 '((ChrWidth + Xadd) * 16 + Xadd) * 16
Pic.ScaleHeight = 1000 '((ChrHeight + Yadd) * 16 + Yadd) * (CInt(StrLength / 16) + 1)
ChrWidth = Pic.ScaleWidth / (16 * 16): ChrHeight = Pic.ScaleHeight / 16: Xadd = 0: Yadd = 0
红 = RGB(255, 0, 0): 黄 = RGB(255, 255, 0): 洋红 = RGB(255, 0, 255): 黑 = RGB(0, 0, 0)
绿 = RGB(0, 255, 0): 青 = RGB(0, 255, 255)
蓝 = RGB(0, 0, 255): 白 = RGB(255, 255, 255)
color = 红: back = 黑 ':: CmbBack.Text = 红: CmbFront.Text = 黑


Set Image1.Picture = LoadResPicture("zx", vbResBitmap)
End Sub

Private Sub HSc1_Change()
Dim ZMEnd As Integer
'GetHZZM ("l")
'XX = &HA3E1
'GetEngNum (TxtInput.Text)
'For i = 1 To 16
'Print ZMSZ(i);
'Next i
                        
GetStrDot (TxtInput.Text)
If StrLength > 16 Then                      '计算显示字串的在字串矩阵中的结束地址
    ZMEnd = HSc1.Value + 15                 '显示区可以显示16个字符 保证从开始地址取16个字符HSc1.Value->ZMEnd <=16个
    If ZMEnd > StrLength Then ZMEnd = StrLength     '最终提取字符的结束地址因包含在字串矩阵内
Else
    ZMEnd = StrLength                       '当字串矩阵字符个数小于显示区域(16个) 时则以字串矩阵字符个数为结束
End If                                      '使得取值地址在字串矩阵末
                                            

HSc1.Max = StrLength                        '字串矩阵总长作为进度条总长,则定义HSc1.Value最为取值的开始地址
HSc1.Min = 1                                '这样进度条对应显示当前字符在总字符串的位置
Pic.Cls

k = 1                                           '按字移位
For i = HSc1.Value To ZMEnd                     '同过HSc1.Value作为显示字符在字串矩阵中的起始地址
If OptZX.Value = True Then                      '填充输出字符字模ZMPrint
        For j = 1 To 32
        ZMSZ(j) = ZMMatrix(i, j)
        
        Next j
        Call ZXCharDot
        For j = 1 To 32
        ZMPrint(k, j) = ZMSZ(j)
        Next j
ElseIf OptHX.Value = True Then
        For j = 1 To 32
        ZMPrint(k, j) = ZMMatrix(i, j)
        Next j
End If
    k = k + 1
Next i

For i = k To 16                                 '如输出字符没有16个,则后几位清零
    For j = 1 To 32
    ZMPrint(i, j) = 0
    Next j
Next i

'X = DrawHZ()
If OptZX.Value = True Then

    Call DrawZX
ElseIf OptHX.Value = True Then
    Call DrawHX
End If

'Print HSc1.Value
End Sub