www.pudn.com > armok01131054.rar > 汉字处理.frm, change:2006-10-05,size:17294b


VERSION 5.00 
Begin VB.Form FrmHZZM  
   Caption         =   "字模生成(by mljda 06 10 5 0 27)" 
   ClientHeight    =   6585 
   ClientLeft      =   2475 
   ClientTop       =   2415 
   ClientWidth     =   10755 
   LinkTopic       =   "Form1" 
   MaxButton       =   0   'False 
   MinButton       =   0   'False 
   ScaleHeight     =   439 
   ScaleMode       =   3  'Pixel 
   ScaleWidth      =   717 
   Begin VB.Frame FraDot  
      Caption         =   "点阵数据" 
      Height          =   3855 
      Left            =   0 
      TabIndex        =   11 
      Top             =   2640 
      Width           =   10695 
      Begin VB.OptionButton OptC51  
         Caption         =   "C51格式" 
         Height          =   180 
         Left            =   2520 
         TabIndex        =   14 
         Top             =   240 
         Width           =   1335 
      End 
      Begin VB.OptionButton OptASM  
         Caption         =   "ASM51格式" 
         Height          =   180 
         Left            =   1200 
         TabIndex        =   13 
         Top             =   240 
         Value           =   -1  'True 
         Width           =   1215 
      End 
      Begin VB.TextBox TxtDot  
         Height          =   3255 
         Left            =   120 
         Locked          =   -1  'True 
         MultiLine       =   -1  'True 
         ScrollBars      =   2  'Vertical 
         TabIndex        =   12 
         Top             =   480 
         Width           =   10455 
      End 
      Begin VB.Label Label3  
         Caption         =   "数据格式:" 
         Height          =   255 
         Left            =   240 
         TabIndex        =   15 
         Top             =   240 
         Width           =   975 
      End 
   End 
   Begin VB.Frame FraShow  
      Caption         =   "显示" 
      Height          =   1575 
      Left            =   0 
      TabIndex        =   2 
      Top             =   960 
      Width           =   8055 
      Begin VB.ComboBox CmbFont  
         Height          =   300 
         ItemData        =   "汉字处理.frx":0000 
         Left            =   6480 
         List            =   "汉字处理.frx":001C 
         Style           =   2  'Dropdown List 
         TabIndex        =   8 
         Top             =   840 
         Width           =   735 
      End 
      Begin VB.ComboBox CmbBack  
         Height          =   300 
         ItemData        =   "汉字处理.frx":0042 
         Left            =   6480 
         List            =   "汉字处理.frx":005E 
         Style           =   2  'Dropdown List 
         TabIndex        =   7 
         Top             =   1200 
         Width           =   735 
      End 
      Begin VB.HScrollBar HSc1  
         Enabled         =   0   'False 
         Height          =   255 
         Left            =   20 
         Min             =   1 
         TabIndex        =   6 
         Top             =   1250 
         Value           =   1 
         Width           =   6315 
      End 
      Begin VB.OptionButton OptZX  
         Caption         =   "纵向" 
         Height          =   255 
         Left            =   6480 
         TabIndex        =   5 
         Top             =   480 
         Value           =   -1  'True 
         Width           =   1455 
      End 
      Begin VB.OptionButton OptHX  
         Caption         =   "横向" 
         Height          =   180 
         Left            =   6480 
         TabIndex        =   4 
         Top             =   240 
         Width           =   1455 
      End 
      Begin VB.PictureBox Pic  
         AutoRedraw      =   -1  'True 
         Height          =   1000 
         Left            =   240 
         ScaleHeight     =   134.328 
         ScaleMode       =   0  'User 
         ScaleWidth      =   671.692 
         TabIndex        =   3 
         Top             =   240 
         Width           =   6075 
      End 
      Begin VB.Label Label2  
         Caption         =   "背景色" 
         Height          =   255 
         Left            =   7320 
         TabIndex        =   10 
         Top             =   1200 
         Width           =   615 
      End 
      Begin VB.Label Label1  
         Caption         =   "字体色" 
         Height          =   255 
         Left            =   7320 
         TabIndex        =   9 
         Top             =   840 
         Width           =   615 
      End 
   End 
   Begin VB.TextBox TxtInput  
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   14.25 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   405 
      Left            =   240 
      TabIndex        =   1 
      Top             =   360 
      Width           =   6135 
   End 
   Begin VB.CommandButton CmdBuild  
      Caption         =   "生成" 
      Default         =   -1  'True 
      Height          =   375 
      Left            =   6480 
      TabIndex        =   0 
      Top             =   360 
      Width           =   1215 
   End 
   Begin VB.Label Label4  
      Caption         =   "点阵示意图" 
      Height          =   1335 
      Left            =   8040 
      TabIndex        =   16 
      Top             =   120 
      Width           =   255 
   End 
   Begin VB.Image Image1  
      Height          =   2415 
      Left            =   8400 
      Stretch         =   -1  'True 
      Top             =   120 
      Width           =   2295 
   End 
End 
Attribute VB_Name = "FrmHZZM" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
 
 
 
Private Sub abort_Click() 
 
End Sub 
 
Private Sub CmbBack_LostFocus() 
Select Case CmbBack.Text 
    Case "黄" 
    back = 黄 
    Case "洋红" 
    back = 洋红 
    Case "青" 
    back = 青 
    Case "蓝" 
    back = 蓝 
    Case "红" 
    back = 红 
    Case "绿" 
    back = 绿 
    Case "黑" 
    back = 黑 
    Case "白" 
    back = 白 
     
End Select 
End Sub 
 
Private Sub CmbFont_LostFocus() 
Select Case CmbFont.Text 
    Case "洋红" 
    color = 洋红 
    Case "青" 
    color = 青 
    Case "蓝" 
    color = 蓝 
    Case "红" 
    color = 红 
    Case "绿" 
    color = 绿 
    Case "黄" 
    color = 黄 
    Case "黑" 
    color = 黑 
    Case "白" 
    color = 白 
     
End Select 
End Sub 
 
Private Sub CmdBuild_Click() 
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 = 16 
Else 
    ZMEnd = StrLength 
End If 
HSc1.Max = StrLength 
HSc1.Min = 1 
Pic.Cls 
TxtDot.Text = "" 
 
For i = 1 To 16                                 '如输出字符没有16个,则后几位清零 
    For j = 1 To 32 
    ZMPrint(i, j) = 0 
    Next j 
Next i 
'X = DrawHZ() 
If OptZX.Value = True Then 
Set Image1.Picture = LoadResPicture("zx", vbResBitmap) 
    For i = 1 To StrLength 
        For j = 1 To 32 
        ZMSZ(j) = ZMMatrix(i, j) 
 
        Next j 
        Call ZXCharDot 
        If OptASM.Value = True Then 
        TxtDot.Text = TxtDot.Text + GetAsmDot() + "      ;" + Mid(TxtInput.Text, i, 1) + Chr(13) + Chr(10) 
        ElseIf OptC51.Value = True Then 
        TxtDot.Text = TxtDot.Text + GetC51Dot() + "      //" + Mid(TxtInput.Text, i, 1) + Chr(13) + Chr(10) 
        End If 
        For j = 1 To 32 
        ZMMatrix(i, j) = ZMSZ(j) 
        Next j 
    Next i 
     
    For i = 1 To ZMEnd 
    For j = 1 To 32 
        ZMPrint(i, j) = ZMMatrix(i, j) 
    Next j 
    Next i 
    Call DrawZX 
ElseIf OptHX.Value = True Then 
Set Image1.Picture = LoadResPicture("hx", vbResBitmap) 
    For i = 1 To ZMEnd 
    For j = 1 To 32 
        ZMPrint(i, j) = ZMMatrix(i, j) 
        ZMSZ(j) = ZMMatrix(i, j) 
    Next j 
        If OptASM.Value = True Then 
        TxtDot.Text = TxtDot.Text + GetAsmDot() + "      ;" + Mid(TxtInput.Text, i, 1) + Chr(13) + Chr(10) 
        ElseIf OptC51.Value = True Then 
        TxtDot.Text = TxtDot.Text + GetC51Dot() + "      //" + Mid(TxtInput.Text, i, 1) + Chr(13) + Chr(10) 
        End If 
         
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