frmgetchardot.frm

取液晶点阵（中文16*16）

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmGetCharDot 
   Caption         =   "字符点阵读取"
   ClientHeight    =   4605
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7635
   LinkTopic       =   "Form1"
   ScaleHeight     =   4605
   ScaleWidth      =   7635
   StartUpPosition =   2  '屏幕中心
   Begin VB.CheckBox chkRotate 
      Caption         =   "字符旋转输出(&R)"
      Height          =   315
      Left            =   60
      TabIndex        =   4
      Top             =   4200
      Width           =   1815
   End
   Begin VB.CommandButton cmdGetAllEZDot 
      Caption         =   "所有英文字符(&A)"
      Height          =   375
      Left            =   5880
      TabIndex        =   2
      Top             =   660
      Width           =   1575
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   660
      Top             =   1320
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdGetHZDot 
      Caption         =   "提取输入字符(&C)"
      Height          =   375
      Left            =   5880
      TabIndex        =   1
      Top             =   180
      Width           =   1575
   End
   Begin VB.TextBox txtInput 
      Height          =   3915
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Text            =   "frmGetCharDot.frx":0000
      Top             =   180
      Width           =   5595
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出(&X)"
      Height          =   375
      Left            =   5880
      TabIndex        =   3
      Top             =   1140
      Width           =   1575
   End
End
Attribute VB_Name = "frmGetCharDot"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdGetAllEZDot_Click()
    Dim iLoop As Integer, jLoop As Integer
    Dim lngTmp As Long, intTmp As Integer
    Dim bytTmp As Byte, strTmp As String
    Dim strDestA As String, strDestB As String
    Dim blnRotate As Boolean, lngQH As Long
    
    strDestA = App.Path & "\EZK1608.DAT"
    strDestB = App.Path & "\EZK1608.H"
    
    If Dir(strDestA) <> "" Then Kill (strDestA)
    If Dir(strDestB) <> "" Then Kill (strDestB)
    
    Open App.Path & "\ASC16" For Random Access Read As #101 Len = 1
    Open strDestA For Binary Access Write As #102
    Open strDestB For Append Access Write As #103
    
    strTmp = "unsigned char dotEZK1608[128][16]={"
    Print #103, strTmp
    
    'If chkRotate.Value = 1 Then
    '    blnRotate = True
    '    lngQH = 10      '区号-1
    'Else
    '    blnRotate = False
    '    lngQH = 9       '区号-1
    'End If
    
    For iLoop = 0 To 127
        lngTmp = 16
        lngTmp = lngTmp * iLoop
        'lngTmp = lngQH * 94 * 32 + 1 + lngTmp   '(区号-1)*94*32+1
        strTmp = ""
        For jLoop = 0 To 31 Step 2
            Get #101, lngTmp + jLoop, bytTmp
            Put #102, , bytTmp
            
            strTmp = strTmp & "0x" & Right("0" & Hex(bytTmp), 2)
            If jLoop < 30 Then
                strTmp = strTmp & ","
            End If
            If jLoop = 14 Then
                strTmp = strTmp & vbCrLf & Space(17)
            End If
        Next jLoop
        If iLoop = 127 Then
            strTmp = Space(16) & "{" & strTmp & "}};"
        Else
            strTmp = Space(16) & "{" & strTmp & "},"
        End If
        Print #103, strTmp
        
    Next iLoop
    
    Close #101
    Close #102
    Close #103
    
    MsgBox "所提取的英文字符点阵，已保存到：" & Space(8) & vbCrLf & vbCrLf _
        & strDestA & vbCrLf & vbCrLf & strDestB & vbCrLf, _
        vbOKOnly + vbInformation, "提示"
        
End Sub

Private Sub cmdGetHZDot_Click()
    Dim iLoop As Integer, jLoop As Integer, kLoop As Integer
    Dim lngTmp As Long, intTmp As Integer
    Dim bytTmp As Byte, strTmp As String, strTmp2
    Dim strDestA As String, strDestB As String
    Dim lngQH As Long, lngWH As Long
    Dim strEZKStr As String, strHZKStr As String
    Dim blnRotate As Boolean
    Dim bytHZDotD(0 To 31) As Byte, bytXX As Byte
    
    
    strTmp = Trim(txtInput.Text)
    intTmp = Len(strTmp)
    If intTmp = 0 Then
        MsgBox "您还没有输入字要提取点阵的字符！", vbOKOnly + vbCritical
        Exit Sub
    End If
    
    If chkRotate.Value = 1 Then
        blnRotate = True
    Else
        blnRotate = False
    End If
    
    strEZKStr = ""
    strHZKStr = ""
    
    For iLoop = 1 To intTmp
        strTmp2 = Mid(strTmp, iLoop, 1)
        lngQH = Asc(strTmp2)
        If lngQH >= 0 Then
            If lngQH > 32 Then
                strEZKStr = strEZKStr & strTmp2
            End If
        Else
            strHZKStr = strHZKStr & strTmp2
        End If
    Next iLoop
    
    If strEZKStr = "" And strHZKStr = "" Then
        MsgBox "您还没有输入字要提取点阵的字符！", vbOKOnly + vbCritical
        Exit Sub
    End If
    
    strDestA = App.Path & "\ZKDOT16S.DAT"
    strDestB = App.Path & "\ZKDOT16S.H"
    
    If Dir(strDestA) <> "" Then Kill (strDestA)
    If Dir(strDestB) <> "" Then Kill (strDestB)
    
    Open App.Path & "\HZK16N" For Random Access Read As #101 Len = 1
    Open strDestA For Binary Access Write As #102
    Open strDestB For Append Access Write As #103
       
    '英文字符
    If strEZKStr <> "" Then
        intTmp = Len(strEZKStr)
        strTmp = vbCrLf & "#define conTotalEZNum" _
                & Space(11) & Format(intTmp) & vbCrLf & vbCrLf _
                & "unsigned char strEZK1608S[]=""" _
                & strEZKStr & "\0"";" & vbCrLf _
                & "unsigned char dotEZK1608S[" _
                & Format(intTmp, "0") & "][16]={"
        Print #103, strTmp
        
        For iLoop = 1 To intTmp
            lngWH = Asc(Mid(strEZKStr, iLoop, 1))
            lngWH = (lngWH - &H21) * 32
            strTmp = ""
            If blnRotate Then
                lngQH = 10 * 94 * 32 + 1 + lngWH  '(区号-1)*94*32+1
                For jLoop = 0 To 15
                    Get #101, lngQH + jLoop, bytTmp
                    Put #102, , bytTmp
                
                    strTmp = strTmp & "0x" & Right("0" & Hex(bytTmp), 2)
                    If jLoop < 15 Then
                        strTmp = strTmp & ","
                    End If
                
                    If jLoop = 7 Then
                        strTmp = strTmp & vbCrLf & Space(17)
                    End If
                Next jLoop
            Else
                lngQH = 9 * 94 * 32 + 1 + lngWH   '(区号-1)*94*32+1
                For jLoop = 0 To 31 Step 2
                    Get #101, lngQH + jLoop, bytTmp
                    Put #102, , bytTmp
                
                    strTmp = strTmp & "0x" & Right("0" & Hex(bytTmp), 2)
                    If jLoop < 30 Then
                        strTmp = strTmp & ","
                    End If
                
                    If jLoop = 14 Then
                        strTmp = strTmp & vbCrLf & Space(17)
                    End If
                Next jLoop
            End If
            
            If iLoop = intTmp Then
                strTmp = Space(16) & "{" & strTmp & "}};"
            Else
                strTmp = Space(16) & "{" & strTmp & "},"
            End If
            Print #103, strTmp
            
        Next iLoop
    End If
    
    '中文字符
    If strHZKStr <> "" Then
        intTmp = Len(strHZKStr)
        strTmp = vbCrLf & "#define conTotalHZNum" _
                & Space(11) & Format(intTmp) & vbCrLf & vbCrLf _
                & "unsigned char strHZK1616S[]=""" _
                & strHZKStr & "\0"";" & vbCrLf _
                & "unsigned char dotHZK1616S[" _
                & Format(intTmp, "0") & "][32]={"
        Print #103, strTmp
        
        For iLoop = 1 To intTmp
            lngWH = Asc(Mid(strHZKStr, iLoop, 1))
            lngQH = lngWH + 65536
            lngWH = (lngQH Mod 256) - 160
            lngQH = (lngQH \ 256) - 160
            
            lngQH = (lngQH - 1) * 94 * 32 + (lngWH - 1) * 32 + 1
            strTmp = ""
            
            If blnRotate Then
                For jLoop = 0 To 31
                    bytHZDotD(jLoop) = 0
                Next jLoop
            End If
            
            For jLoop = 0 To 31 Step 1
                Get #101, lngQH + jLoop, bytTmp
                
                If Not blnRotate Then
                    bytHZDotD(jLoop) = bytTmp
                Else
                    If jLoop = 0 Or jLoop = 16 Then
                        bytXX = 1
                    Else
                        If jLoop Mod 2 = 0 Then
                            bytXX = bytXX * 2
                        End If
                    End If
                    
                    kLoop = 1 + (jLoop Mod 2) * 16 - (jLoop \ 16)
                    
                    bytHZDotD(kLoop) = bytHZDotD(kLoop) + (bytTmp \ 128) * bytXX
                    bytTmp = bytTmp Mod 128
                    
                    bytHZDotD(kLoop + 2) = bytHZDotD(kLoop + 2) + (bytTmp \ 64) * bytXX
                    bytTmp = bytTmp Mod 64
                    
                    bytHZDotD(kLoop + 4) = bytHZDotD(kLoop + 4) + (bytTmp \ 32) * bytXX
                    bytTmp = bytTmp Mod 32
                    
                    bytHZDotD(kLoop + 6) = bytHZDotD(kLoop + 6) + (bytTmp \ 16) * bytXX
                    bytTmp = bytTmp Mod 16
                    
                    bytHZDotD(kLoop + 8) = bytHZDotD(kLoop + 8) + (bytTmp \ 8) * bytXX
                    bytTmp = bytTmp Mod 8
                    
                    bytHZDotD(kLoop + 10) = bytHZDotD(kLoop + 10) + (bytTmp \ 4) * bytXX
                    bytTmp = bytTmp Mod 4
                    
                    bytHZDotD(kLoop + 12) = bytHZDotD(kLoop + 12) + (bytTmp \ 2) * bytXX
                    bytHZDotD(kLoop + 14) = bytHZDotD(kLoop + 14) + (bytTmp Mod 2) * bytXX
                End If
            Next jLoop
            
            strTmp = ""
            For jLoop = 0 To 31
                Put #102, , bytHZDotD(jLoop)
                strTmp = strTmp & "0x" & Right("0" & Hex(bytHZDotD(jLoop)), 2)
                If jLoop < 31 Then
                    strTmp = strTmp & ","
                End If
                If (jLoop = 7) Or (jLoop = 15) Or (jLoop = 23) Then
                    strTmp = strTmp & vbCrLf & Space(17)
                End If
            Next jLoop
            
            If iLoop = intTmp Then
                strTmp = Space(16) & "{" & strTmp & "}};"
            Else
                strTmp = Space(16) & "{" & strTmp & "},"
            End If
            Print #103, strTmp
        Next iLoop
    End If
    
    Close #101
    Close #102
    Close #103
    
    MsgBox "所提取的字符点阵，已保存到：" & Space(8) & vbCrLf & vbCrLf _
            & strDestA & vbCrLf & vbCrLf & strDestB & vbCrLf, _
            vbOKOnly + vbInformation, "提示"
End Sub

Private Sub Form_Load()
    txtInput.Text = ""
End Sub