|
漢字取模方法
（作者未知） 2009/12/21
（接上頁）TempFile = App.Path + "\" + "TempSrc.txt"
’TempFileBinary = App.Path + "\" + "TempSrcBinary.txt"
Open TempFile For Output As #1
Print #1, SrcTxt.Text
Close #1
End Sub
在實例中選用了UCDOS 5.0漢字系統(tǒng)中的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 ’轉(zhuǎn)換完的32字節(jié)的字模數(shù)據(jù)
Dim Buf1(0 To 31) As Byte ’暫存轉(zhuǎn)換過程中的32字節(jié)字模數(shù)據(jù)
Dim HzAll( ) As Byte ’存放全部字模數(shù)據(jù)的動態(tài)數(shù)組
Dim LoopAll As Integer
Dim bit, k2, k3 As Byte
Dim i, j, i1, k, k1, k4, k5, k6 As Integer
DestTxt.Text = "" ’DestTxt是目標文本框，存放轉(zhuǎn)換后的16進制數(shù)據(jù)
Flag = 0
TempDestFile$ = App.Path + "\" + "TempDest.txt"
If FileExists(TempDestFile$) Then Kill TempDestFile ’FileExists是一個檢查文件是否存在的自定義函數(shù)
If SrcTxt.Text = "" Then ’漢字輸入框內(nèi)無漢字則退出
MsgBox "沒有可以轉(zhuǎn)換的字模源文件！"
Exit Sub
End If
HzNum = Len(SrcTxt.Text) ’獲得漢字的個數(shù)
ReDim HzAll(0 To HzNum * 32 - 1) ’重新定義動態(tài)數(shù)組的上界
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 ’區(qū)內(nèi)碼
C2 = CStr(p(2)) - &Ha1 ’位內(nèi)碼
rec = C1 * 94 + C2
Location = CLng(rec) * 32 + 1 ’該漢字在16*16點陣字庫中字模第一個字節(jié)的位置
HzFile = App.Path + "\" + "hzk16"
Open HzFile For Binary Access Read As #1 ’讀取該漢字在16點陣字庫中的原始字模
Get #1， Location， Hz
Close #1
’以下是將UCDOS字庫的存儲格式調(diào)整為HD61202的規(guī)范格式
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 The（未完，下一頁）
|