做字库查询，HZK16字库，生成点阵，但不知道怎么去查询字库，有说VB不好搞，要用C做个》DLL查询，但是不会做封装。求助各位。。。
可以Q我15576080。

[ 本帖最后由 roy1557 于 2011-1-6 13:13 编辑 ]

以前用QB做过读字库的，现不记得扔到那里去了。
HZK16 的字库，每个字是多少字节，然后 每个汉字，转为 单字节的 二个字符，根据这二个字符计算出 在字库里的起始位置来。

字库里读出来的是 按二进制保存的。 1显示黑点，0 显示白点（或不显示）。

系统字库不能用吗？

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

注意,我的程序是只显示第一个汉字,也就是说,如果你有二个汉字的话,也只会显示第一个汉字.
如果你能理解的话,建议使用 显示字模2 进行显示汉字

程序没有判定 hzk16 这个文件是否存在

经速度测试,在我用的电脑上, 显示字模2 的速度是 显示字模 速度的 2倍.
同样显示10000次, 显示字模 耗时 6 秒, 显示字模2 耗时3秒.
测试代码如下:

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

windows下做字库的意义何在，我还以为你想做个在DOS下用的字库，方便DOS下显示自己独特的东西！