祝：新年快乐 请问有没有办法用VB读出汉字库？

Private Const IME_ESC_MAX_KEY = &H1005
Private Const IME_ESC_IME_NAME = &H1006
Private Const GCL_REVERSECONVERSION = &H2Private Type CANDIDATELIST
dwSize As Long
dwStyle As Long
dwCount As Long
dwSelection As Long
dwPageStart As Long
dwPageSize As Long
dwOffset(1) As Long
End TypePrivate Declare Function GetKeyboardLayoutList Lib "user32" (ByVal nBuff As Long, lpList As Long) As Long
Private Declare Function ImmEscape Lib "imm32.dll" Alias "ImmEscapeA" (ByVal hkl As Long, ByVal himc As Long, ByVal un As Long, lpv As Any) As Long
Private Declare Function ImmGetConversionList Lib "imm32.dll" Alias "ImmGetConversionListA" (ByVal hkl As Long, ByVal himc As Long, ByVal lpsz As String, lpCandidateList As Any, ByVal dwBufLen As Long, ByVal uFlag As Long) As Long
Private Declare Function ImmGetConversionList Lib "imm32.dll" Alias "ImmGetConversionListA" (ByVal hkl As Long, ByVal himc As Long, ByVal lpsz As String, lpCandidateList As CANDIDATELIST, ByVal dwBufLen As Long, ByVal uFlag As Long) As Long
Private Declare Function IsDBCSLeadByte Lib "kernel32" (ByVal bTestChar As Byte) As LongPrivate Const NUM_OF_BUFFERS = 40
Private Const MSPY = "微软拼音输入法"
Dim imeHandle(1 To NUM_OF_BUFFERS) As Long
Dim imeName(1 To NUM_OF_BUFFERS) As String

解决方案 »

  1.   

    选用了UCDOS 5.0汉字系统中的16点阵字库Hzk16作为提取汉字字模的标准字库。　　Private Sub CmdCnt_Click( )　　Dim TempSrcFile As String　　Dim TempDestFile As String　　Dim TempFile As String　　Dim HzFile As String　　Dim To61202(32) As Integer　　Dim p(1 To 2) As Byte　　Dim C1, C2　　Dim rec As Integer　　Dim Location As Long '汉字在字库中的位置　　Dim Hz(0 To 31) As Byte '转换完的32字节的字模数据　　Dim Buf1(0 To 31) As Byte '暂存转换过程中的32字节字模数据　　Dim HzAll( ) As Byte '存放全部字模数据的动态数组　　Dim LoopAll As Integer　　Dim bit, k2, k3 As Byte　　Dim i, j, i1, k, k1, k4, k5, k6 As Integer　　DestTxt.Text = "" 'DestTxt是目标文本框，存放转换后的16进制数据　　Flag = 0　　TempDestFile$ = App.Path + "\" + "TempDest.txt"　　If FileExists(TempDestFile$) Then Kill TempDestFile 'FileExists是一个检查文件是否存在的自定义函数　　If SrcTxt.Text = "" Then '汉字输入框内无汉字则退出　　MsgBox "没有可以转换的字模源文件！"　　Exit Sub　　End If　　HzNum = Len(SrcTxt.Text) '获得汉字的个数　　ReDim HzAll(0 To HzNum * 32 - 1) '重新定义动态数组的上界　　Open TempFile For Output As #1　　Print #1, SrcTxt.Text　　Close #1　　For LoopAll = 0 To HzNum - 1　　Open TempFile For Binary Access Read As #1 '按二进制方式打开　　Get #1, 2 * LoopAll + 1, p　　Close #1　　C1 = CStr(p(1)) - &Ha1 '区内码　　C2 = CStr(p(2)) - &Ha1 '位内码　　rec = C1 * 94 + C2　　Location = CLng(rec) * 32 + 1 '该汉字在16*16点阵字库中字模第一个字节的位置　　HzFile = App.Path + "\" + "hzk16"　　Open HzFile For Binary Access Read As #1 '读取该汉字在16点阵字库中的原始字模　　Get #1， Location， Hz　　Close #1　　'以下是将UCDOS字库的存储格式调整为HD61202的规范格式　　For j = 0 To 3　　If j = 0 Then k4 = 14　　If j = 1 Then k4 = 15　　If j = 2 Then k4 = 30　　If j = 3 Then k4 = 31　　For k = 0 To 7　　bit = &H80　　bit = byteRight((bit), (k))　　For i = 0 To 7　　k2 = byteleft(Buf1(j * 8 + k), 1) '整个流程是由低位向高位移动,最后凑成一个字节　　k3 = byteRight((Hz(k4 - i * 2) And bit), 7 - k) '将字节中的某位移到最低位　　k3 = k3 And &H1 '屏蔽掉其余7位　　Buf1(j * 8 + k) = k2 Or k3　　Next i　　Next k　　Next j　　For i1 = 0 To 31 '将调整后的汉字字模再装入原数组　　Hz(i1) = Buf1(i1)　　HzAll(LoopAll * 32 + i1) = Buf1(i1)　　Next 　　Next LoopAll 　　Open TempDestFile For Binary Access Write As #1 '转换结果保存到TempDestFile中　　Put #1, 1, HzAll　　Close #1　　MsgBox "OK!"　　End Sub
      

  2.   

    我做过一个fontsbuild,用来生成和显示 12 或 16 点整的汉字库、ASCII码库，源代码可以到我的主页上下载。http://hzfeng.yeah.net