字库查询
做字库查询,HZK16字库,生成点阵,但不知道怎么去查询字库,有说VB不好搞,要用C做个》DLL查询,但是不会做封装。求助各位。。。可以Q我15576080。
[ 本帖最后由 roy1557 于 2011-1-6 13:13 编辑 ]
Option Explicit Public Sub 显示字模(cs() As Byte, obj As PictureBox, X As Long, Y As Long) '复杂转换,但比较容易理解 Const 格 = 15 '每个格子大小,用于计算坐标的,一般 15缇=1像素 Dim i As Long, j As Long Dim m As String For i = 0 To 15 '一共有 16行 m = Hex(cs(i * 2)) '取一个字节,这行的前半段,并转16进制 If Len(m) = 1 Then m = "0" & m '如果长度为1,则补个 0 m = 二进制(m) '转 2进制字符串 For j = 0 To 7 '显示这8个点,空白点不显示 If Mid(m, j + 1, 1) = 1 Then obj.PSet (X + j * 格, Y + i * 格), 0 End If Next j m = Hex(cs(i * 2 + 1)) '取一个字节,为本行的后半段,操作同上 If Len(m) = 1 Then m = "0" & m m = 二进制(m) For j = 8 To 15 If Mid(m, j - 7, 1) = 1 Then obj.PSet (X + j * 格, Y + i * 格), 0 End If Next j Next i End Sub Public Sub 显示字模2(cs() As Byte, obj As PictureBox, X As Long, Y As Long) '无转换,直接判断位,不容易理解,运算量少 Const 格 = 15 '每个格子大小,用于计算坐标的,一般 15缇=1像素 Dim i As Long, j As Long Dim m As String '如果是大型程序,掩码计算需要放在程序初始化为完成,不要放到每次调用时来计算. Dim YM(0 To 7) As Byte '各位掩码 YM(7) = 1 '最左边,也就是 第 7个掩码为 1 For i = 6 To 0 Step -1 YM(i) = YM(i + 1) * 2 '计算其它各个掩码 Next i For i = 0 To 15 '一共有 16行 For j = 0 To 7 '显示前 8 个点 If (cs(i * 2) And YM(j)) = YM(j) Then '与掩码进行 字节 AND 操作,结果为 掩码或者 0 obj.PSet (X + j * 格, Y + i * 格), 0 End If Next j For j = 8 To 15 '显示后 8 个点 If (cs(i * 2 + 1) And YM(j - 8)) = YM(j - 8) Then '与掩码进行 字节 AND 操作,结果为 掩码或者 0 obj.PSet (X + j * 格, Y + i * 格), 0 End If Next j Next i End Sub Public Sub 读字模(cs As String, dat() As Byte) Dim fr As Long fr = FreeFile '取文件号 Dim dd() As Byte '定义变量,dd只使用前二位,实际上就是一个汉字. dd = StrConv(cs, vbFromUnicode) '转为ASC字串 Dim qh As Long, wh As Long '二个变量,计算区和位的 Dim i As Long qh = dd(0) - 160 '区 160=&ha0 wh = dd(1) - 160 '位 Open "HZK16" For Binary Access Read As #fr '打开文件 Seek #fr, (94 * (qh - 1) + (wh - 1)) * 32 + 1 '跳到位置,+1,因为VB文件起始位置是1 For i = 0 To 31 '按字节,一个字节一个字节的读,共读32个字节 Get #fr, , dat(i) Next i Close #fr End Sub ' qh=c1-32-128=c1-160 wh=c2-32-128=c2-160 ' 或 ' qh=c1-0xa0 wh=c2-0xa0 ' qh,wh为汉字的区号和位号,c1,c2为汉字的第一字节和第二字节。 '根据区号和位号可以得到汉字字模在文件中的位置: ' location=(94*(qh-1)+(wh-1))*32。 Public Function 二进制(cs As String) As String Dim i As Long, j As String cs = UCase(cs) '转大写 If Len(cs) = 1 Then '长度为1 Select Case cs '直接分支选择得到 Case "0" j = "0000" Case "1" j = "0001" Case "2" j = "0010" Case "3" j = "0011" Case "4" j = "0100" Case "5" j = "0101" Case "6" j = "0110" Case "7" j = "0111" Case "8" j = "1000" Case "9" j = "1001" Case "A" j = "1010" Case "B" j = "1011" Case "C" j = "1100" Case "D" j = "1101" Case "E" j = "1110" Case "F" j = "1111" End Select Else For i = 1 To Len(cs) '长度不为1 ,使用循环调用自己来得到最后的数据. j = j & 二进制(Mid(cs, i, 1)) '调用自己 Next i End If 二进制 = j '返回值 End Function
Option Explicit Private Sub Command1_Click() Dim dat(31) As Byte Call 读字模("我", dat()) Call 显示字模2(dat(), Picture1, 100, 100) End Sub
Private Sub Command2_Click() Dim dat(31) As Byte Call 读字模("麝", dat()) Dim t1 As Date Dim t2 As Date Dim t3 As Date Dim i As Long t1 = Time For i = 1 To 10000 Call 显示字模(dat(), Picture1, 100, 100) Next i t2 = Time For i = 1 To 10000 Call 显示字模2(dat(), Picture1, 100, 100) Next i t3 = Time Debug.Print (t2 - t1) * 60 * 60 * 24 ;"秒" Debug.Print (t3 - t2) * 60 * 60 * 24 ;"秒" MsgBox (t2 - t1) * 60 * 60 * 24 & vbCrLf & (t3 - t2) * 60 * 60 * 24 End Sub